From git at git.haskell.org Fri Aug 1 00:13:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 00:13:18 +0000 (UTC) Subject: [commit: ghc] master: Small tweaks to comment (58ed1cc) Message-ID: <20140801001318.918DD240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/58ed1cc2dc2b3cbe085655331b1cc14049fecf5b/ghc >--------------------------------------------------------------- commit 58ed1cc2dc2b3cbe085655331b1cc14049fecf5b Author: Gabor Greif Date: Fri Aug 1 01:46:29 2014 +0200 Small tweaks to comment >--------------------------------------------------------------- 58ed1cc2dc2b3cbe085655331b1cc14049fecf5b compiler/types/FamInstEnv.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs index a9da982..1308984 100644 --- a/compiler/types/FamInstEnv.lhs +++ b/compiler/types/FamInstEnv.lhs @@ -751,11 +751,11 @@ The "extra" type argument [Char] just stays on the end. We handle data families and type families separately here: - * For type families, all instances of a type family must have the + * For type families, all instances of a type family must have the same arity, so we can precompute the split between the match_tys and the overflow tys. This is done in pre_rough_split_tys. - * For data families instances, though, we need to re-split for each + * For data family instances, though, we need to re-split for each instance, because the breakdown might be different for each instance. Why? Because of eta reduction; see Note [Eta reduction for data family axioms] From git at git.haskell.org Fri Aug 1 00:13:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 00:13:20 +0000 (UTC) Subject: [commit: ghc] master: Typo fixes (1c1ef82) Message-ID: <20140801001321.003C0240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1c1ef82409dbff3ad914d1eddd976dec9a293b01/ghc >--------------------------------------------------------------- commit 1c1ef82409dbff3ad914d1eddd976dec9a293b01 Author: Gabor Greif Date: Fri Aug 1 02:03:08 2014 +0200 Typo fixes >--------------------------------------------------------------- 1c1ef82409dbff3ad914d1eddd976dec9a293b01 compiler/basicTypes/BasicTypes.lhs | 4 ++-- compiler/main/DynFlags.hs | 2 +- compiler/typecheck/TcBinds.lhs | 2 +- compiler/types/InstEnv.lhs | 6 +++--- docs/users_guide/glasgow_exts.xml | 6 +++--- testsuite/tests/safeHaskell/ghci/p13.stderr | 2 +- 6 files changed, 11 insertions(+), 11 deletions(-) diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs index c6fb26c..2f86db7 100644 --- a/compiler/basicTypes/BasicTypes.lhs +++ b/compiler/basicTypes/BasicTypes.lhs @@ -508,7 +508,7 @@ data OverlapMode -- See Note [Rules for instance lookup] in InstEnv | Overlaps - -- ^ Equiavalent to having both `Overlapping` and `Overlappable` flags. + -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags. | Incoherent -- ^ Behave like Overlappable and Overlapping, and in addition pick @@ -815,7 +815,7 @@ data InlinePragma -- Note [InlinePragma] , inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor? } deriving( Eq, Data, Typeable ) -data InlineSpec -- What the user's INLINE pragama looked like +data InlineSpec -- What the user's INLINE pragma looked like = Inline | Inlinable | NoInline diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 9c45f41..ac049aa 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2873,7 +2873,7 @@ xFlags = [ ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving, setGenDeriving ), ( "OverlappingInstances", Opt_OverlappingInstances, \ turn_on -> when turn_on - $ deprecate "instead use per-instance pragamas OVERLAPPING/OVERLAPPABLE/OVERLAPS" ), + $ deprecate "instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS" ), ( "UndecidableInstances", Opt_UndecidableInstances, nop ), ( "IncoherentInstances", Opt_IncoherentInstances, nop ), ( "PackageImports", Opt_PackageImports, nop ), diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 83a9591..34db200 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -839,7 +839,7 @@ tcSpec _ prag = pprPanic "tcSpec" (ppr prag) -------------- tcImpPrags :: [LSig Name] -> TcM [LTcSpecPrag] --- SPECIALISE pragamas for imported things +-- SPECIALISE pragmas for imported things tcImpPrags prags = do { this_mod <- getModule ; dflags <- getDynFlags diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.lhs index 636147a..aba2d3d 100644 --- a/compiler/types/InstEnv.lhs +++ b/compiler/types/InstEnv.lhs @@ -462,16 +462,16 @@ The willingness to be overlapped or incoherent is a property of the instance declaration itself, controlled as follows: * An instance is "incoherent" - if it has an INCOHERENT pragama, or + if it has an INCOHERENT pragma, or if it appears in a module compiled with -XIncoherentInstances. * An instance is "overlappable" - if it has an OVERLAPPABLE or OVERLAPS pragama, or + if it has an OVERLAPPABLE or OVERLAPS pragma, or if it appears in a module compiled with -XOverlappingInstances, or if the instance is incoherent. * An instance is "overlapping" - if it has an OVERLAPPING or OVERLAPS pragama, or + if it has an OVERLAPPING or OVERLAPS pragma, or if it appears in a module compiled with -XOverlappingInstances, or if the instance is incoherent. compiled with -XOverlappingInstances. diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 5166c28..84d6a62 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -5062,11 +5062,11 @@ A more precise specification is as follows. The willingness to be overlapped or incoherent is a property of the instance declaration itself, controlled as follows: -An instance is incoherent if it has an INCOHERENT pragama, or if it appears in a module compiled with -XIncoherentInstances. +An instance is incoherent if it has an INCOHERENT pragma, or if it appears in a module compiled with -XIncoherentInstances. -An instance is overlappable if it has an OVERLAPPABLE or OVERLAPS pragama, or if it appears in a module compiled with -XOverlappingInstances, or if the instance is incoherent. +An instance is overlappable if it has an OVERLAPPABLE or OVERLAPS pragma, or if it appears in a module compiled with -XOverlappingInstances, or if the instance is incoherent. -An instance is overlapping if it has an OVERLAPPING or OVERLAPS pragama, or if it appears in a module compiled with -XOverlappingInstances, or if the instance is incoherent. +An instance is overlapping if it has an OVERLAPPING or OVERLAPS pragma, or if it appears in a module compiled with -XOverlappingInstances, or if the instance is incoherent. The language extension is now deprecated in favour diff --git a/testsuite/tests/safeHaskell/ghci/p13.stderr b/testsuite/tests/safeHaskell/ghci/p13.stderr index 44f8ff4..7a743f1 100644 --- a/testsuite/tests/safeHaskell/ghci/p13.stderr +++ b/testsuite/tests/safeHaskell/ghci/p13.stderr @@ -1,6 +1,6 @@ P13_A.hs:1:14: Warning: - -XOverlappingInstances is deprecated: instead use per-instance pragamas OVERLAPPING/OVERLAPPABLE/OVERLAPS + -XOverlappingInstances is deprecated: instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS :11:1: Unsafe overlapping instances for Pos [Int] From git at git.haskell.org Fri Aug 1 08:34:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 08:34:00 +0000 (UTC) Subject: [commit: ghc] master: Unbreak build. (52188ad) Message-ID: <20140801083400.DADED240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/52188ada67e0f90425e52202541f78eccdcee35b/ghc >--------------------------------------------------------------- commit 52188ada67e0f90425e52202541f78eccdcee35b Author: Gabor Pali Date: Fri Aug 1 10:26:53 2014 +0200 Unbreak build. >--------------------------------------------------------------- 52188ada67e0f90425e52202541f78eccdcee35b docs/users_guide/packages.xml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/docs/users_guide/packages.xml b/docs/users_guide/packages.xml index 7a2543d..62b4e96 100644 --- a/docs/users_guide/packages.xml +++ b/docs/users_guide/packages.xml @@ -1048,7 +1048,6 @@ ghc-pkg dot | tred | dot -Tpdf >pkgs.pdf Output the ghc-pkg version number. - @@ -1067,7 +1066,7 @@ ghc-pkg dot | tred | dot -Tpdf >pkgs.pdf necessarily holds). - + From git at git.haskell.org Fri Aug 1 11:46:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 11:46:05 +0000 (UTC) Subject: [commit: ghc] master: refactor to fix 80column overflow (3b9fe0c) Message-ID: <20140801114605.31225240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3b9fe0c61bc3cd7ded3a03b6be714d5c791ce079/ghc >--------------------------------------------------------------- commit 3b9fe0c61bc3cd7ded3a03b6be714d5c791ce079 Author: Simon Marlow Date: Thu Jul 31 09:30:18 2014 +0100 refactor to fix 80column overflow >--------------------------------------------------------------- 3b9fe0c61bc3cd7ded3a03b6be714d5c791ce079 compiler/nativeGen/RegAlloc/Linear/Main.hs | 36 +++++++++++++++++------------- 1 file changed, 20 insertions(+), 16 deletions(-) diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs index 3541692..fa47a17 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Main.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs @@ -196,26 +196,30 @@ regAlloc _ (CmmProc _ _ _ _) linearRegAlloc :: (Outputable instr, Instruction instr) => DynFlags - -> [BlockId] -- ^ entry points - -> BlockMap RegSet -- ^ live regs on entry to each basic block - -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths" + -> [BlockId] -- ^ entry points + -> BlockMap RegSet + -- ^ live regs on entry to each basic block + -> [SCC (LiveBasicBlock instr)] + -- ^ instructions annotated with "deaths" -> UniqSM ([NatBasicBlock instr], RegAllocStats, Int) linearRegAlloc dflags entry_ids block_live sccs - = let platform = targetPlatform dflags - in case platformArch platform of - ArchX86 -> linearRegAlloc' dflags (frInitFreeRegs platform :: X86.FreeRegs) entry_ids block_live sccs - ArchX86_64 -> linearRegAlloc' dflags (frInitFreeRegs platform :: X86_64.FreeRegs) entry_ids block_live sccs - ArchSPARC -> linearRegAlloc' dflags (frInitFreeRegs platform :: SPARC.FreeRegs) entry_ids block_live sccs - ArchPPC -> linearRegAlloc' dflags (frInitFreeRegs platform :: PPC.FreeRegs) entry_ids block_live sccs - ArchARM _ _ _ -> panic "linearRegAlloc ArchARM" - ArchARM64 -> panic "linearRegAlloc ArchARM64" - ArchPPC_64 -> panic "linearRegAlloc ArchPPC_64" - ArchAlpha -> panic "linearRegAlloc ArchAlpha" - ArchMipseb -> panic "linearRegAlloc ArchMipseb" - ArchMipsel -> panic "linearRegAlloc ArchMipsel" + = case platformArch platform of + ArchX86 -> go $ (frInitFreeRegs platform :: X86.FreeRegs) + ArchX86_64 -> go $ (frInitFreeRegs platform :: X86_64.FreeRegs) + ArchSPARC -> go $ (frInitFreeRegs platform :: SPARC.FreeRegs) + ArchPPC -> go $ (frInitFreeRegs platform :: PPC.FreeRegs) + ArchARM _ _ _ -> panic "linearRegAlloc ArchARM" + ArchARM64 -> panic "linearRegAlloc ArchARM64" + ArchPPC_64 -> panic "linearRegAlloc ArchPPC_64" + ArchAlpha -> panic "linearRegAlloc ArchAlpha" + ArchMipseb -> panic "linearRegAlloc ArchMipseb" + ArchMipsel -> panic "linearRegAlloc ArchMipsel" ArchJavaScript -> panic "linearRegAlloc ArchJavaScript" - ArchUnknown -> panic "linearRegAlloc ArchUnknown" + ArchUnknown -> panic "linearRegAlloc ArchUnknown" + where + go f = linearRegAlloc' dflags f entry_ids block_live sccs + platform = targetPlatform dflags linearRegAlloc' :: (FR freeRegs, Outputable instr, Instruction instr) From git at git.haskell.org Fri Aug 1 11:46:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 11:46:07 +0000 (UTC) Subject: [commit: ghc] master: update comment (aab5937) Message-ID: <20140801114607.B400E240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aab5937405d379ee2e9ac0a54f145ca4005cf283/ghc >--------------------------------------------------------------- commit aab5937405d379ee2e9ac0a54f145ca4005cf283 Author: Simon Marlow Date: Thu Jul 31 11:47:35 2014 +0100 update comment >--------------------------------------------------------------- aab5937405d379ee2e9ac0a54f145ca4005cf283 compiler/cmm/CmmPipeline.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs index 4314695..af4f62a 100644 --- a/compiler/cmm/CmmPipeline.hs +++ b/compiler/cmm/CmmPipeline.hs @@ -326,10 +326,9 @@ _GLOBAL_OFFSET_TABLE_, regardless of which entry point we arrived via. {- Note [unreachable blocks] The control-flow optimiser sometimes leaves unreachable blocks behind -containing junk code. If these blocks make it into the native code -generator then they trigger a register allocator panic because they -refer to undefined LocalRegs, so we must eliminate any unreachable -blocks before passing the code onwards. +containing junk code. These aren't necessarily a problem, but +removing them is good because it might save time in the native code +generator later. -} From git at git.haskell.org Fri Aug 1 11:46:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 11:46:10 +0000 (UTC) Subject: [commit: ghc] master: Fix reference to note (028630a) Message-ID: <20140801114611.1AB83240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/028630ab2153d4a6eb473fef6e18130388a68636/ghc >--------------------------------------------------------------- commit 028630ab2153d4a6eb473fef6e18130388a68636 Author: Simon Marlow Date: Thu Jul 31 11:47:28 2014 +0100 Fix reference to note >--------------------------------------------------------------- 028630ab2153d4a6eb473fef6e18130388a68636 compiler/cmm/CmmLayoutStack.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs index db22deb..c582b78 100644 --- a/compiler/cmm/CmmLayoutStack.hs +++ b/compiler/cmm/CmmLayoutStack.hs @@ -870,7 +870,7 @@ areaToSp _ _ _ _ other = other -- really the job of the stack layout algorithm, hence we do it now. optStackCheck :: CmmNode O C -> CmmNode O C -optStackCheck n = -- Note [null stack check] +optStackCheck n = -- Note [Always false stack check] case n of CmmCondBranch (CmmLit (CmmInt 0 _)) _true false -> CmmBranch false other -> other From git at git.haskell.org Fri Aug 1 11:46:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 11:46:13 +0000 (UTC) Subject: [commit: ghc] master: A panic in CmmBuildInfoTables.bundle shouldn't be a panic (#9329) (2989ffd) Message-ID: <20140801114613.70E2B240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2989ffdcb88ab24e8a4e8b3d0454497a0db2652c/ghc >--------------------------------------------------------------- commit 2989ffdcb88ab24e8a4e8b3d0454497a0db2652c Author: Simon Marlow Date: Thu Jul 31 11:47:16 2014 +0100 A panic in CmmBuildInfoTables.bundle shouldn't be a panic (#9329) Summary: This code needs more comments, but I believe this is safe. By definition I can't have broken anything that was working by turning a panic into a non-panic anyway. Test Plan: validate Reviewers: hvr, simonpj, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D105 GHC Trac Issues: #9329 >--------------------------------------------------------------- 2989ffdcb88ab24e8a4e8b3d0454497a0db2652c compiler/cmm/CmmBuildInfoTables.hs | 12 ++++++++---- testsuite/tests/codeGen/should_compile/T9329.cmm | 5 +++++ testsuite/tests/codeGen/should_compile/all.T | 1 + 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs index e10716a..6521a84 100644 --- a/compiler/cmm/CmmBuildInfoTables.hs +++ b/compiler/cmm/CmmBuildInfoTables.hs @@ -286,7 +286,7 @@ bundle :: Map CLabel CAFSet -> (CAFEnv, CmmDecl) -> (CAFSet, Maybe CLabel) -> (BlockEnv CAFSet, CmmDecl) -bundle flatmap (env, decl@(CmmProc infos lbl _ g)) (closure_cafs, mb_lbl) +bundle flatmap (env, decl@(CmmProc infos _lbl _ g)) (closure_cafs, mb_lbl) = ( mapMapWithKey get_cafs (info_tbls infos), decl ) where entry = g_entry g @@ -297,9 +297,13 @@ bundle flatmap (env, decl@(CmmProc infos lbl _ g)) (closure_cafs, mb_lbl) get_cafs l _ | l == entry = entry_cafs - | otherwise = if not (mapMember l env) - then pprPanic "bundle" (ppr l <+> ppr lbl <+> ppr (info_tbls infos) $$ ppr env $$ ppr decl) - else flatten flatmap $ expectJust "bundle" $ mapLookup l env + | Just info <- mapLookup l env = flatten flatmap info + | otherwise = Set.empty + -- the label might not be in the env if the code corresponding to + -- this info table was optimised away (perhaps because it was + -- unreachable). In this case it doesn't matter what SRT we + -- infer, since the info table will not appear in the generated + -- code. See #9329. bundle _flatmap (_, decl) _ = ( mapEmpty, decl ) diff --git a/testsuite/tests/codeGen/should_compile/T9329.cmm b/testsuite/tests/codeGen/should_compile/T9329.cmm new file mode 100644 index 0000000..da20069 --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T9329.cmm @@ -0,0 +1,5 @@ +foo () +{ + STK_CHK_GEN_N (8); /* panics */ + return (0); +} diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index a3020fe..a6b6894 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -24,3 +24,4 @@ test('T7574', [cmm_src, omit_ways(['llvm', 'optllvm'])], compile, ['']) test('T8205', normal, compile, ['-O0']) test('T9155', normal, compile, ['-O2']) test('T9303', normal, compile, ['-O2']) +test('T9329', [cmm_src], compile, ['']) From git at git.haskell.org Fri Aug 1 11:46:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 11:46:16 +0000 (UTC) Subject: [commit: ghc] master: panic message fix (6483b8a) Message-ID: <20140801114617.3D6C2240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6483b8ab7c5cb4dc3d06b2069dcd44fabe400858/ghc >--------------------------------------------------------------- commit 6483b8ab7c5cb4dc3d06b2069dcd44fabe400858 Author: Simon Marlow Date: Thu Jul 31 10:33:42 2014 +0100 panic message fix >--------------------------------------------------------------- 6483b8ab7c5cb4dc3d06b2069dcd44fabe400858 rts/Threads.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/Threads.c b/rts/Threads.c index 0dee470..b1912d8 100644 --- a/rts/Threads.c +++ b/rts/Threads.c @@ -221,7 +221,7 @@ removeThreadFromDeQueue (Capability *cap, } } } - barf("removeThreadFromMVarQueue: not found"); + barf("removeThreadFromDeQueue: not found"); } /* ---------------------------------------------------------------------------- From git at git.haskell.org Fri Aug 1 11:46:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 11:46:19 +0000 (UTC) Subject: [commit: ghc] master: add a comment (6c06db1) Message-ID: <20140801114619.ADCD8240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6c06db13a670f156a79301c89b6bf2669d91af88/ghc >--------------------------------------------------------------- commit 6c06db13a670f156a79301c89b6bf2669d91af88 Author: Simon Marlow Date: Thu Jul 31 11:47:44 2014 +0100 add a comment >--------------------------------------------------------------- 6c06db13a670f156a79301c89b6bf2669d91af88 compiler/cmm/PprCmm.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs index b5beb07..cc31240 100644 --- a/compiler/cmm/PprCmm.hs +++ b/compiler/cmm/PprCmm.hs @@ -138,6 +138,9 @@ pprCmmGraph g $$ nest 2 (vcat $ map ppr blocks) $$ text "}" where blocks = postorderDfs g + -- postorderDfs has the side-effect of discarding unreachable code, + -- so pretty-printed Cmm will omit any unreachable blocks. This can + -- sometimes be confusing. --------------------------------------------- -- Outputting CmmNode and types which it contains From git at git.haskell.org Fri Aug 1 11:46:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 11:46:23 +0000 (UTC) Subject: [commit: ghc] master: interruptible() was not returning true for BlockedOnSTM (#9379) (9d9a554) Message-ID: <20140801114623.61B48240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9d9a55469719908bbd5cd3277e0ac79c0588dc55/ghc >--------------------------------------------------------------- commit 9d9a55469719908bbd5cd3277e0ac79c0588dc55 Author: Simon Marlow Date: Thu Jul 31 10:00:16 2014 +0100 interruptible() was not returning true for BlockedOnSTM (#9379) Summary: There's an knock-on fix in HeapStackCheck.c which is potentially scary, but I'm pretty confident is OK. See comment for details. Test Plan: I've run all the STM tests I can find, including libraries/stm/tests/stm049 with +RTS -N8 and some of the constants bumped to make it more of a stress test. Reviewers: hvr, rwbarton, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D104 GHC Trac Issues: #9379 >--------------------------------------------------------------- 9d9a55469719908bbd5cd3277e0ac79c0588dc55 rts/HeapStackCheck.cmm | 25 ++++++++++++++++++------- rts/RaiseAsync.h | 1 + testsuite/tests/concurrent/should_run/T9379.hs | 17 +++++++++++++++++ testsuite/tests/concurrent/should_run/all.T | 2 ++ 4 files changed, 38 insertions(+), 7 deletions(-) diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm index 12bcfb2..f090bff 100644 --- a/rts/HeapStackCheck.cmm +++ b/rts/HeapStackCheck.cmm @@ -681,13 +681,24 @@ stg_block_async_void STM-specific waiting -------------------------------------------------------------------------- */ -stg_block_stmwait_finally -{ - ccall stmWaitUnlock(MyCapability() "ptr", R3 "ptr"); - jump StgReturn [R1]; -} - stg_block_stmwait { - BLOCK_BUT_FIRST(stg_block_stmwait_finally); + // When blocking on an MVar we have to be careful to only release + // the lock on the MVar at the very last moment (using + // BLOCK_BUT_FIRST()), since when we release the lock another + // Capability can wake up the thread, which modifies its stack and + // other state. This is not a problem for STM, because STM + // wakeups are non-destructive; the waker simply calls + // tryWakeupThread() which sends a message to the owner + // Capability. So the moment we release this lock we might start + // getting wakeup messages, but that's perfectly harmless. + // + // Furthermore, we *must* release these locks, just in case an + // exception is raised in this thread by + // maybePerformBlockedException() while exiting to the scheduler, + // which will abort the transaction, which needs to obtain a lock + // on all the TVars to remove the thread from the queues. + // + ccall stmWaitUnlock(MyCapability() "ptr", R3 "ptr"); + BLOCK_GENERIC; } diff --git a/rts/RaiseAsync.h b/rts/RaiseAsync.h index fabdc78..d0c9efc 100644 --- a/rts/RaiseAsync.h +++ b/rts/RaiseAsync.h @@ -52,6 +52,7 @@ interruptible(StgTSO *t) { switch (t->why_blocked) { case BlockedOnMVar: + case BlockedOnSTM: case BlockedOnMVarRead: case BlockedOnMsgThrowTo: case BlockedOnRead: diff --git a/testsuite/tests/concurrent/should_run/T9379.hs b/testsuite/tests/concurrent/should_run/T9379.hs new file mode 100644 index 0000000..49e6d1e --- /dev/null +++ b/testsuite/tests/concurrent/should_run/T9379.hs @@ -0,0 +1,17 @@ +import Control.Exception +import Control.Concurrent +import Control.Concurrent.STM +import Foreign.StablePtr + +main :: IO () +main = do + tv <- atomically $ newTVar True + _ <- newStablePtr tv + t <- mask_ $ forkIO (blockSTM tv) + killThread t + +blockSTM :: TVar Bool -> IO () +blockSTM tv = do + atomically $ do + v <- readTVar tv + check $ not v diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 017dba1..b43026a 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -86,6 +86,8 @@ test('AtomicPrimops', normal, compile_and_run, ['']) # test uses 2 threads and yield, scheduling can vary with threaded2 test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, ['']) +test('T9379', normal, compile_and_run, ['']) + # ----------------------------------------------------------------------------- # These tests we only do for a full run From git at git.haskell.org Fri Aug 1 13:57:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 13:57:51 +0000 (UTC) Subject: [commit: ghc] master: Improve the desugaring of RULES, esp those from SPECIALISE pragmas (d4d4bef) Message-ID: <20140801135751.49F0B240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d4d4bef2a2a3b90e6c5cb3544e1c2057920ed572/ghc >--------------------------------------------------------------- commit d4d4bef2a2a3b90e6c5cb3544e1c2057920ed572 Author: Simon Peyton Jones Date: Fri Aug 1 14:56:53 2014 +0100 Improve the desugaring of RULES, esp those from SPECIALISE pragmas In the code for Trac #8331 we were not getting a complaint, but we *were* getting a terrible (and virtually useless) RULE, looking like useAbstractMonad (complicated-dictionary-expresion) = $fuseAbstractMonad where we wanted useAbstractMonad d = $fuseAbstractMonad This commit improves the desugaring algorithm. More comments explain; see Note [Drop dictionary bindings on rule LHS] >--------------------------------------------------------------- d4d4bef2a2a3b90e6c5cb3544e1c2057920ed572 compiler/deSugar/DsBinds.lhs | 75 ++++++++++++++++++---- testsuite/tests/simplCore/should_compile/T8331.hs | 59 +++++++++++++++++ .../tests/simplCore/should_compile/T8331.stderr | 9 +++ testsuite/tests/simplCore/should_compile/all.T | 1 + 4 files changed, 133 insertions(+), 11 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d4d4bef2a2a3b90e6c5cb3544e1c2057920ed572 From git at git.haskell.org Fri Aug 1 16:26:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 16:26:51 +0000 (UTC) Subject: [commit: hsc2hs] master: Fix some AMP fallout (af92e43) Message-ID: <20140801162653.543C1240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hsc2hs On branch : master Link : http://git.haskell.org/hsc2hs.git/commitdiff/af92e439369b7a3bb7d0476243af9b5622b7a48f >--------------------------------------------------------------- commit af92e439369b7a3bb7d0476243af9b5622b7a48f Author: Austin Seipp Date: Fri Aug 1 11:24:44 2014 -0500 Fix some AMP fallout Signed-off-by: Austin Seipp >--------------------------------------------------------------- af92e439369b7a3bb7d0476243af9b5622b7a48f CrossCodegen.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CrossCodegen.hs b/CrossCodegen.hs index 725a94b..db9b124 100644 --- a/CrossCodegen.hs +++ b/CrossCodegen.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE NoMonomorphismRestriction #-} module CrossCodegen where @@ -27,7 +28,9 @@ import System.Directory (removeFile) import Data.Char (toLower,toUpper,isSpace) import Control.Exception (assert, onException) import Control.Monad (when, liftM, forM, ap) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) +#endif import Data.Foldable (concatMap) import Data.Maybe (fromMaybe) import qualified Data.Sequence as S From git at git.haskell.org Fri Aug 1 17:57:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 17:57:27 +0000 (UTC) Subject: [commit: ghc] master: Bump haddock.base max_bytes_used (8df7fea) Message-ID: <20140801175727.61A0A240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8df7fea7cf8a32d54ac3d67724322738595bf421/ghc >--------------------------------------------------------------- commit 8df7fea7cf8a32d54ac3d67724322738595bf421 Author: Joachim Breitner Date: Fri Aug 1 19:55:52 2014 +0200 Bump haddock.base max_bytes_used It has reliably increased with commit 1ae5fa45, and has been stable since then, so it does not seem to be a fluke. I did not investigate why that commit might have increased this value. >--------------------------------------------------------------- 8df7fea7cf8a32d54ac3d67724322738595bf421 testsuite/tests/perf/haddock/all.T | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index b17d472..49321b9 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -17,13 +17,14 @@ test('haddock.base', # 2014-01-22: 168 (x86/Linux - new haddock) # 2014-06-29: 156 (x86/Linux) ,stats_num_field('max_bytes_used', - [(wordsize(64), 115113864, 10) - # 2012-08-14: 87374568 (amd64/Linux) - # 2012-08-21: 86428216 (amd64/Linux) - # 2012-09-20: 84794136 (amd64/Linux) - # 2012-11-12: 87265136 (amd64/Linux) - # 2013-01-29: 96022312 (amd64/Linux) + [(wordsize(64), 127954488, 10) + # 2012-08-14: 87374568 (amd64/Linux) + # 2012-08-21: 86428216 (amd64/Linux) + # 2012-09-20: 84794136 (amd64/Linux) + # 2012-11-12: 87265136 (amd64/Linux) + # 2013-01-29: 96022312 (amd64/Linux) # 2013-10-18: 115113864 (amd64/Linux) + # 2014-07-31: 127954488 (amd64/Linux), correlates with 1ae5fa45 ,(platform('i386-unknown-mingw32'), 58557136, 10) # 2013-02-10: 47988488 (x86/Windows) # 2013-11-13: 58557136 (x86/Windows, 64bit machine) From git at git.haskell.org Fri Aug 1 18:08:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 18:08:28 +0000 (UTC) Subject: [commit: ghc] master: [backpack] More revisions to various pieces. (3faff73) Message-ID: <20140801180828.2DFBB240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3faff738f873246f8a81f44d551a9696c8338196/ghc >--------------------------------------------------------------- commit 3faff738f873246f8a81f44d551a9696c8338196 Author: Edward Z. Yang Date: Thu Jul 31 17:52:56 2014 +0100 [backpack] More revisions to various pieces. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 3faff738f873246f8a81f44d551a9696c8338196 docs/backpack/backpack-impl.tex | 209 ++++++++++++++++------------------------ 1 file changed, 84 insertions(+), 125 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3faff738f873246f8a81f44d551a9696c8338196 From git at git.haskell.org Fri Aug 1 18:14:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 18:14:45 +0000 (UTC) Subject: [commit: ghc] master: Two new executables to ignore. (0336588) Message-ID: <20140801181445.15E63240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/033658892bb2e7c172ca75b94b54258b93f715e4/ghc >--------------------------------------------------------------- commit 033658892bb2e7c172ca75b94b54258b93f715e4 Author: Edward Z. Yang Date: Fri Aug 1 19:14:31 2014 +0100 Two new executables to ignore. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 033658892bb2e7c172ca75b94b54258b93f715e4 testsuite/.gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 5653182..c99aeba 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -661,6 +661,7 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/ffi/should_run/fptrfail01 /tests/gadt/CasePrune /tests/gadt/Session +/tests/gadt/T9380 /tests/gadt/gadt2 /tests/gadt/gadt23 /tests/gadt/gadt4 @@ -1142,6 +1143,7 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/perf/should_run/T7954 /tests/perf/should_run/T876 /tests/perf/should_run/T9203 +/tests/perf/should_run/T9339 /tests/perf/should_run/lazy-bs-alloc /tests/perf/should_run/lazy-bs-alloc.stats /tests/perf/should_run/speed.f32 From git at git.haskell.org Fri Aug 1 20:27:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Aug 2014 20:27:29 +0000 (UTC) Subject: [commit: ghc] master: Fix-up to d4d4bef2 'Improve the desugaring of RULES' (02975c9) Message-ID: <20140801202732.97D4B240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/02975c90c0a587122797930e824a4d45ada26b6a/ghc >--------------------------------------------------------------- commit 02975c90c0a587122797930e824a4d45ada26b6a Author: Simon Peyton Jones Date: Fri Aug 1 21:26:51 2014 +0100 Fix-up to d4d4bef2 'Improve the desugaring of RULES' I'd forgotten the possiblity that desugaring could generate dead dictionary bindings; easily fixed by calling occurAnalyseExpr >--------------------------------------------------------------- 02975c90c0a587122797930e824a4d45ada26b6a compiler/deSugar/DsBinds.lhs | 10 ++++++++-- .../tests/simplCore/should_compile/T4398.stderr | 21 ++++++++++++++++++++- testsuite/tests/simplCore/should_compile/all.T | 2 +- .../tests/simplCore/should_compile/simpl016.stderr | 8 +++++++- 4 files changed, 36 insertions(+), 5 deletions(-) diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs index 9297064..172d19b 100644 --- a/compiler/deSugar/DsBinds.lhs +++ b/compiler/deSugar/DsBinds.lhs @@ -35,6 +35,7 @@ import HsSyn -- lots of things import CoreSyn -- lots of things import Literal ( Literal(MachStr) ) import CoreSubst +import OccurAnal ( occurAnalyseExpr ) import MkCore import CoreUtils import CoreArity ( etaExpand ) @@ -627,7 +628,9 @@ decomposeRuleLhs orig_bndrs orig_lhs , text "Orig lhs:" <+> ppr orig_lhs]) dead_msg bndr = hang (sep [ ptext (sLit "Forall'd") <+> pp_bndr bndr , ptext (sLit "is not bound in RULE lhs")]) - 2 (ppr lhs2) + 2 (vcat [ text "Orig bndrs:" <+> ppr orig_bndrs + , text "Orig lhs:" <+> ppr orig_lhs + , text "optimised lhs:" <+> ppr lhs2 ]) pp_bndr bndr | isTyVar bndr = ptext (sLit "type variable") <+> quotes (ppr bndr) | Just pred <- evVarPred_maybe bndr = ptext (sLit "constraint") <+> quotes (ppr pred) @@ -637,8 +640,11 @@ decomposeRuleLhs orig_bndrs orig_lhs drop_dicts e = wrap_lets needed bnds body where - (bnds, body) = split_lets e needed = orig_bndr_set `minusVarSet` exprFreeVars body + (bnds, body) = split_lets (occurAnalyseExpr e) + -- The occurAnalyseExpr drops dead bindings which is + -- crucial to ensure that every binding is used later; + -- which in turn makes wrap_lets work right split_lets :: CoreExpr -> ([(DictId,CoreExpr)], CoreExpr) split_lets e diff --git a/testsuite/tests/simplCore/should_compile/T4398.stderr b/testsuite/tests/simplCore/should_compile/T4398.stderr index 63d1ab3..2f1f567 100644 --- a/testsuite/tests/simplCore/should_compile/T4398.stderr +++ b/testsuite/tests/simplCore/should_compile/T4398.stderr @@ -1,3 +1,22 @@ T4398.hs:5:11: Warning: - Forall'd constraint ?Ord a? is not bound in RULE lhs f @ a x y + Forall'd constraint ?Ord a? is not bound in RULE lhs + Orig bndrs: [a, $dOrd, x, y] + Orig lhs: let { + $dEq :: Eq a + [LclId, Str=DmdType] + $dEq = GHC.Classes.$p1Ord @ a $dOrd } in + f @ a + ((\ ($dOrd :: Ord a) -> + let { + $dEq :: Eq a + [LclId, Str=DmdType] + $dEq = GHC.Classes.$p1Ord @ a $dOrd } in + let { + $dEq :: Eq a + [LclId, Str=DmdType] + $dEq = GHC.Classes.$p1Ord @ a $dOrd } in + x) + $dOrd) + y + optimised lhs: f @ a x y diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index c6453d8..f9a5846 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -95,7 +95,7 @@ test('EvalTest', test('T3831', normal, compile, ['']) test('T4345', normal, compile, ['']) -test('T4398', normal, compile, ['']) +test('T4398', normal, compile, ['-dsuppress-uniques']) test('T4903', extra_clean(['T4903a.hi', 'T4903a.o']), diff --git a/testsuite/tests/simplCore/should_compile/simpl016.stderr b/testsuite/tests/simplCore/should_compile/simpl016.stderr index 2ac4e4f..e08b16d 100644 --- a/testsuite/tests/simplCore/should_compile/simpl016.stderr +++ b/testsuite/tests/simplCore/should_compile/simpl016.stderr @@ -1,4 +1,10 @@ simpl016.hs:5:1: Warning: Forall'd constraint ?Num b? is not bound in RULE lhs - delta' @ Int @ b $dEq + Orig bndrs: [b, $dNum] + Orig lhs: let { + $dEq :: Eq Int + [LclId, Str=DmdType] + $dEq = GHC.Classes.$fEqInt } in + delta' @ Int @ b $dEq + optimised lhs: delta' @ Int @ b $dEq From git at git.haskell.org Sat Aug 2 02:05:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Aug 2014 02:05:32 +0000 (UTC) Subject: [commit: ghc] master: Update Safe Haskell typeable test outputs. (105602f) Message-ID: <20140802020535.05684240EC@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/105602f47f84ad17a87c68491effd0ba59ea1df6/ghc >--------------------------------------------------------------- commit 105602f47f84ad17a87c68491effd0ba59ea1df6 Author: David Terei Date: Thu Jul 31 10:12:35 2014 -0700 Update Safe Haskell typeable test outputs. >--------------------------------------------------------------- 105602f47f84ad17a87c68491effd0ba59ea1df6 testsuite/tests/safeHaskell/ghci/p15.stderr | 4 +++- testsuite/tests/safeHaskell/safeLanguage/SafeLang14.stderr | 8 ++++++-- testsuite/tests/safeHaskell/unsafeLibs/BadImport03.stderr | 4 +++- 3 files changed, 12 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/safeHaskell/ghci/p15.stderr b/testsuite/tests/safeHaskell/ghci/p15.stderr index 19684b3..55b5d4b 100644 --- a/testsuite/tests/safeHaskell/ghci/p15.stderr +++ b/testsuite/tests/safeHaskell/ghci/p15.stderr @@ -8,7 +8,9 @@ Top level: Warning: Deprecated: "Use Data.Typeable.Internal instead" :14:10: - Can't create hand written instances of Typeable in Safe Haskell! Can only derive them + Typeable instances can only be derived in Safe Haskell. + Replace the following instance: + instance [safe] Typeable G :22:22: No instance for (Typeable G) arising from a use of ?cast? diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang14.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang14.stderr index af8dca3..c0f94d5 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang14.stderr +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang14.stderr @@ -2,7 +2,11 @@ [2 of 2] Compiling Main ( SafeLang14.hs, SafeLang14.o ) SafeLang14.hs:14:10: - Can't create hand written instances of Typeable in Safe Haskell! Can only derive them + Typeable instances can only be derived in Safe Haskell. + Replace the following instance: + instance [safe] Typeable G SafeLang14.hs:17:10: - Can't create hand written instances of Typeable in Safe Haskell! Can only derive them + Typeable instances can only be derived in Safe Haskell. + Replace the following instance: + instance [safe] Typeable P diff --git a/testsuite/tests/safeHaskell/unsafeLibs/BadImport03.stderr b/testsuite/tests/safeHaskell/unsafeLibs/BadImport03.stderr index 03b8028..d32e33f 100644 --- a/testsuite/tests/safeHaskell/unsafeLibs/BadImport03.stderr +++ b/testsuite/tests/safeHaskell/unsafeLibs/BadImport03.stderr @@ -2,4 +2,6 @@ [2 of 2] Compiling Main ( BadImport03.hs, BadImport03.o ) BadImport03.hs:16:10: - Can't create hand written instances of Typeable in Safe Haskell! Can only derive them + Typeable instances can only be derived in Safe Haskell. + Replace the following instance: + instance [safe] Typeable NInt From git at git.haskell.org Sat Aug 2 02:05:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Aug 2014 02:05:34 +0000 (UTC) Subject: [commit: ghc] master: Dont allow hand-written Generic instances in Safe Haskell. (578fbec) Message-ID: <20140802020535.213CE2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/578fbeca31dd3d755e24e910c3a7327f92bc4ee3/ghc >--------------------------------------------------------------- commit 578fbeca31dd3d755e24e910c3a7327f92bc4ee3 Author: David Terei Date: Thu Dec 5 17:27:17 2013 -0800 Dont allow hand-written Generic instances in Safe Haskell. While they aren't strictly unsafe, it is a similar situation to Typeable. There are few instances where a programmer will write their own instance, and having compiler assurance that the Generic implementation is correct brings a lot of benefits. >--------------------------------------------------------------- 578fbeca31dd3d755e24e910c3a7327f92bc4ee3 compiler/prelude/PrelNames.lhs | 3 +++ compiler/typecheck/TcInstDcls.lhs | 31 +++++++++++++++++++++---------- 2 files changed, 24 insertions(+), 10 deletions(-) diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 2c84e40..b2dec88 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -1084,6 +1084,9 @@ datatypeClassName = clsQual gHC_GENERICS (fsLit "Datatype") datatypeClassK constructorClassName = clsQual gHC_GENERICS (fsLit "Constructor") constructorClassKey selectorClassName = clsQual gHC_GENERICS (fsLit "Selector") selectorClassKey +genericClassNames :: [Name] +genericClassNames = [genClassName, gen1ClassName] + -- GHCi things ghciIoClassName, ghciStepIoMName :: Name ghciIoClassName = clsQual gHC_GHCI (fsLit "GHCiSandboxIO") ghciIoClassKey diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index c3ba825..6ff8a2b 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -51,8 +51,8 @@ import VarEnv import VarSet import CoreUnfold ( mkDFunUnfolding ) import CoreSyn ( Expr(Var, Type), CoreExpr, mkTyApps, mkVarApps ) -import PrelNames ( tYPEABLE_INTERNAL, typeableClassName, oldTypeableClassNames ) - +import PrelNames ( tYPEABLE_INTERNAL, typeableClassName, + oldTypeableClassNames, genericClassNames ) import Bag import BasicTypes import DynFlags @@ -415,13 +415,16 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls -- hand written instances of old Typeable as then unsafe casts could be -- performed. Derived instances are OK. ; dflags <- getDynFlags - ; when (safeLanguageOn dflags) $ - mapM_ (\x -> when (typInstCheck x) - (addErrAt (getSrcSpan $ iSpec x) typInstErr)) - local_infos + ; when (safeLanguageOn dflags) $ forM_ local_infos $ \x -> case x of + _ | typInstCheck x -> addErrAt (getSrcSpan $ iSpec x) (typInstErr x) + _ | genInstCheck x -> addErrAt (getSrcSpan $ iSpec x) (genInstErr x) + _ -> return () + -- As above but for Safe Inference mode. - ; when (safeInferOn dflags) $ - mapM_ (\x -> when (typInstCheck x) recordUnsafeInfer) local_infos + ; when (safeInferOn dflags) $ forM_ local_infos $ \x -> case x of + _ | typInstCheck x -> recordUnsafeInfer + _ | genInstCheck x -> recordUnsafeInfer + _ -> return () ; return ( gbl_env , bagToList deriv_inst_info ++ local_infos @@ -442,8 +445,16 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls else (typeableInsts, i:otherInsts) typInstCheck ty = is_cls_nm (iSpec ty) `elem` oldTypeableClassNames - typInstErr = ptext $ sLit $ "Can't create hand written instances of Typeable in Safe" - ++ " Haskell! Can only derive them" + typInstErr i = hang (ptext (sLit $ "Typeable instances can only be " + ++ "derived in Safe Haskell.") $+$ + ptext (sLit "Replace the following instance:")) + 2 (pprInstanceHdr (iSpec i)) + + genInstCheck ty = is_cls_nm (iSpec ty) `elem` genericClassNames + genInstErr i = hang (ptext (sLit $ "Generic instances can only be " + ++ "derived in Safe Haskell.") $+$ + ptext (sLit "Replace the following instance:")) + 2 (pprInstanceHdr (iSpec i)) instMsg i = hang (ptext (sLit $ "Typeable instances can only be derived; replace " ++ "the following instance:")) From git at git.haskell.org Sat Aug 2 02:05:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Aug 2014 02:05:37 +0000 (UTC) Subject: [commit: ghc] master: Allow warning if could have been infered safe instead of explicit Trustworthy label. (e69619e) Message-ID: <20140802020537.5A177240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e69619e923e84ae61a6bb4357f06862264daa94b/ghc >--------------------------------------------------------------- commit e69619e923e84ae61a6bb4357f06862264daa94b Author: David Terei Date: Tue Mar 18 15:45:54 2014 -0700 Allow warning if could have been infered safe instead of explicit Trustworthy label. >--------------------------------------------------------------- e69619e923e84ae61a6bb4357f06862264daa94b compiler/main/DynFlags.hs | 94 ++++++++++++---------- compiler/main/HscMain.hs | 53 ++++++------ compiler/main/HscTypes.lhs | 6 +- compiler/typecheck/TcRnMonad.lhs | 7 +- .../tests/safeHaskell/check/pkg01/safePkg01.stdout | 8 +- 5 files changed, 93 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 e69619e923e84ae61a6bb4357f06862264daa94b From git at git.haskell.org Sat Aug 2 02:05:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Aug 2014 02:05:40 +0000 (UTC) Subject: [commit: ghc] master: Add in (disabled for now) test of a Safe Haskell bug. (ab90bf2) Message-ID: <20140802020540.52D82240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ab90bf214bac86890b3533ff77272780828004e2/ghc >--------------------------------------------------------------- commit ab90bf214bac86890b3533ff77272780828004e2 Author: David Terei Date: Fri Aug 1 18:50:45 2014 -0700 Add in (disabled for now) test of a Safe Haskell bug. >--------------------------------------------------------------- ab90bf214bac86890b3533ff77272780828004e2 .../tests/safeHaskell/safeInfered/SafeInfered05.hs | 32 ++++++++++++++++++++++ .../safeHaskell/safeInfered/SafeInfered05_A.hs | 9 ++++++ testsuite/tests/safeHaskell/safeInfered/all.T | 5 ++++ 3 files changed, 46 insertions(+) diff --git a/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.hs b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.hs new file mode 100644 index 0000000..0b42002 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE Unsafe #-} +{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE FlexibleInstances #-} + +-- | +-- This module should actually fail to compile since we have the instances C +-- [Int] from the -XSafe module SafeInfered05_A overlapping as the most +-- specific instance the other instance C [a] from this module. This is in +-- violation of our single-origin-policy. +-- +-- Right now though, the above actually compiles fine but *this is a bug*. +-- Compiling module SafeInfered05_A with -XSafe has the right affect of causing +-- the compilation of module SafeInfered05 to then subsequently fail. So we +-- have a discrepancy between a safe-inferred module and a -XSafe module, which +-- there should not be. +-- +-- It does raise a question of if this bug should be fixed. Right now we've +-- designed Safe Haskell to be completely opt-in, even with safe-inference. +-- Fixing this of course changes this, causing safe-inference to alter the +-- compilation success of some cases. How common it is to have overlapping +-- declarations without -XOverlappingInstances specified needs to be tested. +-- +module SafeInfered05 where + +import safe SafeInfered05_A + +instance C [a] where + f _ = "[a]" + +test2 :: String +test2 = f ([1,2,3,4] :: [Int]) + diff --git a/testsuite/tests/safeHaskell/safeInfered/SafeInfered05_A.hs b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05_A.hs new file mode 100644 index 0000000..a1e12a6 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05_A.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE FlexibleInstances #-} +module SafeInfered05_A where + +class C a where + f :: a -> String + +instance C [Int] where + f _ = "[Int]" + diff --git a/testsuite/tests/safeHaskell/safeInfered/all.T b/testsuite/tests/safeHaskell/safeInfered/all.T index 9fb587b..a995c76 100644 --- a/testsuite/tests/safeHaskell/safeInfered/all.T +++ b/testsuite/tests/safeHaskell/safeInfered/all.T @@ -21,6 +21,11 @@ test('SafeInfered04', [ extra_clean(['SafeInfered04_A.hi', 'SafeInfered04_A.o']) ], multimod_compile, ['SafeInfered04', '']) +# Test should fail, tests an earlier bug in 7.8 +# test('SafeInfered05', +# [ extra_clean(['SafeInfered05_A.hi', 'SafeInfered05_A.o']) ], +# multimod_compile_fail, ['SafeInfered05', '']) + # Tests that should fail to compile as they should be infered unsafe test('UnsafeInfered01', [ extra_clean(['UnsafeInfered01_A.hi', 'UnsafeInfered01_A.o']) ], From git at git.haskell.org Sat Aug 2 02:05:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Aug 2014 02:05:42 +0000 (UTC) Subject: [commit: ghc] master: Infer safety of modules correctly with new overlapping pragmas. (fbd0586) Message-ID: <20140802020543.13BCD240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fbd0586ea55c753f6c81b592ae01e88e22f8f0cd/ghc >--------------------------------------------------------------- commit fbd0586ea55c753f6c81b592ae01e88e22f8f0cd Author: David Terei Date: Fri Aug 1 18:49:43 2014 -0700 Infer safety of modules correctly with new overlapping pragmas. >--------------------------------------------------------------- fbd0586ea55c753f6c81b592ae01e88e22f8f0cd compiler/typecheck/TcInstDcls.lhs | 3 +++ testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.hs | 10 ++++++++++ testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.hs | 10 ++++++++++ testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.hs | 10 ++++++++++ testsuite/tests/safeHaskell/safeInfered/all.T | 5 ++++- 5 files changed, 37 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index 6ff8a2b..2b123ff 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -424,6 +424,7 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls ; when (safeInferOn dflags) $ forM_ local_infos $ \x -> case x of _ | typInstCheck x -> recordUnsafeInfer _ | genInstCheck x -> recordUnsafeInfer + _ | overlapCheck x -> recordUnsafeInfer _ -> return () ; return ( gbl_env @@ -450,6 +451,8 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls ptext (sLit "Replace the following instance:")) 2 (pprInstanceHdr (iSpec i)) + overlapCheck ty = overlapMode (is_flag $ iSpec ty) `elem` + [Overlappable, Overlapping, Overlaps] genInstCheck ty = is_cls_nm (iSpec ty) `elem` genericClassNames genInstErr i = hang (ptext (sLit $ "Generic instances can only be " ++ "derived in Safe Haskell.") $+$ diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.hs new file mode 100644 index 0000000..defc3a5 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.hs @@ -0,0 +1,10 @@ +{-# OPTIONS_GHC -fwarn-unsafe -Werror #-} +{-# LANGUAGE FlexibleInstances #-} +module UnsafeInfered13 where + +class C a where + f :: a -> String + +instance {-# OVERLAPS #-} C a where + f _ = "a" + diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.hs new file mode 100644 index 0000000..5b9f642 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.hs @@ -0,0 +1,10 @@ +{-# OPTIONS_GHC -fwarn-unsafe -Werror #-} +{-# LANGUAGE FlexibleInstances #-} +module UnsafeInfered14 where + +class C a where + f :: a -> String + +instance {-# OVERLAPPABLE #-} C a where + f _ = "a" + diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.hs new file mode 100644 index 0000000..427c97b --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.hs @@ -0,0 +1,10 @@ +{-# OPTIONS_GHC -fwarn-unsafe -Werror #-} +{-# LANGUAGE FlexibleInstances #-} +module UnsafeInfered15 where + +class C a where + f :: a -> String + +instance {-# OVERLAPPING #-} C a where + f _ = "a" + diff --git a/testsuite/tests/safeHaskell/safeInfered/all.T b/testsuite/tests/safeHaskell/safeInfered/all.T index 47e9656..9fb587b 100644 --- a/testsuite/tests/safeHaskell/safeInfered/all.T +++ b/testsuite/tests/safeHaskell/safeInfered/all.T @@ -56,8 +56,11 @@ test('UnsafeInfered11', [ extra_clean(['UnsafeInfered11_A.hi', 'UnsafeInfered11_A.o']) ], multimod_compile_fail, ['UnsafeInfered11', '']) -# test should fail as unsafe and we made warn unsafe + -Werror +# Test should fail as unsafe and we made warn unsafe + -Werror test('UnsafeInfered12', normal, compile_fail, ['']) +test('UnsafeInfered13', normal, compile_fail, ['']) +test('UnsafeInfered14', normal, compile_fail, ['']) +test('UnsafeInfered15', normal, compile_fail, ['']) # Mixed tests test('Mixed01', normal, compile_fail, ['']) From git at git.haskell.org Sat Aug 2 08:02:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Aug 2014 08:02:14 +0000 (UTC) Subject: [commit: ghc] master: Add missing *.stderr files (f293931) Message-ID: <20140802080215.043FB240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f2939312851f3a328b99cc2b2743e645b6aa7bb8/ghc >--------------------------------------------------------------- commit f2939312851f3a328b99cc2b2743e645b6aa7bb8 Author: Joachim Breitner Date: Sat Aug 2 10:00:22 2014 +0200 Add missing *.stderr files which probably should have been added in commit fbd0586ea >--------------------------------------------------------------- f2939312851f3a328b99cc2b2743e645b6aa7bb8 testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.stderr | 7 +++++++ testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.stderr | 7 +++++++ testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.stderr | 7 +++++++ 3 files changed, 21 insertions(+) diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.stderr new file mode 100644 index 0000000..c545d40 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.stderr @@ -0,0 +1,7 @@ + +UnsafeInfered13.hs:1:16: Warning: + ?UnsafeInfered13? has been inferred as unsafe! + Reason: + +: +Failing due to -Werror. diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.stderr new file mode 100644 index 0000000..b7c41ac --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.stderr @@ -0,0 +1,7 @@ + +UnsafeInfered14.hs:1:16: Warning: + ?UnsafeInfered14? has been inferred as unsafe! + Reason: + +: +Failing due to -Werror. diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.stderr new file mode 100644 index 0000000..dbf2094 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.stderr @@ -0,0 +1,7 @@ + +UnsafeInfered15.hs:1:16: Warning: + ?UnsafeInfered15? has been inferred as unsafe! + Reason: + +: +Failing due to -Werror. From git at git.haskell.org Mon Aug 4 10:23:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Aug 2014 10:23:19 +0000 (UTC) Subject: [commit: packages/dph] master: Fix some Applicative-Monad stuff (c0ad10f) Message-ID: <20140804102319.598CE240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/dph On branch : master Link : http://git.haskell.org/packages/dph.git/commitdiff/c0ad10fc1a70d7fe32f4d679c44d1df0e761620b >--------------------------------------------------------------- commit c0ad10fc1a70d7fe32f4d679c44d1df0e761620b Author: Austin Seipp Date: Mon Aug 4 05:17:23 2014 -0500 Fix some Applicative-Monad stuff Signed-off-by: Austin Seipp >--------------------------------------------------------------- c0ad10fc1a70d7fe32f4d679c44d1df0e761620b dph-lifted-base/Data/Array/Parallel/PArray/Reference.hs | 2 +- dph-lifted-boxed/Data/Array/Parallel/PArray.hs | 2 +- .../Data/Array/Parallel/Unlifted/Distributed/Primitive/DistST.hs | 9 ++++++++- dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Vector.hs | 2 +- 4 files changed, 11 insertions(+), 4 deletions(-) diff --git a/dph-lifted-base/Data/Array/Parallel/PArray/Reference.hs b/dph-lifted-base/Data/Array/Parallel/PArray/Reference.hs index 3bcf736..a98ffdc 100644 --- a/dph-lifted-base/Data/Array/Parallel/PArray/Reference.hs +++ b/dph-lifted-base/Data/Array/Parallel/PArray/Reference.hs @@ -55,7 +55,7 @@ import Data.Array.Parallel.Base (Tag) import Data.Vector (Vector) import qualified Data.Array.Parallel.Unlifted as U import qualified Data.Vector as V -import Control.Monad +import Control.Monad hiding ( empty ) import Prelude hiding ( replicate, length, concat , enumFromTo diff --git a/dph-lifted-boxed/Data/Array/Parallel/PArray.hs b/dph-lifted-boxed/Data/Array/Parallel/PArray.hs index d19b795..3b6b6f1 100644 --- a/dph-lifted-boxed/Data/Array/Parallel/PArray.hs +++ b/dph-lifted-boxed/Data/Array/Parallel/PArray.hs @@ -59,7 +59,7 @@ import Data.Vector (Vector) import qualified Data.Array.Parallel.Unlifted as U import qualified Data.Array.Parallel.Array as A import qualified Data.Vector as V -import Control.Monad +import Control.Monad hiding (empty) import GHC.Exts (Int(I#), (+#)) import qualified Prelude as P import Prelude hiding diff --git a/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Primitive/DistST.hs b/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Primitive/DistST.hs index a41ad5b..cdabbda 100644 --- a/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Primitive/DistST.hs +++ b/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Primitive/DistST.hs @@ -31,7 +31,7 @@ import Data.Array.Parallel.Unlifted.Distributed.Primitive.DT import Data.Array.Parallel.Unlifted.Distributed.Primitive.Gang import Data.Array.Parallel.Unlifted.Distributed.Data.Tuple import Data.Array.Parallel.Base (ST, runST) -import Control.Monad (liftM) +import Control.Monad (liftM, ap) -- | Data-parallel computations. @@ -40,6 +40,13 @@ import Control.Monad (liftM) -- then we can make a regular ST computation. newtype DistST s a = DistST { unDistST :: Int -> ST s a } +instance Functor (DistST s) where + fmap = liftM + +instance Applicative (DistST s) where + pure = return + (<*>) = ap + instance Monad (DistST s) where {-# INLINE return #-} return = DistST . const . return diff --git a/dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Vector.hs b/dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Vector.hs index e7d45b2..20b6170 100644 --- a/dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Vector.hs +++ b/dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Vector.hs @@ -133,7 +133,7 @@ import qualified Prelude import qualified System.Random as R import Foreign hiding ( new ) import System.IO -import Control.Monad +import Control.Monad hiding (empty) here s = "Data.Array.Parallel.Unlifted.Sequential.Flat." Prelude.++ s From git at git.haskell.org Mon Aug 4 13:13:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Aug 2014 13:13:02 +0000 (UTC) Subject: [commit: ghc] master: Terminate in forkProcess like in real_main (44853a1) Message-ID: <20140804131302.5F513240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/44853a157a394bf00d1fdfff1926a6d178d8018c/ghc >--------------------------------------------------------------- commit 44853a157a394bf00d1fdfff1926a6d178d8018c Author: Edsko de Vries Date: Mon Aug 4 08:09:11 2014 -0500 Terminate in forkProcess like in real_main Test Plan: validate Reviewers: simonmar, austin Reviewed By: simonmar, austin Subscribers: phaskell, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D99 GHC Trac Issues: #9377 >--------------------------------------------------------------- 44853a157a394bf00d1fdfff1926a6d178d8018c rts/Schedule.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index 140221b..ad1cffc 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1937,8 +1937,7 @@ forkProcess(HsStablePtr *entry rts_checkSchedStatus("forkProcess",cap); rts_unlock(cap); - hs_exit(); // clean up and exit - stg_exit(EXIT_SUCCESS); + shutdownHaskellAndExit(EXIT_SUCCESS, 0 /* !fastExit */); } #else /* !FORKPROCESS_PRIMOP_SUPPORTED */ barf("forkProcess#: primop not supported on this platform, sorry!\n"); From git at git.haskell.org Mon Aug 4 13:13:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Aug 2014 13:13:04 +0000 (UTC) Subject: [commit: ghc] master: docs: fix typo: 'OVERLAPPINGP' -> 'OVERLAPPING' (df1e775) Message-ID: <20140804131304.F2B6F240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/df1e77504b1c187415aa4e28c8912897064139b2/ghc >--------------------------------------------------------------- commit df1e77504b1c187415aa4e28c8912897064139b2 Author: Sergei Trofimovich Date: Mon Aug 4 08:09:29 2014 -0500 docs: fix typo: 'OVERLAPPINGP' -> 'OVERLAPPING' Summary: Signed-off-by: Sergei Trofimovich Test Plan: proofread Reviewers: ezyang, austin Reviewed By: ezyang, austin Subscribers: phaskell, ezyang, simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D100 >--------------------------------------------------------------- df1e77504b1c187415aa4e28c8912897064139b2 docs/users_guide/glasgow_exts.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 84d6a62..3d2e634 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -10805,7 +10805,7 @@ data T = T {-# NOUNPACK #-} !(Int,Int) -OVERLAPPINGP, OVERLAPPABLE, OVERLAPS, and INCOHERENT pragmas +OVERLAPPING, OVERLAPPABLE, OVERLAPS, and INCOHERENT pragmas The pragmas OVERLAPPING, From git at git.haskell.org Mon Aug 4 13:13:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Aug 2014 13:13:08 +0000 (UTC) Subject: [commit: ghc] master: Use 'install' command for 'inplace/' install as we do in 'make install' (637978f) Message-ID: <20140804131308.09CB4240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/637978fa8a7dae97ff67551cb9d5c8fc3ac0fa9d/ghc >--------------------------------------------------------------- commit 637978fa8a7dae97ff67551cb9d5c8fc3ac0fa9d Author: Sergei Trofimovich Date: Mon Aug 4 08:09:44 2014 -0500 Use 'install' command for 'inplace/' install as we do in 'make install' Summary: On hardened gentoo ghc-stage2 does not work as-is, as it uses runtime code generation/loading, thus ghc0stage2 needs to be marked in a special way (via POSIX extened attributes). Before the patch we used 'cp -p' command, which does not preserve that marking. It leads to buid failure on hardened. Hardened's 'install' does preserve POSIX xattrs, thus patch uses it instead. 'inplace/' directory can be seen the same way as target for 'make install', thus using the same facilities to install files to 'inplace/' sounds more consistent. Reported-by: Jay Yang Gentoo-bug: https://bugs.gentoo.org/518734 Signed-off-by: Sergei Trofimovich Test Plan: tested ghc installation on vanilla and hardened distributions Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D108 >--------------------------------------------------------------- 637978fa8a7dae97ff67551cb9d5c8fc3ac0fa9d rules/build-prog.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rules/build-prog.mk b/rules/build-prog.mk index 399369e..ba1fa00 100644 --- a/rules/build-prog.mk +++ b/rules/build-prog.mk @@ -286,7 +286,7 @@ endif ifeq "$(findstring clean,$(MAKECMDGOALS))" "" ifeq "$$($1_$2_INSTALL_INPLACE)" "YES" $$($1_$2_INPLACE) : $1/$2/build/tmp/$$($1_$2_PROG_INPLACE) | $$$$(dir $$$$@)/. - "$$(CP)" -p $$< $$@ + $$(INSTALL) -m 755 $$< $$@ endif endif From git at git.haskell.org Mon Aug 4 13:13:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Aug 2014 13:13:10 +0000 (UTC) Subject: [commit: ghc] master: fix linker_unload test on Solaris/i386 platform (65e5dbc) Message-ID: <20140804131310.998CE240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/65e5dbcd3971cb3ef5b9073096e5d063034b90c1/ghc >--------------------------------------------------------------- commit 65e5dbcd3971cb3ef5b9073096e5d063034b90c1 Author: Karel Gardas Date: Mon Aug 4 08:10:11 2014 -0500 fix linker_unload test on Solaris/i386 platform Summary: This patch set fixes two issues in linker_unload test case on Solaris/i386 platform. First there is an issue in linker_unload.c which causes warning to be emitted about _FILE_OFFSET_BITS redefined. This is solved by including ghcconfig.h as a first header file. Another issue is that on Solaris and its builders we use to configure ghc with --with-gmp-libraries=/usr/lib and this causes issue with test case Makefile's logic. It attempts to start linker_unload and pass it HSinteger-gmp library for unload, but the library name is prefixed with two directories names. The first is of ghc's integer-gmp/build itself and another is the directory name passed to --with-gmp-libraries= configure parameter. In case of Solaris this is /usr/lib. The testcase then fails on unloading integer-gmp/build directory thinking that this is a library to unload. This issue is solved by cuting the first library name from the list and using this for unloading the HSinteger-gmp library. Test Plan: validate Reviewers: ezyang, austin Reviewed By: ezyang, austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D110 >--------------------------------------------------------------- 65e5dbcd3971cb3ef5b9073096e5d063034b90c1 testsuite/tests/rts/Makefile | 4 +++- testsuite/tests/rts/linker_unload.c | 1 + 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile index 180fe9b..8833d45 100644 --- a/testsuite/tests/rts/Makefile +++ b/testsuite/tests/rts/Makefile @@ -108,7 +108,9 @@ BASE_DIR = $(shell $(LOCAL_GHC_PKG) field base library-dirs | sed 's/^.*: *//') BASE_LIB = $(shell $(LOCAL_GHC_PKG) field base hs-libraries | sed 's/^.*: *//') GHC_PRIM_DIR = $(shell $(LOCAL_GHC_PKG) field ghc-prim library-dirs | sed 's/^.*: *//') GHC_PRIM_LIB = $(shell $(LOCAL_GHC_PKG) field ghc-prim hs-libraries | sed 's/^.*: *//') -INTEGER_GMP_DIR = $(shell $(LOCAL_GHC_PKG) field integer-gmp library-dirs | sed 's/^.*: *//') +# need to cut here in order to get rid of system gmp library directory installation when +# ghc is configured with --with-gmp-libraries= parameter +INTEGER_GMP_DIR = $(shell $(LOCAL_GHC_PKG) field integer-gmp library-dirs | sed 's/^.*: *//' | cut -d ' ' -f -1) INTEGER_GMP_LIB = $(shell $(LOCAL_GHC_PKG) field integer-gmp hs-libraries | sed 's/^.*: *//') BASE = $(BASE_DIR)/lib$(BASE_LIB).a diff --git a/testsuite/tests/rts/linker_unload.c b/testsuite/tests/rts/linker_unload.c index 55870c3..f1cc891 100644 --- a/testsuite/tests/rts/linker_unload.c +++ b/testsuite/tests/rts/linker_unload.c @@ -1,3 +1,4 @@ +#include "ghcconfig.h" #include #include #include "Rts.h" From git at git.haskell.org Mon Aug 4 13:13:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Aug 2014 13:13:13 +0000 (UTC) Subject: [commit: ghc] master: ghc --make: add nicer names to RTS threads (threaded IO manager, make workers) (f686682) Message-ID: <20140804131313.1D834240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f6866824ce5cdf5359f0cad78c49d65f6d43af12/ghc >--------------------------------------------------------------- commit f6866824ce5cdf5359f0cad78c49d65f6d43af12 Author: Sergei Trofimovich Date: Mon Aug 4 08:10:33 2014 -0500 ghc --make: add nicer names to RTS threads (threaded IO manager, make workers) Summary: The patch names most of RTS threads and ghc (the tool) threads. It makes nicer debug and eventlog output for ghc itself. Signed-off-by: Sergei Trofimovich Test Plan: ran debugged ghc under '+RTS -Ds' Reviewers: simonmar, austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D101 >--------------------------------------------------------------- f6866824ce5cdf5359f0cad78c49d65f6d43af12 compiler/main/GhcMake.hs | 14 ++++++++++++++ libraries/base/GHC/Event/Thread.hs | 8 ++++++-- 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 33f163c..0c63203 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -63,6 +63,7 @@ import qualified Data.Set as Set import qualified FiniteMap as Map ( insertListWith ) import Control.Concurrent ( forkIOWithUnmask, killThread ) +import qualified GHC.Conc as CC import Control.Concurrent.MVar import Control.Concurrent.QSem import Control.Exception @@ -80,6 +81,11 @@ import System.IO.Error ( isDoesNotExistError ) import GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities ) +label_self :: String -> IO () +label_self thread_name = do + self_tid <- CC.myThreadId + CC.labelThread self_tid thread_name + -- ----------------------------------------------------------------------------- -- Loading the program @@ -744,10 +750,18 @@ parUpsweep n_jobs old_hpt stable_mods cleanup sccs = do | ((ms,mvar,_),idx) <- comp_graph_w_idx ] + liftIO $ label_self "main --make thread" -- For each module in the module graph, spawn a worker thread that will -- compile this module. let { spawnWorkers = forM comp_graph_w_idx $ \((mod,!mvar,!log_queue),!mod_idx) -> forkIOWithUnmask $ \unmask -> do + liftIO $ label_self $ unwords + [ "worker --make thread" + , "for module" + , show (moduleNameString (ms_mod_name mod)) + , "number" + , show mod_idx + ] -- Replace the default log_action with one that writes each -- message to the module's log_queue. The main thread will -- deal with synchronously printing these messages. diff --git a/libraries/base/GHC/Event/Thread.hs b/libraries/base/GHC/Event/Thread.hs index 6e991bf..dcfa32a 100644 --- a/libraries/base/GHC/Event/Thread.hs +++ b/libraries/base/GHC/Event/Thread.hs @@ -39,6 +39,7 @@ import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop, import qualified GHC.Event.Manager as M import qualified GHC.Event.TimerManager as TM import GHC.Num ((-), (+)) +import GHC.Show (showSignedInt) import System.IO.Unsafe (unsafePerformIO) import System.Posix.Types (Fd) @@ -244,11 +245,14 @@ startIOManagerThreads = forM_ [0..high] (startIOManagerThread eventManagerArray) writeIORef numEnabledEventManagers (high+1) +show_int :: Int -> String +show_int i = showSignedInt 0 i "" + restartPollLoop :: EventManager -> Int -> IO ThreadId restartPollLoop mgr i = do M.release mgr !t <- forkOn i $ loop mgr - labelThread t "IOManager" + labelThread t ("IOManager on cap " ++ show_int i) return t startIOManagerThread :: IOArray Int (Maybe (ThreadId, EventManager)) @@ -258,7 +262,7 @@ startIOManagerThread eventManagerArray i = do let create = do !mgr <- new True !t <- forkOn i $ loop mgr - labelThread t "IOManager" + labelThread t ("IOManager on cap " ++ show_int i) writeIOArray eventManagerArray i (Just (t,mgr)) old <- readIOArray eventManagerArray i case old of From git at git.haskell.org Mon Aug 4 13:16:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Aug 2014 13:16:19 +0000 (UTC) Subject: [commit: ghc] master: fix openFile003 test on Solaris/i386 (platform output is not needed anymore) (7328deb) Message-ID: <20140804131619.878D0240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7328deb691c4aed06db8aecc84d0119ef633ab78/ghc >--------------------------------------------------------------- commit 7328deb691c4aed06db8aecc84d0119ef633ab78 Author: Karel Gardas Date: Mon Aug 4 08:15:39 2014 -0500 fix openFile003 test on Solaris/i386 (platform output is not needed anymore) Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D114 >--------------------------------------------------------------- 7328deb691c4aed06db8aecc84d0119ef633ab78 libraries/base/tests/IO/openFile003.stdout-i386-unknown-solaris2 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/libraries/base/tests/IO/openFile003.stdout-i386-unknown-solaris2 b/libraries/base/tests/IO/openFile003.stdout-i386-unknown-solaris2 deleted file mode 100644 index 6a78a2a..0000000 --- a/libraries/base/tests/IO/openFile003.stdout-i386-unknown-solaris2 +++ /dev/null @@ -1,4 +0,0 @@ -Left openFile003Dir: openFile: inappropriate type (is a directory) -Left openFile003Dir: openFile: invalid argument (Invalid argument) -Left openFile003Dir: openFile: invalid argument (Invalid argument) -Left openFile003Dir: openFile: invalid argument (Invalid argument) From git at git.haskell.org Mon Aug 4 13:16:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Aug 2014 13:16:21 +0000 (UTC) Subject: [commit: ghc] master: fix topHandler03 execution on Solaris where shell signals SIGTERM correctly (1f24a03) Message-ID: <20140804131622.044AD240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f24a03234a6b0bb0e38a47a471ef3004ce858d0/ghc >--------------------------------------------------------------- commit 1f24a03234a6b0bb0e38a47a471ef3004ce858d0 Author: Karel Gardas Date: Mon Aug 4 08:15:54 2014 -0500 fix topHandler03 execution on Solaris where shell signals SIGTERM correctly Summary: This patch fixes topHandler03 execution on Solaris where shell correctly signals SIGTERM as exit status 15. Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D112 >--------------------------------------------------------------- 1f24a03234a6b0bb0e38a47a471ef3004ce858d0 libraries/base/tests/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 12a2410..c85d7bc 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -152,7 +152,8 @@ test('topHandler03', [when(opsys('mingw32'), skip), # As above, shells, grrr. ignore_output, - exit_code(143) # actually signal 15 SIGTERM + when(opsys('solaris2'), exit_code(15)), # Solaris signals 15 correctly + when(not opsys('solaris2'), exit_code(143)) # actually signal 15 SIGTERM ], compile_and_run, ['']) From git at git.haskell.org Mon Aug 4 13:21:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Aug 2014 13:21:04 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Avoid deadlock in freeTask (called by forkProcess) (8a6528e) Message-ID: <20140804132104.63058240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/8a6528e92aacc3f676f37536ebe3501046d9a774/ghc >--------------------------------------------------------------- commit 8a6528e92aacc3f676f37536ebe3501046d9a774 Author: Edsko de Vries Date: Sun Jul 13 15:19:39 2014 -0500 Avoid deadlock in freeTask (called by forkProcess) Summary: Documented in more detail inline with the change. Test Plan: validate Reviewers: austin, simonmar, duncan Reviewed By: austin, simonmar, duncan Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D59 (cherry picked from commit 39630ab15cc0607103dc4ef3d9089de44ef17c2d) >--------------------------------------------------------------- 8a6528e92aacc3f676f37536ebe3501046d9a774 rts/Task.c | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/rts/Task.c b/rts/Task.c index 12c22c4..e191bd0 100644 --- a/rts/Task.c +++ b/rts/Task.c @@ -350,6 +350,20 @@ discardTasksExcept (Task *keep) next = task->all_next; if (task != keep) { debugTrace(DEBUG_sched, "discarding task %" FMT_SizeT "", (size_t)TASK_ID(task)); +#if defined(THREADED_RTS) + // It is possible that some of these tasks are currently blocked + // (in the parent process) either on their condition variable + // `cond` or on their mutex `lock`. If they are we may deadlock + // when `freeTask` attempts to call `closeCondition` or + // `closeMutex` (the behaviour of these functions is documented to + // be undefined in the case that there are threads blocked on + // them). To avoid this, we re-initialize both the condition + // variable and the mutex before calling `freeTask` (we do + // precisely the same for all global locks in `forkProcess`). + initCondition(&task->cond); + initMutex(&task->lock); +#endif + // Note that we do not traceTaskDelete here because // we are not really deleting a task. // The OS threads for all these tasks do not exist in From git at git.haskell.org Mon Aug 4 13:21:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Aug 2014 13:21:06 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Acquire all_tasks_mutex in forkProcess (1fc3baf) Message-ID: <20140804132106.C36B4240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/1fc3baf3476a0105b10598c56d4efe3831fb5300/ghc >--------------------------------------------------------------- commit 1fc3baf3476a0105b10598c56d4efe3831fb5300 Author: Edsko de Vries Date: Sun Jul 13 15:19:45 2014 -0500 Acquire all_tasks_mutex in forkProcess Summary: (for the same reason that we acquire all the other mutexes) Test Plan: validate Reviewers: simonmar, austin, duncan Reviewed By: simonmar, austin, duncan Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D60 (cherry picked from commit 16403f0d182d2d3d0b1fbe5ad778ead4bfcb7e16) >--------------------------------------------------------------- 1fc3baf3476a0105b10598c56d4efe3831fb5300 rts/Schedule.c | 11 +++++++++++ rts/Task.c | 2 +- rts/Task.h | 5 +++++ 3 files changed, 17 insertions(+), 1 deletion(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index adf2b5c..7f8ced6 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1802,6 +1802,10 @@ forkProcess(HsStablePtr *entry ACQUIRE_LOCK(&capabilities[i]->lock); } +#ifdef THREADED_RTS + ACQUIRE_LOCK(&all_tasks_mutex); +#endif + stopTimer(); // See #4074 #if defined(TRACING) @@ -1823,6 +1827,11 @@ forkProcess(HsStablePtr *entry releaseCapability_(capabilities[i],rtsFalse); RELEASE_LOCK(&capabilities[i]->lock); } + +#ifdef THREADED_RTS + RELEASE_LOCK(&all_tasks_mutex); +#endif + boundTaskExiting(task); // just return the pid @@ -1839,6 +1848,8 @@ forkProcess(HsStablePtr *entry for (i=0; i < n_capabilities; i++) { initMutex(&capabilities[i]->lock); } + + initMutex(&all_tasks_mutex); #endif #ifdef TRACING diff --git a/rts/Task.c b/rts/Task.c index e191bd0..842ad84 100644 --- a/rts/Task.c +++ b/rts/Task.c @@ -39,7 +39,7 @@ static Task * allocTask (void); static Task * newTask (rtsBool); #if defined(THREADED_RTS) -static Mutex all_tasks_mutex; +Mutex all_tasks_mutex; #endif /* ----------------------------------------------------------------------------- diff --git a/rts/Task.h b/rts/Task.h index cf70256..8dab0a2 100644 --- a/rts/Task.h +++ b/rts/Task.h @@ -171,6 +171,11 @@ isBoundTask (Task *task) // extern Task *all_tasks; +// The all_tasks list is protected by the all_tasks_mutex +#if defined(THREADED_RTS) +extern Mutex all_tasks_mutex; +#endif + // Start and stop the task manager. // Requires: sched_mutex. // From git at git.haskell.org Mon Aug 4 13:21:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Aug 2014 13:21:09 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Allow multiple entry points when allocating recursive groups (#9303) (13a651d) Message-ID: <20140804132109.8656F240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/13a651df7b6cf3a26e9a41e4a9d84c1015408af5/ghc >--------------------------------------------------------------- commit 13a651df7b6cf3a26e9a41e4a9d84c1015408af5 Author: Simon Marlow Date: Tue Jul 22 12:04:32 2014 +0100 Allow multiple entry points when allocating recursive groups (#9303) Summary: In this example we ended up with some code that was only reachable via an info table, because a branch had been optimised away by the native code generator. The register allocator then got confused because it was only considering the first block of the proc to be an entry point, when actually any of the info tables are entry points. Test Plan: validate Reviewers: simonpj, austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D88 (cherry picked from commit da70f9ef49a545707dc32db9662441b9c8845fba) >--------------------------------------------------------------- 13a651df7b6cf3a26e9a41e4a9d84c1015408af5 compiler/nativeGen/RegAlloc/Linear/Main.hs | 48 ++++++++++++------------- compiler/nativeGen/RegAlloc/Liveness.hs | 26 ++++++++------ testsuite/tests/codeGen/should_compile/T9303.hs | 10 ++++++ testsuite/tests/codeGen/should_compile/all.T | 1 + 4 files changed, 50 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 13a651df7b6cf3a26e9a41e4a9d84c1015408af5 From git at git.haskell.org Mon Aug 4 13:21:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Aug 2014 13:21:12 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: A panic in CmmBuildInfoTables.bundle shouldn't be a panic (#9329) (0a27505) Message-ID: <20140804132112.0A341240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/0a275059e2e909c99857de9fe640070d4ed797c0/ghc >--------------------------------------------------------------- commit 0a275059e2e909c99857de9fe640070d4ed797c0 Author: Simon Marlow Date: Thu Jul 31 11:47:16 2014 +0100 A panic in CmmBuildInfoTables.bundle shouldn't be a panic (#9329) Summary: This code needs more comments, but I believe this is safe. By definition I can't have broken anything that was working by turning a panic into a non-panic anyway. Test Plan: validate Reviewers: hvr, simonpj, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D105 GHC Trac Issues: #9329 (cherry picked from commit 2989ffdcb88ab24e8a4e8b3d0454497a0db2652c) >--------------------------------------------------------------- 0a275059e2e909c99857de9fe640070d4ed797c0 compiler/cmm/CmmBuildInfoTables.hs | 12 ++++++++---- testsuite/tests/codeGen/should_compile/T9329.cmm | 5 +++++ testsuite/tests/codeGen/should_compile/all.T | 1 + 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs index 04c3b71..4974e9e 100644 --- a/compiler/cmm/CmmBuildInfoTables.hs +++ b/compiler/cmm/CmmBuildInfoTables.hs @@ -290,7 +290,7 @@ bundle :: Map CLabel CAFSet -> (CAFEnv, CmmDecl) -> (CAFSet, Maybe CLabel) -> (BlockEnv CAFSet, CmmDecl) -bundle flatmap (env, decl@(CmmProc infos lbl _ g)) (closure_cafs, mb_lbl) +bundle flatmap (env, decl@(CmmProc infos _lbl _ g)) (closure_cafs, mb_lbl) = ( mapMapWithKey get_cafs (info_tbls infos), decl ) where entry = g_entry g @@ -301,9 +301,13 @@ bundle flatmap (env, decl@(CmmProc infos lbl _ g)) (closure_cafs, mb_lbl) get_cafs l _ | l == entry = entry_cafs - | otherwise = if not (mapMember l env) - then pprPanic "bundle" (ppr l <+> ppr lbl <+> ppr (info_tbls infos) $$ ppr env $$ ppr decl) - else flatten flatmap $ expectJust "bundle" $ mapLookup l env + | Just info <- mapLookup l env = flatten flatmap info + | otherwise = Set.empty + -- the label might not be in the env if the code corresponding to + -- this info table was optimised away (perhaps because it was + -- unreachable). In this case it doesn't matter what SRT we + -- infer, since the info table will not appear in the generated + -- code. See #9329. bundle _flatmap (_, decl) _ = ( mapEmpty, decl ) diff --git a/testsuite/tests/codeGen/should_compile/T9329.cmm b/testsuite/tests/codeGen/should_compile/T9329.cmm new file mode 100644 index 0000000..da20069 --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T9329.cmm @@ -0,0 +1,5 @@ +foo () +{ + STK_CHK_GEN_N (8); /* panics */ + return (0); +} diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index a3020fe..a6b6894 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -24,3 +24,4 @@ test('T7574', [cmm_src, omit_ways(['llvm', 'optllvm'])], compile, ['']) test('T8205', normal, compile, ['-O0']) test('T9155', normal, compile, ['-O2']) test('T9303', normal, compile, ['-O2']) +test('T9329', [cmm_src], compile, ['']) From git at git.haskell.org Mon Aug 4 13:21:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Aug 2014 13:21:14 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: interruptible() was not returning true for BlockedOnSTM (#9379) (c1042cc) Message-ID: <20140804132115.182DD240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/c1042cc19b688e56c5f28e600bc963365c029fbb/ghc >--------------------------------------------------------------- commit c1042cc19b688e56c5f28e600bc963365c029fbb Author: Simon Marlow Date: Thu Jul 31 10:00:16 2014 +0100 interruptible() was not returning true for BlockedOnSTM (#9379) Summary: There's an knock-on fix in HeapStackCheck.c which is potentially scary, but I'm pretty confident is OK. See comment for details. Test Plan: I've run all the STM tests I can find, including libraries/stm/tests/stm049 with +RTS -N8 and some of the constants bumped to make it more of a stress test. Reviewers: hvr, rwbarton, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D104 GHC Trac Issues: #9379 (cherry picked from commit 9d9a55469719908bbd5cd3277e0ac79c0588dc55) >--------------------------------------------------------------- c1042cc19b688e56c5f28e600bc963365c029fbb rts/HeapStackCheck.cmm | 25 ++++++++++++++++++------- rts/RaiseAsync.h | 1 + testsuite/tests/concurrent/should_run/T9379.hs | 17 +++++++++++++++++ testsuite/tests/concurrent/should_run/all.T | 2 ++ 4 files changed, 38 insertions(+), 7 deletions(-) diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm index 12bcfb2..f090bff 100644 --- a/rts/HeapStackCheck.cmm +++ b/rts/HeapStackCheck.cmm @@ -681,13 +681,24 @@ stg_block_async_void STM-specific waiting -------------------------------------------------------------------------- */ -stg_block_stmwait_finally -{ - ccall stmWaitUnlock(MyCapability() "ptr", R3 "ptr"); - jump StgReturn [R1]; -} - stg_block_stmwait { - BLOCK_BUT_FIRST(stg_block_stmwait_finally); + // When blocking on an MVar we have to be careful to only release + // the lock on the MVar at the very last moment (using + // BLOCK_BUT_FIRST()), since when we release the lock another + // Capability can wake up the thread, which modifies its stack and + // other state. This is not a problem for STM, because STM + // wakeups are non-destructive; the waker simply calls + // tryWakeupThread() which sends a message to the owner + // Capability. So the moment we release this lock we might start + // getting wakeup messages, but that's perfectly harmless. + // + // Furthermore, we *must* release these locks, just in case an + // exception is raised in this thread by + // maybePerformBlockedException() while exiting to the scheduler, + // which will abort the transaction, which needs to obtain a lock + // on all the TVars to remove the thread from the queues. + // + ccall stmWaitUnlock(MyCapability() "ptr", R3 "ptr"); + BLOCK_GENERIC; } diff --git a/rts/RaiseAsync.h b/rts/RaiseAsync.h index 1f61b8c..3da9e7b 100644 --- a/rts/RaiseAsync.h +++ b/rts/RaiseAsync.h @@ -52,6 +52,7 @@ interruptible(StgTSO *t) { switch (t->why_blocked) { case BlockedOnMVar: + case BlockedOnSTM: case BlockedOnMVarRead: case BlockedOnMsgThrowTo: case BlockedOnRead: diff --git a/testsuite/tests/concurrent/should_run/T9379.hs b/testsuite/tests/concurrent/should_run/T9379.hs new file mode 100644 index 0000000..49e6d1e --- /dev/null +++ b/testsuite/tests/concurrent/should_run/T9379.hs @@ -0,0 +1,17 @@ +import Control.Exception +import Control.Concurrent +import Control.Concurrent.STM +import Foreign.StablePtr + +main :: IO () +main = do + tv <- atomically $ newTVar True + _ <- newStablePtr tv + t <- mask_ $ forkIO (blockSTM tv) + killThread t + +blockSTM :: TVar Bool -> IO () +blockSTM tv = do + atomically $ do + v <- readTVar tv + check $ not v diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 0b502c3..3fcc2b1 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -82,6 +82,8 @@ test('tryReadMVar2', normal, compile_and_run, ['']) test('T7970', normal, compile_and_run, ['']) +test('T9379', normal, compile_and_run, ['']) + # ----------------------------------------------------------------------------- # These tests we only do for a full run From git at git.haskell.org Tue Aug 5 10:15:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Aug 2014 10:15:30 +0000 (UTC) Subject: [commit: ghc] master: Disable package auto-hiding if -hide-all-packages is passed (edff1ef) Message-ID: <20140805101530.91DC0240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/edff1efa74edcfa9db0010ae92e1e159ecb60b7e/ghc >--------------------------------------------------------------- commit edff1efa74edcfa9db0010ae92e1e159ecb60b7e Author: Edward Z. Yang Date: Thu Jul 31 18:11:22 2014 +0100 Disable package auto-hiding if -hide-all-packages is passed Summary: This is in preparation for thinning/renaming package arguments, which allow users to rename modules of packages they import. In situations like this, it may be desirable to load multiple copies of a package at different versions explicitly under different names. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, simonmar, hvr, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D106 >--------------------------------------------------------------- edff1efa74edcfa9db0010ae92e1e159ecb60b7e compiler/main/Packages.lhs | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index c240956e..5973bc5 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -78,12 +78,18 @@ import qualified Data.Set as Set -- provide. -- -- The package state is computed by 'initPackages', and kept in DynFlags. +-- It is influenced by various package flags: -- --- * @-package @ causes @@ to become exposed, and all other packages --- with the same name to become hidden. +-- * @-package @ and @-package-id @ cause @@ to become exposed. +-- If @-hide-all-packages@ was not specified, these commands also cause +-- all other packages with the same name to become hidden. -- -- * @-hide-package @ causes @@ to become hidden. -- +-- * (there are a few more flags, check below for their semantics) +-- +-- The package state has the following properties. +-- -- * Let @exposedPackages@ be the set of packages thus exposed. -- Let @depExposedPackages@ be the transitive closure from @exposedPackages@ of -- their dependencies. @@ -401,9 +407,12 @@ applyPackageFlag dflags unusable pkgs flag = where -- When a package is requested to be exposed, we hide all other - -- packages with the same name. + -- packages with the same name if -hide-all-packages was not specified. + -- If it was specified, we expect users to not try to expose a package + -- multiple times, so don't hide things. hideAll name ps = map maybe_hide ps where maybe_hide p + | gopt Opt_HideAllPackages dflags = p | pkgName (sourcePackageId p) == name = p {exposed=False} | otherwise = p @@ -475,10 +484,12 @@ packageFlagErr dflags flag reasons -- that is already exposed. This just makes it non-fatal to have two -- versions of a package exposed, which can happen if you install a -- later version of a package in the user database, for example. +-- However, don't do this if @-hide-all-packages@ was passed. -- hideOldPackages :: DynFlags -> [PackageConfig] -> IO [PackageConfig] hideOldPackages dflags pkgs = mapM maybe_hide pkgs where maybe_hide p + | gopt Opt_HideAllPackages dflags = return p | not (exposed p) = return p | (p' : _) <- later_versions = do debugTraceMsg dflags 2 $ From git at git.haskell.org Tue Aug 5 10:15:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Aug 2014 10:15:33 +0000 (UTC) Subject: [commit: ghc] master: Package keys (for linking/type equality) separated from package IDs. (66218d1) Message-ID: <20140805101533.DDA97240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/66218d15b7c27a4a38992003bd761f60bae84b1f/ghc >--------------------------------------------------------------- commit 66218d15b7c27a4a38992003bd761f60bae84b1f Author: Edward Z. Yang Date: Fri Jul 18 14:48:47 2014 +0100 Package keys (for linking/type equality) separated from package IDs. This patch set makes us no longer assume that a package key is a human readable string, leaving Cabal free to "do whatever it wants" to allocate keys; we'll look up the PackageId in the database to display to the user. This also means we have a new level of qualifier decisions to make at the package level, and rewriting some Safe Haskell error reporting code to DTRT. Additionally, we adjust the build system to use a new ghc-cabal output Make variable PACKAGE_KEY to determine library names and other things, rather than concatenating PACKAGE/VERSION as before. Adds a new `-this-package-key` flag to subsume the old, erroneously named `-package-name` flag, and `-package-key` to select packages by package key. RFC: The md5 hashes are pretty tough on the eye, as far as the file system is concerned :( ToDo: safePkg01 test had its output updated, but the fix is not really right: the rest of the dependencies are truncated due to the fact the we're only grepping a single line, but ghc-pkg is wrapping its output. ToDo: In a later commit, update all submodules to stop using -package-name and use -this-package-key. For now, we don't do it to avoid submodule explosion. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, simonmar, hvr, austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D80 >--------------------------------------------------------------- 66218d15b7c27a4a38992003bd761f60bae84b1f compiler/basicTypes/Module.lhs | 26 +++++++- compiler/ghc.cabal.in | 4 +- compiler/ghc.mk | 6 ++ compiler/ghci/Linker.lhs | 2 +- compiler/iface/LoadIface.lhs | 2 + compiler/llvmGen/LlvmCodeGen/Base.hs | 2 +- compiler/main/DynFlags.hs | 18 ++++-- compiler/main/Finder.lhs | 2 +- compiler/main/HscMain.hs | 13 +++- compiler/main/HscTypes.lhs | 55 +++++++++++++++-- compiler/main/PackageConfig.hs | 19 +++--- compiler/main/Packages.lhs | 59 ++++++++++++------ compiler/main/Packages.lhs-boot | 4 ++ compiler/utils/Outputable.lhs | 61 +++++++++++++++---- docs/users_guide/flags.xml | 2 +- docs/users_guide/packages.xml | 18 +++--- ghc.mk | 6 +- ghc/InteractiveUI.hs | 5 +- libraries/Cabal | 2 +- libraries/base/base.cabal | 4 +- .../Distribution/InstalledPackageInfo/Binary.hs | 11 ++++ libraries/ghc-prim/ghc-prim.cabal | 4 +- libraries/integer-gmp/integer-gmp.cabal | 4 +- libraries/integer-simple/integer-simple.cabal | 2 +- libraries/template-haskell/template-haskell.cabal | 4 +- rts/ghc.mk | 6 +- rts/package.conf.in | 3 +- rules/build-package-way.mk | 14 +++-- rules/build-prog.mk | 2 +- rules/distdir-way-opts.mk | 20 +++++-- testsuite/.gitignore | 2 + testsuite/tests/cabal/T1750A.pkg | 1 + testsuite/tests/cabal/T1750B.pkg | 1 + testsuite/tests/cabal/cabal06/Makefile | 70 ++++++++++++++++++++++ .../tests/cabal/{cabal05 => cabal06}/Setup.hs | 0 testsuite/tests/cabal/{cabal03 => cabal06}/all.T | 6 +- .../tests/cabal/cabal06/cabal06.stderr | 0 testsuite/tests/cabal/cabal06/cabal06.stdout | 8 +++ .../cabal/{cabal05/p => cabal06/p-1.0}/LICENSE | 0 testsuite/tests/cabal/cabal06/p-1.0/P.hs | 3 + .../cabal/{cabal05/p => cabal06/p-1.0}/p.cabal | 7 ++- .../cabal/{cabal05/p => cabal06/p-1.1}/LICENSE | 0 testsuite/tests/cabal/cabal06/p-1.1/P.hs | 3 + .../cabal/{cabal05/p => cabal06/p-1.1}/p.cabal | 7 ++- .../tests/cabal/{cabal05/p => cabal06/q}/LICENSE | 0 testsuite/tests/cabal/{cabal05 => cabal06}/q/Q.hs | 4 +- testsuite/tests/cabal/cabal06/q/q-1.0.conf | 19 ++++++ testsuite/tests/cabal/cabal06/q/q.cabal | 12 ++++ .../tests/cabal/{cabal05/p => cabal06/r}/LICENSE | 0 testsuite/tests/cabal/cabal06/r/Main.hs | 3 + testsuite/tests/cabal/cabal06/r/r.cabal | 12 ++++ testsuite/tests/cabal/ghcpkg01.stdout | 6 ++ testsuite/tests/cabal/shadow1.pkg | 1 + testsuite/tests/cabal/shadow2.pkg | 1 + testsuite/tests/cabal/shadow3.pkg | 1 + testsuite/tests/cabal/test.pkg | 1 + testsuite/tests/cabal/test2.pkg | 1 + testsuite/tests/cabal/test3.pkg | 1 + testsuite/tests/cabal/test4.pkg | 1 + testsuite/tests/cabal/test5.pkg | 1 + testsuite/tests/cabal/test7a.pkg | 1 + testsuite/tests/cabal/test7b.pkg | 1 + testsuite/tests/cabal/testdup.pkg | 1 + testsuite/tests/ghc-api/T7478/T7478.hs | 4 +- testsuite/tests/ghci/linking/Makefile | 3 + testsuite/tests/module/base01/Makefile | 4 +- testsuite/tests/module/mod73.stderr | 4 +- testsuite/tests/rename/prog006/Makefile | 3 +- testsuite/tests/rename/should_compile/T3103/test.T | 2 +- .../safeHaskell/check/pkg01/ImpSafeOnly07.stderr | 2 +- .../safeHaskell/check/pkg01/ImpSafeOnly08.stderr | 2 +- .../tests/safeHaskell/check/pkg01/safePkg01.stdout | 6 +- utils/ghc-cabal/Main.hs | 21 ++++++- utils/ghc-pkg/Main.hs | 48 +++++++++++---- 74 files changed, 512 insertions(+), 142 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 66218d15b7c27a4a38992003bd761f60bae84b1f From git at git.haskell.org Tue Aug 5 10:15:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Aug 2014 10:15:36 +0000 (UTC) Subject: [commit: ghc] master: Make PackageState an abstract type. (de3f064) Message-ID: <20140805101536.63037240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/de3f0644b8ff1748335c0fe07404dd4502a624e0/ghc >--------------------------------------------------------------- commit de3f0644b8ff1748335c0fe07404dd4502a624e0 Author: Edward Z. Yang Date: Fri Aug 1 12:35:15 2014 +0100 Make PackageState an abstract type. Summary: Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, simonmar, hvr, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D107 >--------------------------------------------------------------- de3f0644b8ff1748335c0fe07404dd4502a624e0 compiler/ghci/Linker.lhs | 9 +--- compiler/main/CodeOutput.lhs | 4 +- compiler/main/DriverPipeline.hs | 7 ++- compiler/main/Finder.lhs | 8 +--- compiler/main/GHC.hs | 4 +- compiler/main/HscMain.hs | 5 +-- compiler/main/HscTypes.lhs | 5 +-- compiler/main/Packages.lhs | 95 +++++++++++++++++++++++++++-------------- ghc/InteractiveUI.hs | 23 ++++------ 9 files changed, 88 insertions(+), 72 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc de3f0644b8ff1748335c0fe07404dd4502a624e0 From git at git.haskell.org Tue Aug 5 10:15:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Aug 2014 10:15:38 +0000 (UTC) Subject: [commit: ghc] master: Disable ghc-pkg accepting multiple package IDs (differing package keys) for now. (3663791) Message-ID: <20140805101538.BA6AA240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/36637914b0a874d7716d9b6a6c7e80540aae68af/ghc >--------------------------------------------------------------- commit 36637914b0a874d7716d9b6a6c7e80540aae68af Author: Edward Z. Yang Date: Wed Jul 30 13:54:46 2014 +0100 Disable ghc-pkg accepting multiple package IDs (differing package keys) for now. Duncan requested that ghc-pkg not accept duplicate package IDs (foo-0.1) by default until the higher level tools can accommodate it. Until then you'll need to use the --multi-instance flag to install multiple copies in the package database. I think reusing the --multi-instance flag is dodgy, because that can be used to cause duplicate package keys; but there is a mode of use of the database where package keys are unique. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 36637914b0a874d7716d9b6a6c7e80540aae68af utils/ghc-pkg/Main.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 2679639..970ab67 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -901,13 +901,13 @@ registerPackage input verbosity my_flags auto_ghci_libs multi_instance let -- In the normal mode, we only allow one version of each package, so we - -- remove all instances with the same source package key as the one we're + -- remove all instances with the same source package id as the one we're -- adding. In the multi instance mode we don't do that, thus allowing - -- multiple instances with the same source package key. + -- multiple instances with the same source package id. removes = [ RemovePackage p | not multi_instance, p <- packages db_to_operate_on, - packageKey p == packageKey pkg ] + sourcePackageId p == sourcePackageId pkg ] -- changeDB verbosity (removes ++ [AddPackage pkg']) db_to_operate_on @@ -1564,14 +1564,13 @@ checkDuplicates :: PackageDBStack -> InstalledPackageInfo -> Bool -> Bool-> Validate () checkDuplicates db_stack pkg multi_instance update = do let - pkg_key = packageKey pkg pkgid = sourcePackageId pkg pkgs = packages (head db_stack) -- -- Check whether this package id already exists in this DB -- when (not update && not multi_instance - && (pkg_key `elem` map packageKey pkgs)) $ + && (pkgid `elem` map sourcePackageId pkgs)) $ verror CannotForce $ "package " ++ display pkgid ++ " is already installed" From git at git.haskell.org Tue Aug 5 10:15:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Aug 2014 10:15:42 +0000 (UTC) Subject: [commit: ghc] master: Refactor package state, also fixing a module reexport bug. (00b8f8c) Message-ID: <20140805101542.D4D13240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/00b8f8c5b378fc679639ebe81238cf42d92aa607/ghc >--------------------------------------------------------------- commit 00b8f8c5b378fc679639ebe81238cf42d92aa607 Author: Edward Z. Yang Date: Fri Aug 1 18:03:20 2014 +0100 Refactor package state, also fixing a module reexport bug. Instead of building a multiply indirected data structure and querying it on every import, we now have two data structures moduleToPkgConf and moduleToPkgConfAll. moduleToPkgConf is a single-level UniqFM that is intended to be used for most valid imports; however, it does not contain any information useful for error reporting. If an error is occurred, we then query moduleToPkgConfAll, which contains a more comprehensive view of the package database. This field is lazily initialized (so this means we're retaining the package database list, but this should be fine because we're already maintaining the entries of the list.) Additionally, the full view doesn't keep track of a boolean toggle for visibility/exposure anymore, but instead tracks the *provenance* of how the module binding came to be (the ModuleOrigin data type). Additionally, we move the logic for determining if a module is exposed or not from Finder.lhs and put it in Packages.lhs; this information is communicated via the LookupResult data type. Unfortunately, we can't directly return a FindResult, because this data type is defined in HscTypes which depends on Packages. This is going to change some more in the near future when I add thinning/renaming to package flags; the error messages will need to be more flexible. I've also slightly changed the semantics of error messages for package qualified imports. Previously, if we didn't find any package qualified imports, but there were hidden modules in a *different* package, the error message would prefer mentioning those as opposed to providing suggestions. Now, if a module is hidden but in the wrong package, we won't mention it; instead, it will get mentioned with the other module suggestions. I was too lazy to write a test, but I can add one if people would like. The module reexport bug was, package q reexported p:P as Conflict, and package r reexported p:P2 as Conflict, this was *not* reported as a conflict, because the old logic incorrectly decided that P and P2 were the same module on account of being from the same package. The logic here has been corrected. Contains haddock submodule update. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 00b8f8c5b378fc679639ebe81238cf42d92aa607 compiler/main/Finder.lhs | 58 ++-- compiler/main/HscTypes.lhs | 5 +- compiler/main/Packages.lhs | 301 +++++++++++++-------- testsuite/tests/cabal/cabal05/Makefile | 5 +- testsuite/tests/cabal/cabal05/q/q.cabal | 3 +- testsuite/tests/cabal/cabal05/r/r.cabal | 5 +- testsuite/tests/cabal/cabal05/{p => t}/LICENSE | 0 testsuite/tests/cabal/cabal05/{ => t}/Setup.hs | 0 testsuite/tests/cabal/cabal05/t/T.hs | 3 + .../tests/cabal/cabal05/{s/s.cabal => t/t.cabal} | 4 +- utils/haddock | 2 +- 11 files changed, 226 insertions(+), 160 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 00b8f8c5b378fc679639ebe81238cf42d92aa607 From git at git.haskell.org Tue Aug 5 10:15:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Aug 2014 10:15:45 +0000 (UTC) Subject: [commit: ghc] master: Refactor PackageFlags so that ExposePackage is a single constructor. (4accf60) Message-ID: <20140805101545.E5C02240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4accf60184dba550ef0cbdf70fa8e708a4007370/ghc >--------------------------------------------------------------- commit 4accf60184dba550ef0cbdf70fa8e708a4007370 Author: Edward Z. Yang Date: Fri Aug 1 19:07:03 2014 +0100 Refactor PackageFlags so that ExposePackage is a single constructor. You can parametrize over the different selection by using a different PackageArg. This helps reduce code duplication. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 4accf60184dba550ef0cbdf70fa8e708a4007370 compiler/main/DynFlags.hs | 25 ++++++++++++++------ compiler/main/Packages.lhs | 58 +++++++++++++++++----------------------------- ghc/InteractiveUI.hs | 7 +++--- 3 files changed, 43 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 4accf60184dba550ef0cbdf70fa8e708a4007370 From git at git.haskell.org Tue Aug 5 10:15:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Aug 2014 10:15:49 +0000 (UTC) Subject: [commit: ghc] master: Thinning and renaming modules from packages on the command line. (2078752) Message-ID: <20140805101549.C87BF240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/207875293fea07aa90efe215369629b657d1875a/ghc >--------------------------------------------------------------- commit 207875293fea07aa90efe215369629b657d1875a Author: Edward Z. Yang Date: Sat Aug 2 13:50:00 2014 +0100 Thinning and renaming modules from packages on the command line. Summary: This patch set adds support for extra syntax on -package and related arguments which allow you to thin and rename modules from a package. For example, this argument: -package "base (Data.Bool as Bam, Data.List)" adds two more modules into scope, Bam and Data.List, without adding any of base's other modules to scope. These flags are additive: so, for example, saying: -hide-all-packages -package base -package "base (Data.Bool as Bam)" will provide both the normal bindings for modules in base, as well as the module Bam. There is also a new debug flag -ddump-mod-map which prints the state of the module mapping database. H = hidden, E = exposed (so for example EH says the module in question is exported, but in a hidden package.) Module suggestions have been minorly overhauled to work better with reexports: if you have -package "base (Data.Bool as Bam)" and mispell Bam, GHC will suggest "Did you mean Bam (defined via package flags to be base:Data.Bool)"; and generally you will get more accurate information. Also, fix a bug where we suggest the -package flag when we really need the -package-key flag. NB: The renaming afforded here does *not* affect what wired in symbols GHC generates. (But it does affect implicit prelude!) ToDo: add 'hiding' functionality, to make it easier to support the alternative prelude use-case. ToDo: Cabal support Signed-off-by: Edward Z. Yang Test Plan: new tests and validate Reviewers: simonpj, simonmar, hvr, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D113 GHC Trac Issues: #9375 >--------------------------------------------------------------- 207875293fea07aa90efe215369629b657d1875a compiler/main/DynFlags.hs | 32 +- compiler/main/Finder.lhs | 103 +++- compiler/main/HscMain.hs | 7 - compiler/main/HscTypes.lhs | 13 +- compiler/main/Packages.lhs | 626 ++++++++++++++-------- docs/users_guide/glasgow_exts.xml | 6 +- docs/users_guide/packages.xml | 61 ++- ghc/InteractiveUI.hs | 12 +- ghc/Main.hs | 7 +- testsuite/tests/ghci/scripts/T5979.stderr | 5 +- testsuite/tests/{annotations => package}/Makefile | 0 testsuite/tests/package/all.T | 21 + testsuite/tests/package/package01.hs | 3 + testsuite/tests/package/package01e.hs | 3 + testsuite/tests/package/package01e.stderr | 10 + testsuite/tests/package/package02.hs | 5 + testsuite/tests/package/package03.hs | 5 + testsuite/tests/package/package04.hs | 5 + testsuite/tests/package/package05.hs | 4 + testsuite/tests/package/package06.hs | 3 + testsuite/tests/package/package06e.hs | 3 + testsuite/tests/package/package06e.stderr | 10 + testsuite/tests/package/package07e.hs | 5 + testsuite/tests/package/package07e.stderr | 20 + testsuite/tests/package/package08e.hs | 5 + testsuite/tests/package/package08e.stderr | 20 + testsuite/tests/package/package09e.hs | 2 + testsuite/tests/package/package09e.stderr | 5 + testsuite/tests/package/package10.hs | 2 + 29 files changed, 717 insertions(+), 286 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 207875293fea07aa90efe215369629b657d1875a From git at git.haskell.org Tue Aug 5 13:24:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Aug 2014 13:24:54 +0000 (UTC) Subject: [commit: ghc] master: [no-ci] Minor bugfixes in Backpack docs. (94b2b22) Message-ID: <20140805132454.25F50240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/94b2b22582f1584a4007b4301dbe7070589d951f/ghc >--------------------------------------------------------------- commit 94b2b22582f1584a4007b4301dbe7070589d951f Author: Edward Z. Yang Date: Tue Aug 5 14:24:45 2014 +0100 [no-ci] Minor bugfixes in Backpack docs. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 94b2b22582f1584a4007b4301dbe7070589d951f docs/backpack/backpack-impl.tex | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/docs/backpack/backpack-impl.tex b/docs/backpack/backpack-impl.tex index 7d022d1..963c53c 100644 --- a/docs/backpack/backpack-impl.tex +++ b/docs/backpack/backpack-impl.tex @@ -1116,7 +1116,7 @@ against (renamed) interface files. \State\Call{Exec}{\texttt{ghc -c} $p$\texttt{.hsig} \texttt{-package-db} $db$ \texttt{--sig-of} $H(p)$ $flags$} \EndCase% \Case{$p = p'$} - \State$flags\gets flags$ \texttt{-alias} $p$ $p'$ \texttt{-package-db} $db$ + \State$flags\gets flags$ \texttt{-alias} $p$ $p'$ \EndCase% \Case{\Cinc{$P'$} $\langle\vec{p_H\mapsto p_H'}, \vec{p\mapsto p'} \rangle$} \State\textbf{let} $H'(p_H) = $ \Call{Exec}{\texttt{ghc --resolve-module} $p_H'$ \texttt{-package-db} $db$ $flags$} @@ -1133,10 +1133,11 @@ against (renamed) interface files. \end{algorithmic} \end{algorithm} -The full recursive procedure for compiling a Backpack package is given -in Figure~\ref{alg:compile}. We recursively walk through Backpack descriptions, -processing each line by invoking GHC and/or modifying our package state. -Here is a more in-depth description of the algorith, line-by-line: +The full recursive procedure for compiling a Backpack package using +one-shot compilation is given in Figure~\ref{alg:compile}. We +recursively walk through Backpack descriptions, processing each line by +invoking GHC and/or modifying our package state. Here is a more +in-depth description of the algorithm, line-by-line: \paragraph{The parameters} To compile a package description for package $P$, we need to know $H$, the mapping of holes $p_H$ in package $P$ to @@ -1217,8 +1218,8 @@ reporting an ambiguous import, we instead have to merge the two interface files together and use the result as the interface for the module. (This could be done on the fly, or we could generate merged interface files as we go along.) -Note that we need to merge signatures with an implementation, just use the -implementation interface. E.g. +Note that we do not need to merge signatures with an implementation, in such +cases, we should just use the implementation interface. E.g. \begin{verbatim} package p where @@ -1233,7 +1234,7 @@ Here, \m{A} is available both from \pname{p} and \pname{q}, but the use in the starred module should be done with respect to the full implementation. \paragraph{The \texttt{-alias} flag} We introduce a new flag -\texttt{-alias} for aliasing modules today. Aliasing is analogous to +\texttt{-alias} for aliasing modules. Aliasing is analogous to the merging that can occur when we include packages, but it also applies to modules which are locally defined. When we alias a module $p$ with $p'$, we require that $p'$ exists in the current module mapping, and then @@ -1317,12 +1318,6 @@ of dynamically rewriting these references at the linking stage. But separate compilation achieved in this fashion would not be able to take advantage of cross-module optimizations. -\subsection{Compiling aliases} - -Aliasing simply adds an extra \texttt{-alias} flag to the compilation flags. To -eagerly report errors, we run a special command \texttt{ghc --check} which checks -to make sure $flags$ is consistent (e.g., no linking conflicts.) - \subsection{Compiling includes} Includes are the most interesting part of the compilation process, as we have @@ -1449,7 +1444,7 @@ generate for them all point to the same original implementation. However, The problem here is that type checking asks ``does it compile with respect to all possible instantiations of the holes'', whereas compilation asks ``does it compile with respect to this particular instantiation of holes.'' -It's a bit unavoidable, really. +In the absence of a shaping pass, this problem is unavoidable. \section{Shaped Backpack} From git at git.haskell.org Tue Aug 5 15:57:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Aug 2014 15:57:41 +0000 (UTC) Subject: [commit: ghc] master: configure.ac: drop unused VOID_INT_SIGNALS (7479df6) Message-ID: <20140805155741.2B9F4240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7479df6af5dd7bc72158d7617dab5c5f139a87fb/ghc >--------------------------------------------------------------- commit 7479df6af5dd7bc72158d7617dab5c5f139a87fb Author: Sergei Trofimovich Date: Tue Aug 5 17:44:49 2014 +0300 configure.ac: drop unused VOID_INT_SIGNALS Summary: Another macro borrowed from hugs, gone aways in commit 528a7d2cf1c90408d60028bb1fec85124d539476 Signed-off-by: Sergei Trofimovich Test Plan: build-tested Reviewers: simonmar, austin, ezyang Reviewed By: austin, ezyang Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D118 >--------------------------------------------------------------- 7479df6af5dd7bc72158d7617dab5c5f139a87fb configure.ac | 26 +------------------------- 1 file changed, 1 insertion(+), 25 deletions(-) diff --git a/configure.ac b/configure.ac index 5fc5733..d952428 100644 --- a/configure.ac +++ b/configure.ac @@ -228,7 +228,7 @@ case $host in # here we go with the test MINOR=`uname -r|cut -d '.' -f 2-` if test "$MINOR" -lt "11"; then - SOLARIS_BROKEN_SHLD=YES + SOLARIS_BROKEN_SHLD=YES fi ;; esac @@ -818,30 +818,6 @@ FP_CHECK_FUNC([WinExec], FP_CHECK_FUNC([GetModuleFileName], [@%:@include ], [GetModuleFileName((HMODULE)0,(LPTSTR)0,0)]) -dnl ** check return type of signal handlers -dnl Foo: assumes we can use prototypes. -dnl On BCC, signal handlers have type "int(void)", elsewhere its "void(int)". -dnl AC_CACHE_CHECK([type of signal handlers], ac_cv_type_signal_handler, -dnl [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include -dnl #include -dnl #ifdef signal -dnl #undef signal -dnl #endif -dnl void (*signal (int, void (*)(int)))(int); -dnl ]], -dnl [[int i;]])], -dnl [ac_cv_type_signal_handler=void_int], -dnl [ac_cv_type_signal_handler=int_void])]) -dnl if test "$ac_cv_type_signal_handler" = void_int; then -dnl AC_DEFINE(VOID_INT_SIGNALS) -dnl fi - -dnl On BCC, signal handlers have type "int(void)", elsewhere its "void(int)". -AC_TYPE_SIGNAL -if test "$ac_cv_type_signal" = void; then - AC_DEFINE([VOID_INT_SIGNALS], [1], [Define to 1 if signal handlers have type void (*)(int). Otherwise, they're assumed to have type int (*)(void).]) -fi - dnl ** check for more functions dnl ** The following have been verified to be used in ghc/, but might be used somewhere else, too. AC_CHECK_FUNCS([getclock getrusage gettimeofday setitimer siginterrupt sysconf times ctime_r sched_setaffinity setlocale]) From git at git.haskell.org Tue Aug 5 16:36:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Aug 2014 16:36:18 +0000 (UTC) Subject: [commit: ghc] master: Update Haddock submodule to know about profiling. (56ca32c) Message-ID: <20140805163618.A5A1D240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/56ca32c96d82489cb28d7bfa13432ae00ac20cb1/ghc >--------------------------------------------------------------- commit 56ca32c96d82489cb28d7bfa13432ae00ac20cb1 Author: Edward Z. Yang Date: Tue Aug 5 17:35:53 2014 +0100 Update Haddock submodule to know about profiling. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 56ca32c96d82489cb28d7bfa13432ae00ac20cb1 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index d59fec2..97b5fa2 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit d59fec2c9551b5662a3507c0011e32a09a9c118f +Subproject commit 97b5fa2b7b9c8bd07d0be5068b2f031b58e8fc56 From git at git.haskell.org Tue Aug 5 17:51:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Aug 2014 17:51:24 +0000 (UTC) Subject: [commit: ghc] master: Filter out null bytes from trace, and warn accordingly, fixing #9395. (d360d44) Message-ID: <20140805175124.47AF6240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d360d440b994c03d645603c50f25ef208700db02/ghc >--------------------------------------------------------------- commit d360d440b994c03d645603c50f25ef208700db02 Author: Edward Z. Yang Date: Tue Aug 5 09:55:00 2014 -0700 Filter out null bytes from trace, and warn accordingly, fixing #9395. Summary: Previously, if you ran trace "foo\0bar", the output was truncated so that everything after the null byte was omitted. This was terrible. Now we filter out null bytes, and emit an extra trace saying that null bytes were filtered out. NB: we CANNOT fix debugBelch, because all printf variants *always* respect null bytes, even if you're using string precision such as %.*s. The alternative would have been to introduce a new function debugRawBelch which did not use format strings and took an explicit string length, but I decided we generally should avoid putting null bytes in our trace messages, and warn the user. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: hvr, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D121 GHC Trac Issues: #9395 >--------------------------------------------------------------- d360d440b994c03d645603c50f25ef208700db02 libraries/base/Debug/Trace.hs | 11 +++++++++-- libraries/base/tests/T9395.hs | 2 ++ libraries/base/tests/T9395.stderr | 2 ++ libraries/base/tests/all.T | 1 + 4 files changed, 14 insertions(+), 2 deletions(-) diff --git a/libraries/base/Debug/Trace.hs b/libraries/base/Debug/Trace.hs index eedacfa..92e5b20 100644 --- a/libraries/base/Debug/Trace.hs +++ b/libraries/base/Debug/Trace.hs @@ -52,6 +52,7 @@ import qualified GHC.Foreign import GHC.IO.Encoding import GHC.Ptr import GHC.Stack +import Data.List -- $tracing -- @@ -70,9 +71,15 @@ import GHC.Stack -- /Since: 4.5.0.0/ traceIO :: String -> IO () traceIO msg = do - withCString "%s\n" $ \cfmt -> - withCString msg $ \cmsg -> + withCString "%s\n" $ \cfmt -> do + -- NB: debugBelch can't deal with null bytes, so filter them + -- out so we don't accidentally truncate the message. See Trac #9395 + let (nulls, msg') = partition (=='\0') msg + withCString msg' $ \cmsg -> debugBelch cfmt cmsg + when (not (null nulls)) $ + withCString "WARNING: previous trace message had null bytes" $ \cmsg -> + debugBelch cfmt cmsg -- don't use debugBelch() directly, because we cannot call varargs functions -- using the FFI. diff --git a/libraries/base/tests/T9395.hs b/libraries/base/tests/T9395.hs new file mode 100644 index 0000000..c86b127 --- /dev/null +++ b/libraries/base/tests/T9395.hs @@ -0,0 +1,2 @@ +import Debug.Trace +main = trace "333\0UUUU" $ return () diff --git a/libraries/base/tests/T9395.stderr b/libraries/base/tests/T9395.stderr new file mode 100644 index 0000000..4a4fb3f --- /dev/null +++ b/libraries/base/tests/T9395.stderr @@ -0,0 +1,2 @@ +333UUUU +WARNING: previous trace message had null bytes diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index c85d7bc..aa752c2 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -169,3 +169,4 @@ test('T8766', ['-O']) test('T9111', normal, compile, ['']) +test('T9395', normal, compile_and_run, ['']) From git at git.haskell.org Tue Aug 5 18:04:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Aug 2014 18:04:11 +0000 (UTC) Subject: [commit: ghc] master: Temporarily bump Haddock numbers; I'm going to fix it. (c88559b) Message-ID: <20140805180411.54B08240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c88559b3304cc5e142ab9c2655d48e570f81afeb/ghc >--------------------------------------------------------------- commit c88559b3304cc5e142ab9c2655d48e570f81afeb Author: Edward Z. Yang Date: Tue Aug 5 11:03:58 2014 -0700 Temporarily bump Haddock numbers; I'm going to fix it. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- c88559b3304cc5e142ab9c2655d48e570f81afeb testsuite/tests/perf/haddock/all.T | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 49321b9..376a944 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -33,7 +33,7 @@ test('haddock.base', # 2014-01-22: 62189068 (x86/Linux) # 2014-06-29: 58243640 (x86/Linux) ,stats_num_field('bytes allocated', - [(wordsize(64), 7498123680, 5) + [(wordsize(64), 7992757384, 5) # 2012-08-14: 5920822352 (amd64/Linux) # 2012-09-20: 5829972376 (amd64/Linux) # 2012-10-08: 5902601224 (amd64/Linux) @@ -44,6 +44,9 @@ test('haddock.base', # 2013-11-21: 6756213256 (x86_64/Linux) # 2014-01-12: 7128342344 (x86_64/Linux) # 2014-06-12: 7498123680 (x86_64/Linux) + # XXX This one is TEMPORARY, it's due to an unoptimized error-path + # that Haddock is tickling, I am profiling and fixing this. + # 2014-08-05: 7992757384 (x86_64/Linux) ,(platform('i386-unknown-mingw32'), 3548581572, 5) # 2013-02-10: 3358693084 (x86/Windows) # 2013-11-13: 3097751052 (x86/Windows, 64bit machine) @@ -99,7 +102,7 @@ test('haddock.Cabal', # 2014-01-22: 52718512 (x86/Linux) # 2014-06-29: 66411508 (x86/Linux) ,stats_num_field('bytes allocated', - [(wordsize(64), 4200993768, 5) + [(wordsize(64), 4493770224, 5) # 2012-08-14: 3255435248 (amd64/Linux) # 2012-08-29: 3324606664 (amd64/Linux, new codegen) # 2012-10-08: 3373401360 (amd64/Linux) @@ -111,6 +114,9 @@ test('haddock.Cabal', # 2013-12-12: 3828567272 (amd64/Linux) # 2014-01-12: 3979151552 (amd64/Linux) new parser # 2014-06-29: 4200993768 (amd64/Linux) + # XXX This one is TEMPORARY, it's due to an unoptimized error-path + # that Haddock is tickling, I am profiling and fixing this. + # 2014-08-05: 4493770224 (x86_64/Linux) ,(platform('i386-unknown-mingw32'), 2052220292, 5) # 2012-10-30: 1733638168 (x86/Windows) # 2013-02-10: 1906532680 (x86/Windows) From git at git.haskell.org Wed Aug 6 19:53:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Aug 2014 19:53:57 +0000 (UTC) Subject: [commit: ghc] master: Revert "fix linker_unload test on Solaris/i386 platform" (8e400d2) Message-ID: <20140806195358.09FE9240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8e400d244272c9d41d9d918858acae4497c5f723/ghc >--------------------------------------------------------------- commit 8e400d244272c9d41d9d918858acae4497c5f723 Author: Karel Gardas Date: Wed Aug 6 21:52:20 2014 +0200 Revert "fix linker_unload test on Solaris/i386 platform" This reverts commit 65e5dbcd3971cb3ef5b9073096e5d063034b90c1. >--------------------------------------------------------------- 8e400d244272c9d41d9d918858acae4497c5f723 testsuite/tests/rts/Makefile | 4 +--- testsuite/tests/rts/linker_unload.c | 1 - 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile index 8833d45..180fe9b 100644 --- a/testsuite/tests/rts/Makefile +++ b/testsuite/tests/rts/Makefile @@ -108,9 +108,7 @@ BASE_DIR = $(shell $(LOCAL_GHC_PKG) field base library-dirs | sed 's/^.*: *//') BASE_LIB = $(shell $(LOCAL_GHC_PKG) field base hs-libraries | sed 's/^.*: *//') GHC_PRIM_DIR = $(shell $(LOCAL_GHC_PKG) field ghc-prim library-dirs | sed 's/^.*: *//') GHC_PRIM_LIB = $(shell $(LOCAL_GHC_PKG) field ghc-prim hs-libraries | sed 's/^.*: *//') -# need to cut here in order to get rid of system gmp library directory installation when -# ghc is configured with --with-gmp-libraries= parameter -INTEGER_GMP_DIR = $(shell $(LOCAL_GHC_PKG) field integer-gmp library-dirs | sed 's/^.*: *//' | cut -d ' ' -f -1) +INTEGER_GMP_DIR = $(shell $(LOCAL_GHC_PKG) field integer-gmp library-dirs | sed 's/^.*: *//') INTEGER_GMP_LIB = $(shell $(LOCAL_GHC_PKG) field integer-gmp hs-libraries | sed 's/^.*: *//') BASE = $(BASE_DIR)/lib$(BASE_LIB).a diff --git a/testsuite/tests/rts/linker_unload.c b/testsuite/tests/rts/linker_unload.c index f1cc891..55870c3 100644 --- a/testsuite/tests/rts/linker_unload.c +++ b/testsuite/tests/rts/linker_unload.c @@ -1,4 +1,3 @@ -#include "ghcconfig.h" #include #include #include "Rts.h" From git at git.haskell.org Wed Aug 6 20:30:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Aug 2014 20:30:52 +0000 (UTC) Subject: [commit: ghc] master: Mark type-rep not as expect_broken when debugged (f4904fb) Message-ID: <20140806203052.8D5F0240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f4904fbffe7e17f29ad4d79b0b619eed45e1eba9/ghc >--------------------------------------------------------------- commit f4904fbffe7e17f29ad4d79b0b619eed45e1eba9 Author: Joachim Breitner Date: Wed Aug 6 22:29:41 2014 +0200 Mark type-rep not as expect_broken when debugged Thanks to slyfox for noticing this reregression. >--------------------------------------------------------------- f4904fbffe7e17f29ad4d79b0b619eed45e1eba9 testsuite/tests/gadt/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T index 4a42bb7..315ecb6 100644 --- a/testsuite/tests/gadt/all.T +++ b/testsuite/tests/gadt/all.T @@ -40,7 +40,7 @@ test('gadt23', test('gadt24', normal, compile, ['']) test('red-black', normal, compile, ['']) -test('type-rep', [ when(fast(), skip), when(compiler_debugged(),expect_broken_for(8569, ['hpc','optasm','threaded2','dyn','optllvm'])) ] , compile_and_run, ['']) +test('type-rep', when(fast(), skip), compile_and_run, ['']) test('equal', normal, compile, ['']) test('nbe', normal, compile, ['']) test('while', normal, compile_and_run, ['']) From git at git.haskell.org Thu Aug 7 07:49:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 07:49:10 +0000 (UTC) Subject: [commit: ghc] master: fix linker_unload test for ghc configurations with --with-gmp-libraries (2b3c621) Message-ID: <20140807074910.8D3E9240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2b3c621685ec975e81ce82472f9a774791b14ac1/ghc >--------------------------------------------------------------- commit 2b3c621685ec975e81ce82472f9a774791b14ac1 Author: Karel Gardas Date: Wed Aug 6 23:29:46 2014 +0200 fix linker_unload test for ghc configurations with --with-gmp-libraries The issue is presented in Makefile logic where it attempts to start linker_unload and pass it HSinteger-gmp library for unload, but the library name is prefixed with two directories names. The first is of ghc's integer-gmp/build itself and another is the directory name passed to --with-gmp-libraries= configure parameter. The testcase then fails on unloading integer-gmp/build directory thinking that this is a library to unload. The issue is solved by cuting (head -1) the first library name from the list and using this for unloading the HSinteger-gmp library. I use head -1 instead of cut -d ' ' here since ghc may be installed into the directory with space(s) in its name like in the case when running validate. >--------------------------------------------------------------- 2b3c621685ec975e81ce82472f9a774791b14ac1 testsuite/tests/rts/Makefile | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile index 180fe9b..02a50a4 100644 --- a/testsuite/tests/rts/Makefile +++ b/testsuite/tests/rts/Makefile @@ -108,7 +108,11 @@ BASE_DIR = $(shell $(LOCAL_GHC_PKG) field base library-dirs | sed 's/^.*: *//') BASE_LIB = $(shell $(LOCAL_GHC_PKG) field base hs-libraries | sed 's/^.*: *//') GHC_PRIM_DIR = $(shell $(LOCAL_GHC_PKG) field ghc-prim library-dirs | sed 's/^.*: *//') GHC_PRIM_LIB = $(shell $(LOCAL_GHC_PKG) field ghc-prim hs-libraries | sed 's/^.*: *//') -INTEGER_GMP_DIR = $(shell $(LOCAL_GHC_PKG) field integer-gmp library-dirs | sed 's/^.*: *//') +# We need to get first library directory here in order to get rid of +# system gmp library directory installation when ghc is configured +# with --with-gmp-libraries= parameter +INTEGER_GMP_DIR = $(shell $(LOCAL_GHC_PKG) field integer-gmp library-dirs \ + | sed 's/^.*: *//' | head -1) INTEGER_GMP_LIB = $(shell $(LOCAL_GHC_PKG) field integer-gmp hs-libraries | sed 's/^.*: *//') BASE = $(BASE_DIR)/lib$(BASE_LIB).a From git at git.haskell.org Thu Aug 7 07:49:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 07:49:13 +0000 (UTC) Subject: [commit: ghc] master: fix T658b/T5776 to use POSIX grep -c instead of GNU's --count (24a2e49) Message-ID: <20140807074913.641F3240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/24a2e49e8a96a6ef5ef19386676b9f3b7d323afd/ghc >--------------------------------------------------------------- commit 24a2e49e8a96a6ef5ef19386676b9f3b7d323afd Author: Karel Gardas Date: Thu Aug 7 00:11:45 2014 +0200 fix T658b/T5776 to use POSIX grep -c instead of GNU's --count >--------------------------------------------------------------- 24a2e49e8a96a6ef5ef19386676b9f3b7d323afd testsuite/tests/simplCore/should_compile/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile index ca0d552..605d3a5 100644 --- a/testsuite/tests/simplCore/should_compile/Makefile +++ b/testsuite/tests/simplCore/should_compile/Makefile @@ -17,12 +17,12 @@ T3055: T5658b: $(RM) -f T5658b.o T5658b.hi - '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T5658b.hs -ddump-simpl | grep --count indexIntArray + '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T5658b.hs -ddump-simpl | grep -c indexIntArray # Trac 5658 meant that there were three calls to indexIntArray instead of two T5776: $(RM) -f T5776.o T5776.hi - '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T5776.hs -ddump-rules | grep --count dEq + '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T5776.hs -ddump-rules | grep -c dEq T3772: $(RM) -f T3772*.hi T3772*.o From git at git.haskell.org Thu Aug 7 07:49:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 07:49:15 +0000 (UTC) Subject: [commit: ghc] master: fix linker_unload test _FILE_OFFSET_BITS redefined warning on Solaris/i386 (f42fa9b) Message-ID: <20140807074915.B830E240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f42fa9b872a72e08e3a960bb4bb87a133d2051db/ghc >--------------------------------------------------------------- commit f42fa9b872a72e08e3a960bb4bb87a133d2051db Author: Karel Gardas Date: Wed Aug 6 23:22:31 2014 +0200 fix linker_unload test _FILE_OFFSET_BITS redefined warning on Solaris/i386 >--------------------------------------------------------------- f42fa9b872a72e08e3a960bb4bb87a133d2051db testsuite/tests/rts/linker_unload.c | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/rts/linker_unload.c b/testsuite/tests/rts/linker_unload.c index 55870c3..f1cc891 100644 --- a/testsuite/tests/rts/linker_unload.c +++ b/testsuite/tests/rts/linker_unload.c @@ -1,3 +1,4 @@ +#include "ghcconfig.h" #include #include #include "Rts.h" From git at git.haskell.org Thu Aug 7 08:55:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 08:55:26 +0000 (UTC) Subject: [commit: ghc] master: Comments and white space (61baf71) Message-ID: <20140807085527.07370240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/61baf71021976a105080b060f72df1f1f611389e/ghc >--------------------------------------------------------------- commit 61baf71021976a105080b060f72df1f1f611389e Author: Simon Peyton Jones Date: Fri Aug 1 16:38:33 2014 +0100 Comments and white space >--------------------------------------------------------------- 61baf71021976a105080b060f72df1f1f611389e compiler/coreSyn/CoreSyn.lhs | 42 ++++++++++++++++++++++-------------------- compiler/coreSyn/CoreUtils.lhs | 6 ++---- compiler/iface/BuildTyCl.lhs | 0 3 files changed, 24 insertions(+), 24 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index b36cb6d..8678678 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -180,24 +180,7 @@ These data types are the heart of the compiler -- /must/ be of lifted type (see "Type#type_classification" for -- the meaning of /lifted/ vs. /unlifted/). -- --- #let_app_invariant# --- The right hand side of of a non-recursive 'Let' --- _and_ the argument of an 'App', --- /may/ be of unlifted type, but only if the expression --- is ok-for-speculation. This means that the let can be floated --- around without difficulty. For example, this is OK: --- --- > y::Int# = x +# 1# --- --- But this is not, as it may affect termination if the --- expression is floated out: --- --- > y::Int# = fac 4# --- --- In this situation you should use @case@ rather than a @let at . The function --- 'CoreUtils.needsCaseBinding' can help you determine which to generate, or --- alternatively use 'MkCore.mkCoreLet' rather than this constructor directly, --- which will generate a @case@ if necessary +-- See Note [CoreSyn let/app invariant] -- -- #type_let# -- We allow a /non-recursive/ let to bind a type variable, thus: @@ -359,9 +342,28 @@ See #letrec_invariant# Note [CoreSyn let/app invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See #let_app_invariant# +The let/app invariant + the right hand side of of a non-recursive 'Let', and + the argument of an 'App', + /may/ be of unlifted type, but only if + the expression is ok-for-speculation. + +This means that the let can be floated around +without difficulty. For example, this is OK: + + y::Int# = x +# 1# + +But this is not, as it may affect termination if the +expression is floated out: + + y::Int# = fac 4# + +In this situation you should use @case@ rather than a @let at . The function +'CoreUtils.needsCaseBinding' can help you determine which to generate, or +alternatively use 'MkCore.mkCoreLet' rather than this constructor directly, +which will generate a @case@ if necessary -This is intially enforced by DsUtils.mkCoreLet and mkCoreApp +Th let/app invariant is intially enforced by DsUtils.mkCoreLet and mkCoreApp Note [CoreSyn case invariants] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index 3bf07fe..74fa623 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -983,10 +983,8 @@ app_ok primop_ok fun args -> True | otherwise - -> primop_ok op -- A bit conservative: we don't really need - && all (expr_ok primop_ok) args - - -- to care about lazy arguments, but this is easy + -> primop_ok op -- A bit conservative: we don't really need + && all (expr_ok primop_ok) args -- to care about lazy arguments, but this is easy _other -> isUnLiftedType (idType fun) -- c.f. the Var case of exprIsHNF || idArity fun > n_val_args -- Partial apps From git at git.haskell.org Thu Aug 7 08:55:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 08:55:29 +0000 (UTC) Subject: [commit: ghc] master: Tiny refactoring, plus comments; no change in behaviour (d3fafbb) Message-ID: <20140807085529.69385240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d3fafbb0e37bf052f63ba0d4af0c40ff03a81a2c/ghc >--------------------------------------------------------------- commit d3fafbb0e37bf052f63ba0d4af0c40ff03a81a2c Author: Simon Peyton Jones Date: Fri Aug 1 16:39:47 2014 +0100 Tiny refactoring, plus comments; no change in behaviour >--------------------------------------------------------------- d3fafbb0e37bf052f63ba0d4af0c40ff03a81a2c compiler/prelude/PrimOp.lhs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs index 1261d87..4a243bc 100644 --- a/compiler/prelude/PrimOp.lhs +++ b/compiler/prelude/PrimOp.lhs @@ -404,9 +404,9 @@ Note [primOpOkForSpeculation] let-bind a can_fail or has_side_effects primop. The RHS of a let-binding (which can float in and out freely) satisfies exprOkForSpeculation. And exprOkForSpeculation is false of - can_fail and no_side_effect. + can_fail and has_side_effects. - * So can_fail and no_side_effect primops will appear only as the + * So can_fail and has_side_effects primops will appear only as the scrutinees of cases, and that's why the FloatIn pass is capable of floating case bindings inwards. @@ -422,10 +422,14 @@ primOpCanFail :: PrimOp -> Bool #include "primop-can-fail.hs-incl" primOpOkForSpeculation :: PrimOp -> Bool - -- See Note [primOpOkForSpeculation and primOpOkForFloatOut] + -- See Note [primOpOkForSpeculation] -- See comments with CoreUtils.exprOkForSpeculation + -- primOpOkForSpeculation => primOpOkForSideEffects primOpOkForSpeculation op - = not (primOpHasSideEffects op || primOpOutOfLine op || primOpCanFail op) + = primOpOkForSideEffects op + && not (primOpOutOfLine op || primOpCanFail op) + -- I think the "out of line" test is because out of line things can + -- be expensive (eg sine, consine), and so we may not want to speculate them primOpOkForSideEffects :: PrimOp -> Bool primOpOkForSideEffects op From git at git.haskell.org Thu Aug 7 08:55:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 08:55:31 +0000 (UTC) Subject: [commit: ghc] master: Move Outputable instance for FloatBind to the data type definition (31399be) Message-ID: <20140807085531.BAFD3240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/31399bef865dd02ea9f326907b46ee82bb04fb14/ghc >--------------------------------------------------------------- commit 31399bef865dd02ea9f326907b46ee82bb04fb14 Author: Simon Peyton Jones Date: Fri Aug 1 16:39:20 2014 +0100 Move Outputable instance for FloatBind to the data type definition >--------------------------------------------------------------- 31399bef865dd02ea9f326907b46ee82bb04fb14 compiler/coreSyn/MkCore.lhs | 5 +++++ compiler/simplCore/FloatOut.lhs | 5 ----- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs index 5213f92..3ba8b1d 100644 --- a/compiler/coreSyn/MkCore.lhs +++ b/compiler/coreSyn/MkCore.lhs @@ -421,6 +421,11 @@ data FloatBind -- case e of y { C ys -> ... } -- See Note [Floating cases] in SetLevels +instance Outputable FloatBind where + ppr (FloatLet b) = ptext (sLit "LET") <+> ppr b + ppr (FloatCase e b c bs) = hang (ptext (sLit "CASE") <+> ppr e <+> ptext (sLit "of") <+> ppr b) + 2 (ppr c <+> ppr bs) + wrapFloat :: FloatBind -> CoreExpr -> CoreExpr wrapFloat (FloatLet defns) body = Let defns body wrapFloat (FloatCase e b con bs) body = Case e b (exprType body) [(con, bs, body)] diff --git a/compiler/simplCore/FloatOut.lhs b/compiler/simplCore/FloatOut.lhs index dbab552..37d6dc8 100644 --- a/compiler/simplCore/FloatOut.lhs +++ b/compiler/simplCore/FloatOut.lhs @@ -458,11 +458,6 @@ data FloatBinds = FB !(Bag FloatLet) -- Destined for top level !MajorEnv -- Levels other than top -- See Note [Representation of FloatBinds] -instance Outputable FloatBind where - ppr (FloatLet b) = ptext (sLit "LET") <+> ppr b - ppr (FloatCase e b c bs) = hang (ptext (sLit "CASE") <+> ppr e <+> ptext (sLit "of") <+> ppr b) - 2 (ppr c <+> ppr bs) - instance Outputable FloatBinds where ppr (FB fbs defs) = ptext (sLit "FB") <+> (braces $ vcat From git at git.haskell.org Thu Aug 7 08:55:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 08:55:34 +0000 (UTC) Subject: [commit: ghc] master: Make Core Lint check the let/app invariant (6b96557) Message-ID: <20140807085534.CF613240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6b965570e72cebd56875a7f3115580b0954b6d14/ghc >--------------------------------------------------------------- commit 6b965570e72cebd56875a7f3115580b0954b6d14 Author: Simon Peyton Jones Date: Fri Aug 1 16:41:52 2014 +0100 Make Core Lint check the let/app invariant If we have an invariant, Lint should jolly well check it. (And indeed, adding this test throws up Lint errors that are fixed in separate patches.) >--------------------------------------------------------------- 6b965570e72cebd56875a7f3115580b0954b6d14 compiler/coreSyn/CoreLint.lhs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs index a586810..f460782 100644 --- a/compiler/coreSyn/CoreLint.lhs +++ b/compiler/coreSyn/CoreLint.lhs @@ -207,7 +207,8 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) ; binder_ty <- applySubstTy binder_ty ; checkTys binder_ty ty (mkRhsMsg binder (ptext (sLit "RHS")) ty) - -- Check (not isUnLiftedType) (also checks for bogus unboxed tuples) + -- Check the let/app invariant + -- See Note [CoreSyn let/app invariant] in CoreSyn ; checkL (not (isUnLiftedType binder_ty) || (isNonRec rec_flag && exprOkForSpeculation rhs)) (mkRhsPrimMsg binder rhs) @@ -220,6 +221,7 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- Check that if the binder is local, it is not marked as exported ; checkL (not (isExportedId binder) || isTopLevel top_lvl_flag) (mkNonTopExportedMsg binder) + -- Check that if the binder is local, it does not have an external name ; checkL (not (isExternalName (Var.varName binder)) || isTopLevel top_lvl_flag) (mkNonTopExternalNameMsg binder) @@ -451,6 +453,8 @@ lintCoreArg fun_ty (Type arg_ty) lintCoreArg fun_ty arg = do { arg_ty <- lintCoreExpr arg + ; checkL (not (isUnLiftedType arg_ty) || exprOkForSpeculation arg) + (mkLetAppMsg arg) ; lintValApp arg fun_ty arg_ty } ----------------- @@ -1391,6 +1395,11 @@ mkRhsMsg binder what ty hsep [ptext (sLit "Binder's type:"), ppr (idType binder)], hsep [ptext (sLit "Rhs type:"), ppr ty]] +mkLetAppMsg :: CoreExpr -> MsgDoc +mkLetAppMsg e + = hang (ptext (sLit "This argument does not satisfy the let/app invariant:")) + 2 (ppr e) + mkRhsPrimMsg :: Id -> CoreExpr -> MsgDoc mkRhsPrimMsg binder _rhs = vcat [hsep [ptext (sLit "The type of this binder is primitive:"), From git at git.haskell.org Thu Aug 7 08:55:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 08:55:37 +0000 (UTC) Subject: [commit: ghc] master: Add Output instance for OrdList (93b1a43) Message-ID: <20140807085537.E0C4B240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/93b1a43ebe8bf145b35e903966d4a62b7847f213/ghc >--------------------------------------------------------------- commit 93b1a43ebe8bf145b35e903966d4a62b7847f213 Author: Simon Peyton Jones Date: Fri Aug 1 16:40:18 2014 +0100 Add Output instance for OrdList >--------------------------------------------------------------- 93b1a43ebe8bf145b35e903966d4a62b7847f213 compiler/utils/OrdList.lhs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/compiler/utils/OrdList.lhs b/compiler/utils/OrdList.lhs index d1d8708..42abb51 100644 --- a/compiler/utils/OrdList.lhs +++ b/compiler/utils/OrdList.lhs @@ -15,6 +15,8 @@ module OrdList ( mapOL, fromOL, toOL, foldrOL, foldlOL ) where +import Outputable + infixl 5 `appOL` infixl 5 `snocOL` infixr 5 `consOL` @@ -28,6 +30,8 @@ data OrdList a | Two (OrdList a) -- Invariant: non-empty (OrdList a) -- Invariant: non-empty +instance Outputable a => Outputable (OrdList a) where + ppr ol = ppr (fromOL ol) -- Convert to list and print that nilOL :: OrdList a isNilOL :: OrdList a -> Bool From git at git.haskell.org Thu Aug 7 08:55:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 08:55:40 +0000 (UTC) Subject: [commit: ghc] master: Don't float into unlifted function arguments (1736082) Message-ID: <20140807085540.44D66240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1736082115ad3be9a7d1dcc2f412c5ca60f2cfe3/ghc >--------------------------------------------------------------- commit 1736082115ad3be9a7d1dcc2f412c5ca60f2cfe3 Author: Simon Peyton Jones Date: Fri Aug 1 16:53:21 2014 +0100 Don't float into unlifted function arguments We were inadvertently destroying the let/app invariant, by floating into an unlifted function argument. >--------------------------------------------------------------- 1736082115ad3be9a7d1dcc2f412c5ca60f2cfe3 compiler/simplCore/FloatIn.lhs | 68 +++++++++++++++++++++++++++++++----------- 1 file changed, 50 insertions(+), 18 deletions(-) diff --git a/compiler/simplCore/FloatIn.lhs b/compiler/simplCore/FloatIn.lhs index 2cf886c..95e4cd3 100644 --- a/compiler/simplCore/FloatIn.lhs +++ b/compiler/simplCore/FloatIn.lhs @@ -26,16 +26,17 @@ module FloatIn ( floatInwards ) where import CoreSyn import MkCore -import CoreUtils ( exprIsDupable, exprIsExpandable, exprOkForSideEffects ) +import CoreUtils ( exprIsDupable, exprIsExpandable, exprType, exprOkForSideEffects ) import CoreFVs ( CoreExprWithFVs, freeVars, freeVarsOf, idRuleAndUnfoldingVars ) import Id ( isOneShotBndr, idType ) import Var -import Type ( isUnLiftedType ) +import Type ( Type, isUnLiftedType, splitFunTy, applyTy ) import VarSet import Util import UniqFM import DynFlags import Outputable +import Data.List( mapAccumL ) \end{code} Top-level interface function, @floatInwards at . Note that we do not @@ -155,18 +156,42 @@ need to get at all the arguments. The next simplifier run will pull out any silly ones. \begin{code} -fiExpr dflags to_drop (_,AnnApp fun arg@(arg_fvs, ann_arg)) - | noFloatIntoRhs ann_arg = wrapFloats drop_here $ wrapFloats arg_drop $ - App (fiExpr dflags fun_drop fun) (fiExpr dflags [] arg) - -- It's inconvenient to test for an unlifted arg here, - -- and it really doesn't matter if we float into one - | otherwise = wrapFloats drop_here $ - App (fiExpr dflags fun_drop fun) (fiExpr dflags arg_drop arg) +fiExpr dflags to_drop ann_expr@(_,AnnApp {}) + = wrapFloats drop_here $ wrapFloats extra_drop $ + mkApps (fiExpr dflags fun_drop ann_fun) + (zipWith (fiExpr dflags) arg_drops ann_args) where - [drop_here, fun_drop, arg_drop] - = sepBindsByDropPoint dflags False [freeVarsOf fun, arg_fvs] to_drop + (ann_fun@(fun_fvs, _), ann_args) = collectAnnArgs ann_expr + fun_ty = exprType (deAnnotate ann_fun) + ((_,extra_fvs), arg_fvs) = mapAccumL mk_arg_fvs (fun_ty, emptyVarSet) ann_args + + -- All this faffing about is so that we can get hold of + -- the types of the arguments, to pass to noFloatIntoRhs + mk_arg_fvs :: (Type, FreeVarSet) -> CoreExprWithFVs -> ((Type, FreeVarSet), FreeVarSet) + mk_arg_fvs (fun_ty, extra_fvs) (_, AnnType ty) + = ((applyTy fun_ty ty, extra_fvs), emptyVarSet) + + mk_arg_fvs (fun_ty, extra_fvs) (arg_fvs, ann_arg) + | noFloatIntoRhs ann_arg arg_ty + = ((res_ty, extra_fvs `unionVarSet` arg_fvs), emptyVarSet) + | otherwise + = ((res_ty, extra_fvs), arg_fvs) + where + (arg_ty, res_ty) = splitFunTy fun_ty + + drop_here : extra_drop : fun_drop : arg_drops + = sepBindsByDropPoint dflags False (extra_fvs : fun_fvs : arg_fvs) to_drop \end{code} +Note [Do not destroy the let/app invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Watch out for + f (x +# y) +We don't want to float bindings into here + f (case ... of { x -> x +# y }) +because that might destroy the let/app invariant, which requires +unlifted function arguments to be ok-for-speculation. + Note [Floating in past a lambda group] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * We must be careful about floating inside inside a value lambda. @@ -288,11 +313,11 @@ fiExpr dflags to_drop (_,AnnLet (AnnNonRec id rhs@(rhs_fvs, ann_rhs)) body) = fiExpr dflags new_to_drop body where body_fvs = freeVarsOf body `delVarSet` id + rhs_ty = idType id rule_fvs = idRuleAndUnfoldingVars id -- See Note [extra_fvs (2): free variables of rules] - extra_fvs | noFloatIntoRhs ann_rhs - || isUnLiftedType (idType id) = rule_fvs `unionVarSet` rhs_fvs - | otherwise = rule_fvs + extra_fvs | noFloatIntoRhs ann_rhs rhs_ty = rule_fvs `unionVarSet` rhs_fvs + | otherwise = rule_fvs -- See Note [extra_fvs (1): avoid floating into RHS] -- No point in floating in only to float straight out again -- Ditto ok-for-speculation unlifted RHSs @@ -322,7 +347,7 @@ fiExpr dflags to_drop (_,AnnLet (AnnRec bindings) body) rule_fvs = foldr (unionVarSet . idRuleAndUnfoldingVars) emptyVarSet ids extra_fvs = rule_fvs `unionVarSet` unionVarSets [ fvs | (fvs, rhs) <- rhss - , noFloatIntoRhs rhs ] + , noFloatIntoExpr rhs ] (shared_binds:extra_binds:body_binds:rhss_binds) = sepBindsByDropPoint dflags False (extra_fvs:body_fvs:rhss_fvs) to_drop @@ -403,8 +428,15 @@ okToFloatInside bndrs = all ok bndrs ok b = not (isId b) || isOneShotBndr b -- Push the floats inside there are no non-one-shot value binders -noFloatIntoRhs :: AnnExpr' Var (UniqFM Var) -> Bool -noFloatIntoRhs (AnnLam bndr e) +noFloatIntoRhs :: AnnExpr' Var (UniqFM Var) -> Type -> Bool +-- ^ True if it's a bad idea to float bindings into this RHS +-- Preconditio: rhs :: rhs_ty +noFloatIntoRhs rhs rhs_ty + = isUnLiftedType rhs_ty -- See Note [Do not destroy the let/app invariant] + || noFloatIntoExpr rhs + +noFloatIntoExpr :: AnnExpr' Var (UniqFM Var) -> Bool +noFloatIntoExpr (AnnLam bndr e) = not (okToFloatInside (bndr:bndrs)) -- NB: Must line up with fiExpr (AnnLam...); see Trac #7088 where @@ -418,7 +450,7 @@ noFloatIntoRhs (AnnLam bndr e) -- boxing constructor into it, else we box it every time which is very bad -- news indeed. -noFloatIntoRhs rhs = exprIsExpandable (deAnnotate' rhs) +noFloatIntoExpr rhs = exprIsExpandable (deAnnotate' rhs) -- We'd just float right back out again... -- Should match the test in SimplEnv.doFloatFromRhs \end{code} From git at git.haskell.org Thu Aug 7 08:55:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 08:55:42 +0000 (UTC) Subject: [commit: ghc] master: When desugaring Use the smart mkCoreConApps and friends (1fc60ea) Message-ID: <20140807085542.C82DD240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1fc60ea1f1fd89b90c2992d060aecb5b5a65f8c0/ghc >--------------------------------------------------------------- commit 1fc60ea1f1fd89b90c2992d060aecb5b5a65f8c0 Author: Simon Peyton Jones Date: Fri Aug 1 16:56:10 2014 +0100 When desugaring Use the smart mkCoreConApps and friends This is actually the bug that triggered Trac #9390. We had an unboxed tuple (# writeArray# ..., () #), and that writeArray# argument isn't ok-for-speculation, so disobeys the invariant. The desugaring of unboxed tuples was to blame; the fix is easy. >--------------------------------------------------------------- 1fc60ea1f1fd89b90c2992d060aecb5b5a65f8c0 compiler/deSugar/DsArrows.lhs | 4 ++-- compiler/deSugar/DsCCall.lhs | 6 +++--- compiler/deSugar/DsExpr.lhs | 6 +++--- compiler/deSugar/DsMeta.hs | 2 +- compiler/deSugar/MatchLit.lhs | 2 +- 5 files changed, 10 insertions(+), 10 deletions(-) diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs index 1bbcc05..35a2477 100644 --- a/compiler/deSugar/DsArrows.lhs +++ b/compiler/deSugar/DsArrows.lhs @@ -466,8 +466,8 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdIf mb_fun cond then_cmd else_cmd) left_con <- dsLookupDataCon leftDataConName right_con <- dsLookupDataCon rightDataConName - let mk_left_expr ty1 ty2 e = mkConApp left_con [Type ty1, Type ty2, e] - mk_right_expr ty1 ty2 e = mkConApp right_con [Type ty1, Type ty2, e] + let mk_left_expr ty1 ty2 e = mkCoreConApps left_con [Type ty1, Type ty2, e] + mk_right_expr ty1 ty2 e = mkCoreConApps right_con [Type ty1, Type ty2, e] in_ty = envStackType env_ids stack_ty then_ty = envStackType then_ids stack_ty diff --git a/compiler/deSugar/DsCCall.lhs b/compiler/deSugar/DsCCall.lhs index 217a4ce..a47b9ea 100644 --- a/compiler/deSugar/DsCCall.lhs +++ b/compiler/deSugar/DsCCall.lhs @@ -238,9 +238,9 @@ boxResult result_ty _ -> [] return_result state anss - = mkConApp (tupleCon UnboxedTuple (2 + length extra_result_tys)) - (map Type (realWorldStatePrimTy : io_res_ty : extra_result_tys) - ++ (state : anss)) + = mkCoreConApps (tupleCon UnboxedTuple (2 + length extra_result_tys)) + (map Type (realWorldStatePrimTy : io_res_ty : extra_result_tys) + ++ (state : anss)) ; (ccall_res_ty, the_alt) <- mk_alt return_result res diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs index 4eadef69..2a2d733 100644 --- a/compiler/deSugar/DsExpr.lhs +++ b/compiler/deSugar/DsExpr.lhs @@ -293,8 +293,8 @@ dsExpr (ExplicitTuple tup_args boxity) -- The reverse is because foldM goes left-to-right ; return $ mkCoreLams lam_vars $ - mkConApp (tupleCon (boxityNormalTupleSort boxity) (length tup_args)) - (map (Type . exprType) args ++ args) } + mkCoreConApps (tupleCon (boxityNormalTupleSort boxity) (length tup_args)) + (map (Type . exprType) args ++ args) } dsExpr (HsSCC cc expr@(L loc _)) = do mod_name <- getModule @@ -435,7 +435,7 @@ dsExpr (RecordCon (L _ data_con_id) con_expr rbinds) = do then mapM unlabelled_bottom arg_tys else mapM mk_arg (zipEqual "dsExpr:RecordCon" arg_tys labels) - return (mkApps con_expr' con_args) + return (mkCoreApps con_expr' con_args) \end{code} Record update is a little harder. Suppose we have the decl: diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 2713f95..28e6fef 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -1476,7 +1476,7 @@ rep2 n xs = do { id <- dsLookupGlobalId n dataCon' :: Name -> [CoreExpr] -> DsM (Core a) dataCon' n args = do { id <- dsLookupDataCon n - ; return $ MkC $ mkConApp id args } + ; return $ MkC $ mkCoreConApps id args } dataCon :: Name -> DsM (Core a) dataCon n = dataCon' n [] diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs index 350ed22..71a5e10 100644 --- a/compiler/deSugar/MatchLit.lhs +++ b/compiler/deSugar/MatchLit.lhs @@ -92,7 +92,7 @@ dsLit (HsInt i) = do dflags <- getDynFlags dsLit (HsRat r ty) = do num <- mkIntegerExpr (numerator (fl_value r)) denom <- mkIntegerExpr (denominator (fl_value r)) - return (mkConApp ratio_data_con [Type integer_ty, num, denom]) + return (mkCoreConApps ratio_data_con [Type integer_ty, num, denom]) where (ratio_data_con, integer_ty) = case tcSplitTyConApp ty of From git at git.haskell.org Thu Aug 7 08:55:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 08:55:45 +0000 (UTC) Subject: [commit: ghc] master: Make buildToArrPReprs obey the let/app invariant (d174f49) Message-ID: <20140807085545.33AC6240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d174f49cafd14bbb448ca3c16a6743eaae942173/ghc >--------------------------------------------------------------- commit d174f49cafd14bbb448ca3c16a6743eaae942173 Author: Simon Peyton Jones Date: Mon Aug 4 13:03:09 2014 +0100 Make buildToArrPReprs obey the let/app invariant Vectorise.Generic.PAMethods.buildToArrPReprs was building an expression like pvoids# (lengthSels2# sels) which does not satisfy the let/app invariant. It should be more like case lengthSels2# sels of l -> pvoids# l This was caught by Core Lint (once it was taught to check for the invariant) >--------------------------------------------------------------- d174f49cafd14bbb448ca3c16a6743eaae942173 compiler/vectorise/Vectorise/Generic/PAMethods.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/compiler/vectorise/Vectorise/Generic/PAMethods.hs b/compiler/vectorise/Vectorise/Generic/PAMethods.hs index 269119c..0d5d37c 100644 --- a/compiler/vectorise/Vectorise/Generic/PAMethods.hs +++ b/compiler/vectorise/Vectorise/Generic/PAMethods.hs @@ -16,7 +16,7 @@ import Vectorise.Generic.Description import CoreSyn import CoreUtils import FamInstEnv -import MkCore ( mkWildCase ) +import MkCore ( mkWildCase, mkCoreLet ) import TyCon import CoAxiom import Type @@ -24,6 +24,7 @@ import OccName import Coercion import MkId import FamInst +import TysPrim( intPrimTy ) import DynFlags import FastString @@ -404,9 +405,13 @@ buildToArrPReprs vect_tc repr_co _ pdatas_tc r -- and PDatas Void arrays in the product. See Note [Empty PDatas]. let xSums = App (repr_selsLength_v ss) (Var sels) - (vars, exprs) <- mapAndUnzipM (to_con xSums) (repr_cons ss) + xSums_var <- newLocalVar (fsLit "xsum") intPrimTy + + (vars, exprs) <- mapAndUnzipM (to_con xSums_var) (repr_cons ss) return ( sels : concat vars , wrapFamInstBody psums_tc (repr_con_tys ss) + $ mkCoreLet (NonRec xSums_var xSums) + -- mkCoreLet ensures that the let/app invariant holds $ mkConApp psums_con $ map Type (repr_con_tys ss) ++ (Var sels : exprs)) @@ -414,7 +419,7 @@ buildToArrPReprs vect_tc repr_co _ pdatas_tc r = case ss of EmptyProd -> do pvoids <- builtin pvoidsVar - return ([], App (Var pvoids) xSums ) + return ([], App (Var pvoids) (Var xSums) ) UnaryProd r -> do pty <- mkPDatasType (compOrigType r) From git at git.haskell.org Thu Aug 7 08:55:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 08:55:48 +0000 (UTC) Subject: [commit: ghc] master: Document the maintenance of the let/app invariant in the simplifier (db17d58) Message-ID: <20140807085548.24E0E240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/db17d58dc4c43de155022909bfae7263d7870d0a/ghc >--------------------------------------------------------------- commit db17d58dc4c43de155022909bfae7263d7870d0a Author: Simon Peyton Jones Date: Mon Aug 4 16:37:57 2014 +0100 Document the maintenance of the let/app invariant in the simplifier It's not obvious why the simplifier generates code that correctly satisfies the let/app invariant. This patch does some minor refactoring, but the main point is to document pre-conditions to key functions, namely that the rhs passed in satisfies the let/app invariant. There shouldn't be any change in behaviour. >--------------------------------------------------------------- db17d58dc4c43de155022909bfae7263d7870d0a compiler/coreSyn/CoreSyn.lhs | 5 ++- compiler/simplCore/SimplEnv.lhs | 81 +++++++++++++++++++-------------------- compiler/simplCore/SimplUtils.lhs | 8 ++++ compiler/simplCore/Simplify.lhs | 23 ++++++++--- 4 files changed, 68 insertions(+), 49 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc db17d58dc4c43de155022909bfae7263d7870d0a From git at git.haskell.org Thu Aug 7 08:55:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 08:55:51 +0000 (UTC) Subject: [commit: ghc] master: Extensive Notes on can_fail and has_side_effects (ab6480b) Message-ID: <20140807085552.6C8BD240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ab6480b8d8ea45ae6958558245266153df071aa5/ghc >--------------------------------------------------------------- commit ab6480b8d8ea45ae6958558245266153df071aa5 Author: Simon Peyton Jones Date: Thu Aug 7 07:46:24 2014 +0100 Extensive Notes on can_fail and has_side_effects In fixing Trac #9390 I discovered that I *still* didn't really understand what the can_fail and has_side_effects properties of a PrimOp mean, precisely. The big new things I learned are * has_side_effects needs to be true only of *write* effects, Reads (which are, strictly speaking, effects) don't matter here. * has_side_effects must be true of primops that can throw a synchronous Haskell exception (eg raiseIO#) * can_fail is true only of primops that can cause an *unchecked* (not Haskell) system exception, like divide by zero, or accessing memory out of range through an array read or write. I've documented all this now. The changes in this patch are only in comments. >--------------------------------------------------------------- ab6480b8d8ea45ae6958558245266153df071aa5 compiler/coreSyn/CoreUtils.lhs | 19 ++++-- compiler/prelude/PrimOp.lhs | 149 ++++++++++++++++++++++++++++------------- compiler/simplCore/FloatIn.lhs | 1 + 3 files changed, 119 insertions(+), 50 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ab6480b8d8ea45ae6958558245266153df071aa5 From git at git.haskell.org Thu Aug 7 08:55:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 08:55:53 +0000 (UTC) Subject: [commit: ghc] master: Refactor the handling of case-elimination (8367f06) Message-ID: <20140807085553.DFB12240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8367f062785cd30d7ab6dfc52c0aa4d5a9a941fd/ghc >--------------------------------------------------------------- commit 8367f062785cd30d7ab6dfc52c0aa4d5a9a941fd Author: Simon Peyton Jones Date: Thu Aug 7 07:47:28 2014 +0100 Refactor the handling of case-elimination Mainly in Simplify.rebuildCase. The old code wasn't wrong, but I kept mis-understanding it. This patch cuts splits out "pure seq" from "strict let", which makes it much easier to grok. >--------------------------------------------------------------- 8367f062785cd30d7ab6dfc52c0aa4d5a9a941fd compiler/simplCore/Simplify.lhs | 119 ++++++++++++++++++++-------------------- 1 file changed, 60 insertions(+), 59 deletions(-) diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index 8e010c0..cc214f7 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -1351,22 +1351,21 @@ simplNonRecE env bndr (Type ty_arg, rhs_se) (bndrs, body) cont simplNonRecE env bndr (rhs, rhs_se) (bndrs, body) cont = do dflags <- getDynFlags case () of - _ - | preInlineUnconditionally dflags env NotTopLevel bndr rhs -> - do { tick (PreInlineUnconditionally bndr) - ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $ + _ | preInlineUnconditionally dflags env NotTopLevel bndr rhs + -> do { tick (PreInlineUnconditionally bndr) + ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $ simplLam (extendIdSubst env bndr (mkContEx rhs_se rhs)) bndrs body cont } - | isStrictId bndr -> -- Includes coercions - do { simplExprF (rhs_se `setFloats` env) rhs - (StrictBind bndr bndrs body env cont) } + | isStrictId bndr -- Includes coercions + -> simplExprF (rhs_se `setFloats` env) rhs + (StrictBind bndr bndrs body env cont) - | otherwise -> - ASSERT( not (isTyVar bndr) ) - do { (env1, bndr1) <- simplNonRecBndr env bndr - ; let (env2, bndr2) = addBndrRules env1 bndr bndr1 - ; env3 <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se - ; simplLam env3 bndrs body cont } + | otherwise + -> ASSERT( not (isTyVar bndr) ) + do { (env1, bndr1) <- simplNonRecBndr env bndr + ; let (env2, bndr2) = addBndrRules env1 bndr bndr1 + ; env3 <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se + ; simplLam env3 bndrs body cont } \end{code} %************************************************************************ @@ -1726,7 +1725,13 @@ transformation: or (b) 'x' is not used at all and e is ok-for-speculation The ok-for-spec bit checks that we don't lose any - exceptions or divergence + exceptions or divergence. + + NB: it'd be *sound* to switch from case to let if the + scrutinee was not yet WHNF but was guaranteed to + converge; but sticking with case means we won't build a + thunk + or (c) 'x' is used strictly in the body, and 'e' is a variable Then we can just substitute 'e' for 'x' in the body. @@ -1881,56 +1886,41 @@ rebuildCase env scrut case_bndr alts cont -- 2. Eliminate the case if scrutinee is evaluated -------------------------------------------------- -rebuildCase env scrut case_bndr [(_, bndrs, rhs)] cont +rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont -- See if we can get rid of the case altogether -- See Note [Case elimination] -- mkCase made sure that if all the alternatives are equal, -- then there is now only one (DEFAULT) rhs - | all isDeadBinder bndrs -- bndrs are [InId] - - , if isUnLiftedType (idType case_bndr) - then elim_unlifted -- Satisfy the let-binding invariant - else elim_lifted - = do { -- pprTrace "case elim" (vcat [ppr case_bndr, ppr (exprIsHNF scrut), - -- ppr ok_for_spec, - -- ppr scrut]) $ - tick (CaseElim case_bndr) - ; env' <- simplNonRecX env case_bndr scrut - -- If case_bndr is dead, simplNonRecX will discard - ; simplExprF env' rhs cont } - where - elim_lifted -- See Note [Case elimination: lifted case] - = exprIsHNF scrut - || (is_plain_seq && ok_for_spec) - -- Note: not the same as exprIsHNF - || (strict_case_bndr && scrut_is_var scrut) - -- See Note [Eliminating redundant seqs] - - elim_unlifted - | is_plain_seq = exprOkForSideEffects scrut - -- The entire case is dead, so we can drop it, - -- _unless_ the scrutinee has side effects - | otherwise = ok_for_spec - -- The case-binder is alive, but we may be able - -- turn the case into a let, if the expression is ok-for-spec - -- See Note [Case elimination: unlifted case] - - ok_for_spec = exprOkForSpeculation scrut - is_plain_seq = isDeadBinder case_bndr -- Evaluation *only* for effect - strict_case_bndr = isStrictDmd (idDemandInfo case_bndr) - - scrut_is_var :: CoreExpr -> Bool - scrut_is_var (Cast s _) = scrut_is_var s - scrut_is_var (Var _) = True - scrut_is_var _ = False - --------------------------------------------------- --- 3. Try seq rules; see Note [User-defined RULES for seq] in MkId --------------------------------------------------- - -rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont - | all isDeadBinder (case_bndr : bndrs) -- So this is just 'seq' + -- 2a. Dropping the case altogether, if + -- a) it binds nothing (so it's really just a 'seq') + -- b) evaluating the scrutinee has no side effects + | is_plain_seq + , exprOkForSideEffects scrut + -- The entire case is dead, so we can drop it + -- if the scrutinee converges without having imperative + -- side effects or raising a Haskell exception + -- See Note [PrimOp can_fail and has_side_effects] in PrimOp + = simplExprF env rhs cont + + -- 2b. Turn the case into a let, if + -- a) it binds only the case-binder + -- b) unlifted case: the scrutinee is ok-for-speculation + -- lifted case: the scrutinee is in HNF (or will later be demanded) + | all_dead_bndrs + , if is_unlifted + then exprOkForSpeculation scrut -- See Note [Case elimination: unlifted case] + else exprIsHNF scrut -- See Note [Case elimination: lifted case] + || scrut_is_demanded_var scrut + = do { tick (CaseElim case_bndr) + ; env' <- simplNonRecX env case_bndr scrut + ; simplExprF env' rhs cont } + + -- 2c. Try the seq rules if + -- a) it binds only the case binder + -- b) a rule for seq applies + -- See Note [User-defined RULES for seq] in MkId + | is_plain_seq = do { let rhs' = substExpr (text "rebuild-case") env rhs env' = zapSubstEnv env out_args = [Type (substTy env (idType case_bndr)), @@ -1942,6 +1932,17 @@ rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont ; case mb_rule of Just (rule_rhs, cont') -> simplExprF env' rule_rhs cont' Nothing -> reallyRebuildCase env scrut case_bndr alts cont } + where + is_unlifted = isUnLiftedType (idType case_bndr) + all_dead_bndrs = all isDeadBinder bndrs -- bndrs are [InId] + is_plain_seq = all_dead_bndrs && isDeadBinder case_bndr -- Evaluation *only* for effect + + scrut_is_demanded_var :: CoreExpr -> Bool + -- See Note [Eliminating redundant seqs] + scrut_is_demanded_var (Cast s _) = scrut_is_demanded_var s + scrut_is_demanded_var (Var _) = isStrictDmd (idDemandInfo case_bndr) + scrut_is_demanded_var _ = False + rebuildCase env scrut case_bndr alts cont = reallyRebuildCase env scrut case_bndr alts cont From git at git.haskell.org Thu Aug 7 08:55:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 08:55:56 +0000 (UTC) Subject: [commit: ghc] master: Add has_side_effets to the raise# primop (0957a9b) Message-ID: <20140807085556.3B7E9240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0957a9b0e3f9723761d12d9684c93209a8056755/ghc >--------------------------------------------------------------- commit 0957a9b0e3f9723761d12d9684c93209a8056755 Author: Simon Peyton Jones Date: Thu Aug 7 07:56:28 2014 +0100 Add has_side_effets to the raise# primop According to the definition of has_side_effets in PrimOp, raise# clearly has side effects! In practice it makes little difference becuase the fact that it returns bottom is more important... but still it's better to say it right. >--------------------------------------------------------------- 0957a9b0e3f9723761d12d9684c93209a8056755 compiler/prelude/primops.txt.pp | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 4faa585..19cd812 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -1881,6 +1881,11 @@ primop RaiseOp "raise#" GenPrimOp strictness = { \ _arity -> mkClosedStrictSig [topDmd] botRes } -- NB: result is bottom out_of_line = True + has_side_effects = True + -- raise# certainly throws a Haskell exception and hence has_side_effects + -- It doesn't actually make much difference because the fact that it + -- returns bottom independently ensures that we are careful not to discard + -- it. But still, it's better to say the Right Thing. -- raiseIO# needs to be a primop, because exceptions in the IO monad -- must be *precise* - we don't want the strictness analyser turning From git at git.haskell.org Thu Aug 7 09:08:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 09:08:18 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #9390 (2990e97) Message-ID: <20140807090818.65D4A240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2990e97f008c9703eb4b47e24a29d052d5735f00/ghc >--------------------------------------------------------------- commit 2990e97f008c9703eb4b47e24a29d052d5735f00 Author: Simon Peyton Jones Date: Thu Aug 7 10:08:00 2014 +0100 Test Trac #9390 >--------------------------------------------------------------- 2990e97f008c9703eb4b47e24a29d052d5735f00 testsuite/tests/simplCore/should_run/T9390.hs | 27 +++++++++++++++++++++++ testsuite/tests/simplCore/should_run/T9390.stdout | 1 + testsuite/tests/simplCore/should_run/all.T | 1 + 3 files changed, 29 insertions(+) diff --git a/testsuite/tests/simplCore/should_run/T9390.hs b/testsuite/tests/simplCore/should_run/T9390.hs new file mode 100644 index 0000000..04b4da0 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T9390.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +module Main(main ) where + +import GHC.IO (IO (..)) +import GHC.Prim + +writeB :: MutableArray# RealWorld Char -> IO () +writeB arr# = IO $ \s0# -> (# writeArray# arr# 0# 'B' s0#, () #) + +inlineWriteB :: MutableArray# RealWorld Char -> () +inlineWriteB arr# = + case f realWorld# of + (# _, x #) -> x + where + IO f = writeB arr# + +test :: IO Char +test = IO $ \s0# -> + case newArray# 1# 'A' s0# of + (# s1#, arr# #) -> + case seq# (inlineWriteB arr#) s1# of + (# s2#, () #) -> + readArray# arr# 0# s2# + +main :: IO () +main = test >>= print + diff --git a/testsuite/tests/simplCore/should_run/T9390.stdout b/testsuite/tests/simplCore/should_run/T9390.stdout new file mode 100644 index 0000000..69349b4 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T9390.stdout @@ -0,0 +1 @@ +'B' diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index e36fb00..93dc4c6 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -67,3 +67,4 @@ test('T7924', exit_code(1), compile_and_run, ['']) test('T457', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run, ['']) test('T9128', normal, compile_and_run, ['']) +test('T9390', normal, compile_and_run, ['']) From git at git.haskell.org Thu Aug 7 11:24:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 11:24:48 +0000 (UTC) Subject: [commit: ghc] master: Fix some typos in recent comments/notes (18ac546) Message-ID: <20140807112448.99398240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/18ac546d8db93f170cdbc29da8b7118272b065e7/ghc >--------------------------------------------------------------- commit 18ac546d8db93f170cdbc29da8b7118272b065e7 Author: Gabor Greif Date: Thu Aug 7 13:22:25 2014 +0200 Fix some typos in recent comments/notes >--------------------------------------------------------------- 18ac546d8db93f170cdbc29da8b7118272b065e7 compiler/coreSyn/CoreSyn.lhs | 2 +- compiler/coreSyn/CoreUtils.lhs | 4 ++-- compiler/prelude/PrimOp.lhs | 18 +++++++++--------- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index 3efc647..12a60da 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -363,7 +363,7 @@ In this situation you should use @case@ rather than a @let at . The function alternatively use 'MkCore.mkCoreLet' rather than this constructor directly, which will generate a @case@ if necessary -Th let/app invariant is intially enforced by DsUtils.mkCoreLet and mkCoreApp +Th let/app invariant is initially enforced by DsUtils.mkCoreLet and mkCoreApp Note [CoreSyn case invariants] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index 369af16..baf7e4f 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -913,7 +913,7 @@ it's applied only to dictionaries. -- c) without causing a write side effect (e.g. writing a mutable variable) -- d) without throwing a Haskell exception -- e) without risking an unchecked runtime exception (array out of bounds, --- divide byzero) +-- divide by zero) -- -- For @exprOkForSideEffects@ the list is the same, but omitting (e). -- @@ -922,7 +922,7 @@ it's applied only to dictionaries. -- exprOkForSpeculation implies exprOkForSideEffects -- -- See Note [PrimOp can_fail and has_side_effects] in PrimOp --- and Note [Implementation: how can_fail/has_side_effects affect transformaations] +-- and Note [Implementation: how can_fail/has_side_effects affect transformations] -- -- As an example of the considerations in this test, consider: -- diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs index 2e33406..198078b 100644 --- a/compiler/prelude/PrimOp.lhs +++ b/compiler/prelude/PrimOp.lhs @@ -354,20 +354,20 @@ data dependencies of the state token to enforce write-effect ordering * NB3: *Read* effects (like reading an IORef) don't count here, because it doesn't matter if we don't do them, or do them more than - once. *Sequencing* is maintain by the data dependency of the state + once. *Sequencing* is maintained by the data dependency of the state token. ---------- can_fail ---------------------------- -A primop "can_fail" if if can fail with an *unchecked* exception on +A primop "can_fail" if it can fail with an *unchecked* exception on some elements of its input domain. Main examples: - division (fails on zero demoninator + division (fails on zero demoninator) array indexing (fails if the index is out of bounds) -An "unchecked exception" is one that is an outright error, not -turned into a Haskell exception), such as seg-fault or +An "unchecked exception" is one that is an outright error, (not +turned into a Haskell exception,) such as seg-fault or divide-by-zero error. Such can_fail primops are ALWAYS surrounded with a test that checks for the bad cases, but we need to be -very careful about code motion that might move the out of +very careful about code motion that might move it out of the scope of the test. Note [Transformations affected by can_fail and has_side_effects] @@ -404,7 +404,7 @@ Duplicate YES NO - Synchronous Haskell exceptions, eg from raiseIO#, are treated + Synchronous Haskell exceptions, e.g. from raiseIO#, are treated as has_side_effects and hence are not discarded. * Float in. You can float a can_fail or has_side_effects primop @@ -449,7 +449,7 @@ Duplicate YES NO However, it's fine to duplicate a can_fail primop. That is really the only difference between can_fail and has_side_effects. -Note [Implementation: how can_fail/has_side_effects affect transformaations] +Note [Implementation: how can_fail/has_side_effects affect transformations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ How do we ensure that that floating/duplication/discarding are done right in the simplifier? @@ -487,7 +487,7 @@ primOpOkForSpeculation op = primOpOkForSideEffects op && not (primOpOutOfLine op || primOpCanFail op) -- I think the "out of line" test is because out of line things can - -- be expensive (eg sine, consine), and so we may not want to speculate them + -- be expensive (eg sine, cosine), and so we may not want to speculate them primOpOkForSideEffects :: PrimOp -> Bool primOpOkForSideEffects op From git at git.haskell.org Thu Aug 7 13:09:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 13:09:58 +0000 (UTC) Subject: [commit: ghc] master: Give the Unique generated by strings a tag '$', fixes #9413. (4855be0) Message-ID: <20140807130958.EEE02240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4855be0d0d1ac90f836a6fb54f4034f478e38fd8/ghc >--------------------------------------------------------------- commit 4855be0d0d1ac90f836a6fb54f4034f478e38fd8 Author: Edward Z. Yang Date: Wed Aug 6 11:55:06 2014 +0100 Give the Unique generated by strings a tag '$', fixes #9413. Summary: Previously, we allocated uniques for strings starting at zero, which means the tag bits in the unique are zero, which means that printing a Unique for a string will start with a null byte. This is bad. So instead, start our numbering with the tag byte as '$' (as in $tring). This is hard coded so we don't have to worry about the optimizer reducing the expression. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: hvr, simonmar, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D123 GHC Trac Issues: #9413 >--------------------------------------------------------------- 4855be0d0d1ac90f836a6fb54f4034f478e38fd8 compiler/utils/FastString.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs index 0396c02..157e5f0 100644 --- a/compiler/utils/FastString.lhs +++ b/compiler/utils/FastString.lhs @@ -239,7 +239,7 @@ data FastStringTable = string_table :: FastStringTable {-# NOINLINE string_table #-} string_table = unsafePerformIO $ do - uid <- newIORef 0 + uid <- newIORef 603979776 -- ord '$' * 0x01000000 tab <- IO $ \s1# -> case newArray# hASH_TBL_SIZE_UNBOXED (panic "string_table") s1# of (# s2#, arr# #) -> (# s2#, FastStringTable uid arr# #) From git at git.haskell.org Thu Aug 7 13:19:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 13:19:07 +0000 (UTC) Subject: [commit: ghc] master: Permanently accept the Haddock performance number bump, and add some TODOs (d026e9e) Message-ID: <20140807131907.50ABF240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d026e9e889f347a86425c34b61bfb443a409d1e3/ghc >--------------------------------------------------------------- commit d026e9e889f347a86425c34b61bfb443a409d1e3 Author: Edward Z. Yang Date: Thu Aug 7 14:15:13 2014 +0100 Permanently accept the Haddock performance number bump, and add some TODOs I bisected the performance difference in Haddock and found it was due to d6aec63c009c4e57181900eb03847d7dc0fc3c7c, which I accidentally picked up when updating Haddock 00b8f8c5b378fc679639ebe81238cf42d92aa607. The performance regression is justified by the fact that we are now actually processing URLs in Haddock comments that we were not previously, so there would be more allocation. Time use was not affected. The TODOs simply reflect the fact that we need updated numbers for 32-bit Linux and Windows. Please add them when you get a chance. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- d026e9e889f347a86425c34b61bfb443a409d1e3 testsuite/tests/perf/haddock/all.T | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 376a944..dbd2471 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -44,19 +44,19 @@ test('haddock.base', # 2013-11-21: 6756213256 (x86_64/Linux) # 2014-01-12: 7128342344 (x86_64/Linux) # 2014-06-12: 7498123680 (x86_64/Linux) - # XXX This one is TEMPORARY, it's due to an unoptimized error-path - # that Haddock is tickling, I am profiling and fixing this. - # 2014-08-05: 7992757384 (x86_64/Linux) + # 2014-08-05: 7992757384 (x86_64/Linux - bugfix for #314, Haddock now parses more URLs) ,(platform('i386-unknown-mingw32'), 3548581572, 5) # 2013-02-10: 3358693084 (x86/Windows) # 2013-11-13: 3097751052 (x86/Windows, 64bit machine) # 2014-04-04: 3548581572 (x86/Windows, 64bit machine) + # 2014-08-05: XXX TODO UPDATE ME XXX ,(wordsize(32), 3799130400, 1)]) # 2012-08-14: 3046487920 (x86/OSX) # 2012-10-30: 2955470952 (x86/Windows) # 2013-02-10: 3146596848 (x86/OSX) # 2014-02-22: 3554624600 (x86/Linux - new haddock) # 2014-06-29: 3799130400 (x86/Linux) + # 2014-08-05: XXX TODO UPDATE ME XXX ], stats, ['../../../../libraries/base/dist-install/doc/html/base/base.haddock.t']) @@ -114,18 +114,18 @@ test('haddock.Cabal', # 2013-12-12: 3828567272 (amd64/Linux) # 2014-01-12: 3979151552 (amd64/Linux) new parser # 2014-06-29: 4200993768 (amd64/Linux) - # XXX This one is TEMPORARY, it's due to an unoptimized error-path - # that Haddock is tickling, I am profiling and fixing this. - # 2014-08-05: 4493770224 (x86_64/Linux) + # 2014-08-05: 4493770224 (x86_64/Linux - bugfix for #314, Haddock now parses more URLs) ,(platform('i386-unknown-mingw32'), 2052220292, 5) # 2012-10-30: 1733638168 (x86/Windows) # 2013-02-10: 1906532680 (x86/Windows) # 2014-01-28: 1966911336 (x86/Windows) # 2014-04-24: 2052220292 (x86/Windows) + # 2014-08-05: XXX TODO UPDATE ME XXX ,(wordsize(32), 2127198484, 1)]) # 2012-08-14: 1648610180 (x86/OSX) # 2014-01-22: 1986290624 (x86/Linux) # 2014-06-29: 2127198484 (x86/Linux) + # 2014-08-05: XXX TODO UPDATE ME XXX ], stats, ['../../../../libraries/Cabal/Cabal/dist-install/doc/html/Cabal/Cabal.haddock.t']) From git at git.haskell.org Thu Aug 7 13:24:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 13:24:10 +0000 (UTC) Subject: [commit: ghc] master: [no-ci] Track Haddock submodule change: ignore TAGS. (c51498b) Message-ID: <20140807132411.6F0F5240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c51498baf3c75c7364ca063a6d33b0587bd4b2ab/ghc >--------------------------------------------------------------- commit c51498baf3c75c7364ca063a6d33b0587bd4b2ab Author: Edward Z. Yang Date: Thu Aug 7 14:23:57 2014 +0100 [no-ci] Track Haddock submodule change: ignore TAGS. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- c51498baf3c75c7364ca063a6d33b0587bd4b2ab utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 97b5fa2..d9b224f 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 97b5fa2b7b9c8bd07d0be5068b2f031b58e8fc56 +Subproject commit d9b224f124edc99f051dfc0dcab922041654c36a From git at git.haskell.org Thu Aug 7 15:52:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 15:52:17 +0000 (UTC) Subject: [commit: ghc] master: ghci: tweak option list indentation in ':show packages' (af1fc53) Message-ID: <20140807155217.72E6B240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/af1fc53a157c179854fd0e03e0a8e17c2295e547/ghc >--------------------------------------------------------------- commit af1fc53a157c179854fd0e03e0a8e17c2295e547 Author: Sergei Trofimovich Date: Thu Aug 7 18:48:03 2014 +0300 ghci: tweak option list indentation in ':show packages' Summary: Caught by './validate --slow' in 'ghci/scripts/ghci024'. Commit 207875293fea07aa90efe215369629b657d1875a changed indentation a bit: --- ./ghci/scripts/ghci024.stdout 2014-07-31 12:05:34.000000000 +0300 +++ ./ghci/scripts/ghci024.run.stdout 2014-08-07 17:19:23.000000000 +0300 @@ -33,4 +33,4 @@ active package flags: none ~~~~~~~~~~ Testing :show packages, including the ghc package active package flags: - -package ghc +-package ghc Patch restores indentation. Signed-off-by: Sergei Trofimovich Test Plan: passed validate, tested manually Reviewers: austin, ezyang Reviewed By: ezyang Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D126 >--------------------------------------------------------------- af1fc53a157c179854fd0e03e0a8e17c2295e547 ghc/InteractiveUI.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 386d4df..3d871d9 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -2331,9 +2331,9 @@ showPackages :: GHCi () showPackages = do dflags <- getDynFlags let pkg_flags = packageFlags dflags - liftIO $ putStrLn $ showSDoc dflags $ vcat $ - text ("active package flags:"++if null pkg_flags then " none" else "") - : map pprFlag pkg_flags + liftIO $ putStrLn $ showSDoc dflags $ + text ("active package flags:"++if null pkg_flags then " none" else "") $$ + nest 2 (vcat (map pprFlag pkg_flags)) showPaths :: GHCi () showPaths = do From git at git.haskell.org Thu Aug 7 18:07:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:07:33 +0000 (UTC) Subject: [commit: ghc] branch 'wip/rae' created Message-ID: <20140807180733.9E6E0240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/rae Referencing: f149b9cb1bd828ba5325e89fba47c285ecb39846 From git at git.haskell.org Thu Aug 7 18:07:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:07:36 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #9371 (indexed-types/should_fail/T9371) (64cd1be) Message-ID: <20140807180736.911E9240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/64cd1bef7b1d7ffe9825c0635bdc00c2ba3f09ce/ghc >--------------------------------------------------------------- commit 64cd1bef7b1d7ffe9825c0635bdc00c2ba3f09ce Author: Richard Eisenberg Date: Sun Aug 3 17:54:54 2014 -0400 Test #9371 (indexed-types/should_fail/T9371) >--------------------------------------------------------------- 64cd1bef7b1d7ffe9825c0635bdc00c2ba3f09ce testsuite/tests/indexed-types/should_fail/T9371.hs | 25 ++++++++++++++++++++++ .../tests/indexed-types/should_fail/T9371.stderr | 5 +++++ testsuite/tests/indexed-types/should_fail/all.T | 1 + 3 files changed, 31 insertions(+) diff --git a/testsuite/tests/indexed-types/should_fail/T9371.hs b/testsuite/tests/indexed-types/should_fail/T9371.hs new file mode 100644 index 0000000..cfec4c0 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9371.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} + +module T9371 where + +import Data.Monoid + +class C x where + data D x :: * + makeD :: D x + +instance {-# OVERLAPPABLE #-} Monoid x => C x where + data D x = D1 (Either x ()) + makeD = D1 (Left mempty) + +instance (Monoid x, Monoid y) => C (x, y) where + data D (x,y) = D2 (x,y) + makeD = D2 (mempty, mempty) + +instance Show x => Show (D x) where + show (D1 x) = show x + + +main = print (makeD :: D (String, String)) diff --git a/testsuite/tests/indexed-types/should_fail/T9371.stderr b/testsuite/tests/indexed-types/should_fail/T9371.stderr new file mode 100644 index 0000000..695a7b4 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9371.stderr @@ -0,0 +1,5 @@ + +T9371.hs:14:10: + Conflicting family instance declarations: + D -- Defined at T9371.hs:14:10 + D (x, y) -- Defined at T9371.hs:18:10 diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 0851c08..6d284cf 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -125,3 +125,4 @@ test('T9171', normal, compile_fail, ['']) test('T9097', normal, compile_fail, ['']) test('T9160', normal, compile_fail, ['']) test('T9357', normal, compile_fail, ['']) +test('T9371', normal, compile_fail, ['']) From git at git.haskell.org Thu Aug 7 18:07:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:07:38 +0000 (UTC) Subject: [commit: ghc] wip/rae: Comments only: explain that TauTv sometimes gets sigma-types. (fdfb86c) Message-ID: <20140807180741.2196A240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/fdfb86c42cdb9f14f69a03e102c3fff30c07a9d0/ghc >--------------------------------------------------------------- commit fdfb86c42cdb9f14f69a03e102c3fff30c07a9d0 Author: Richard Eisenberg Date: Sun Aug 3 18:51:37 2014 -0400 Comments only: explain that TauTv sometimes gets sigma-types. >--------------------------------------------------------------- fdfb86c42cdb9f14f69a03e102c3fff30c07a9d0 compiler/typecheck/TcType.lhs | 24 ++++++++++++++++++++++-- compiler/typecheck/TcUnify.lhs | 1 + 2 files changed, 23 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index f12ec9d..c779fbb 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -264,6 +264,25 @@ Similarly consider When doing kind inference on {S,T} we don't want *skolems* for k1,k2, because they end up unifying; we want those SigTvs again. +Note [TauTv sometimes gets sigma-types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Despite the name TauTv, a TauTv metavariable can be *unified* with a +sigma-type -- it's just that the solver will never make this choice. +This is because sigma-types sometimes have implicit parameters (type +parameters & dictionaries). We need to know up front where these +implicit parameters occur, so that we can instantiate for them. If, +say, unification didn't expose that a meta-variable was really a forall, +and the solver did discover this, we'd be in trouble, because the forall-type's +implicit parameters wouldn't be instantiated. Indeed, this is the whole +point of having TauTvs at all. + +But, it's OK if the unifier discovers that a TauTv should be a sigma-type. +That's because the unifier is run while we're walking through the expression, +so when it's time to instantiate, we can zonk away any known meta-variables, +expose the sigma-type, and instantiate away. + +This is all implemented in checkTauTvUpdate in TcUnify. + \begin{code} -- A TyVarDetails is inside a TyVar data TcTyVarDetails @@ -303,8 +322,9 @@ instance Outputable MetaDetails where data MetaInfo = TauTv -- This MetaTv is an ordinary unification variable - -- A TauTv is always filled in with a tau-type, which - -- never contains any ForAlls + -- A TauTv is usually filled with a tau-type, which + -- cannot have any foralls. But not always; see + -- Note [TauTv sometimes gets sigma-types] | PolyTv -- Like TauTv, but can unify with a sigma-type diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index ef06ddd..6552ebe 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -899,6 +899,7 @@ checkTauTvUpdate dflags tv ty -- Checks for (a) occurrence of tv -- (b) type family applications -- See Note [Conservative unification check] + -- and Note [TauTv sometimes gets sigma-types] in TcType defer_me (LitTy {}) = False defer_me (TyVarTy tv') = tv == tv' defer_me (TyConApp tc tys) = isSynFamilyTyCon tc || any defer_me tys From git at git.haskell.org Thu Aug 7 18:07:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:07:41 +0000 (UTC) Subject: [commit: ghc] wip/rae: Remove tcInfExpr (#9404) (55fae5a) Message-ID: <20140807180741.666A7240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/55fae5a69d279c1d4210ee39108093a1f31f60bf/ghc >--------------------------------------------------------------- commit 55fae5a69d279c1d4210ee39108093a1f31f60bf Author: Richard Eisenberg Date: Sun Aug 3 21:29:51 2014 -0400 Remove tcInfExpr (#9404) It seems that tcInfExpr (a special case for inferring a type without a known result type) is unnecessary. This removes it in favor of using the main tcExpr exclusively. >--------------------------------------------------------------- 55fae5a69d279c1d4210ee39108093a1f31f60bf compiler/typecheck/TcExpr.lhs | 26 +------------------------- 1 file changed, 1 insertion(+), 25 deletions(-) diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index 7e6c495..b23e622 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -125,16 +125,9 @@ tcInferRho expr = addErrCtxt (exprCtxt expr) (tcInferRhoNC expr) tcInferRhoNC (L loc expr) = setSrcSpan loc $ - do { (expr', rho) <- tcInfExpr expr + do { (expr', rho) <- tcInfer (tcExpr expr) ; return (L loc expr', rho) } -tcInfExpr :: HsExpr Name -> TcM (HsExpr TcId, TcRhoType) -tcInfExpr (HsVar f) = tcInferId f -tcInfExpr (HsPar e) = do { (e', ty) <- tcInferRhoNC e - ; return (HsPar e', ty) } -tcInfExpr (HsApp e1 e2) = tcInferApp e1 [e2] -tcInfExpr e = tcInfer (tcExpr e) - tcHole :: OccName -> TcRhoType -> TcM (HsExpr TcId) tcHole occ res_ty = do { ty <- newFlexiTyVarTy liftedTypeKind @@ -937,23 +930,6 @@ mk_app_msg fun = sep [ ptext (sLit "The function") <+> quotes (ppr fun) , ptext (sLit "is applied to")] ---------------- -tcInferApp :: LHsExpr Name -> [LHsExpr Name] -- Function and args - -> TcM (HsExpr TcId, TcRhoType) -- Translated fun and args - -tcInferApp (L _ (HsPar e)) args = tcInferApp e args -tcInferApp (L _ (HsApp e1 e2)) args = tcInferApp e1 (e2:args) -tcInferApp fun args - = -- Very like the tcApp version, except that there is - -- no expected result type passed in - do { (fun1, fun_tau) <- tcInferFun fun - ; (co_fun, expected_arg_tys, actual_res_ty) - <- matchExpectedFunTys (mk_app_msg fun) (length args) fun_tau - ; args1 <- tcArgs fun args expected_arg_tys - ; let fun2 = mkLHsWrapCo co_fun fun1 - app = foldl mkHsApp fun2 args1 - ; return (unLoc app, actual_res_ty) } - ----------------- tcInferFun :: LHsExpr Name -> TcM (LHsExpr TcId, TcRhoType) -- Infer and instantiate the type of a function tcInferFun (L loc (HsVar name)) From git at git.haskell.org Thu Aug 7 18:07:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:07:43 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix Trac #9371. (7b3535f) Message-ID: <20140807180743.ED454240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/7b3535f7b9d1e2db730032691bc74ae3be237e4a/ghc >--------------------------------------------------------------- commit 7b3535f7b9d1e2db730032691bc74ae3be237e4a Author: Richard Eisenberg Date: Sun Aug 3 18:40:30 2014 -0400 Fix Trac #9371. This was very simple: lists of different lengths are *maybe* apart, not *surely* apart. >--------------------------------------------------------------- 7b3535f7b9d1e2db730032691bc74ae3be237e4a compiler/types/Unify.lhs | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs index f44e260..1eb1c2b 100644 --- a/compiler/types/Unify.lhs +++ b/compiler/types/Unify.lhs @@ -418,6 +418,26 @@ substituted, we can't properly unify the types. But, that skolem variable may later be instantiated with a unifyable type. So, we return maybeApart in these cases. +Note [Lists of different lengths are MaybeApart] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It is unusual to call tcUnifyTys or tcUnifyTysFG with lists of different +lengths. The place where we know this can happen is from compatibleBranches in +FamInstEnv, when checking data family instances. Data family instances may be +eta-reduced; see Note [Eta reduction for data family axioms] in TcInstDcls. + +We wish to say that + + D :: * -> * -> * + axDF1 :: D Int ~ DFInst1 + axDF2 :: D Int Bool ~ DFInst2 + +overlap. If we conclude that lists of different lengths are SurelyApart, then +it will look like these do *not* overlap, causing disaster. See Trac #9371. + +In usages of tcUnifyTys outside of family instances, we always use tcUnifyTys, +which can't tell the difference between MaybeApart and SurelyApart, so those +usages won't notice this design choice. + \begin{code} tcUnifyTy :: Type -> Type -- All tyvars are bindable -> Maybe TvSubst -- A regular one-shot (idempotent) substitution @@ -593,7 +613,7 @@ unifyList subst orig_xs orig_ys go subst [] [] = return subst go subst (x:xs) (y:ys) = do { subst' <- unify subst x y ; go subst' xs ys } - go _ _ _ = surelyApart + go subst _ _ = maybeApart subst -- See Note [Lists of different lengths are MaybeApart] --------------------------------- uVar :: TvSubstEnv -- An existing substitution to extend From git at git.haskell.org Thu Aug 7 18:07:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:07:46 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #9200. (polykinds/T9200) (5d682d6) Message-ID: <20140807180746.996F3240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/5d682d6a294ce51bfdb8b4f2ceef1285c6a68129/ghc >--------------------------------------------------------------- commit 5d682d6a294ce51bfdb8b4f2ceef1285c6a68129 Author: Richard Eisenberg Date: Sun Aug 3 21:37:45 2014 -0400 Test #9200. (polykinds/T9200) >--------------------------------------------------------------- 5d682d6a294ce51bfdb8b4f2ceef1285c6a68129 testsuite/tests/polykinds/T9200.hs | 19 +++++++++++++++++++ testsuite/tests/polykinds/all.T | 1 + 2 files changed, 20 insertions(+) diff --git a/testsuite/tests/polykinds/T9200.hs b/testsuite/tests/polykinds/T9200.hs new file mode 100644 index 0000000..b74177a --- /dev/null +++ b/testsuite/tests/polykinds/T9200.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds #-} + +module T9200 where + +------ +-- test CUSK on classes + +class C (f :: k) (a :: k2) where + c_meth :: D a => () + +class C () a => D a + + +--------- +--- test CUSK on type synonyms +data T1 a b c = MkT1 (S True b c) +data T2 p q r = MkT2 (S p 5 r) +data T3 x y q = MkT3 (S x y '()) +type S (f :: k1) (g :: k2) (h :: k3) = ((T1 f g h, T2 f g h, T3 f g h) :: *) diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 22a159d..abb158b 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -106,3 +106,4 @@ test('T9222', normal, compile, ['']) test('T9264', normal, compile, ['']) test('T9263', normal, run_command, ['$MAKE -s --no-print-directory T9263']) test('T9063', normal, compile, ['']) +test('T9200', normal, compile, ['']) From git at git.haskell.org Thu Aug 7 18:07:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:07:50 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #9404 (typecheck/should_compile/T9404) (80368d4) Message-ID: <20140807180750.41F0F240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/80368d4a14aff66b3e6bae6053adf9e30218bde5/ghc >--------------------------------------------------------------- commit 80368d4a14aff66b3e6bae6053adf9e30218bde5 Author: Richard Eisenberg Date: Thu Aug 7 09:20:41 2014 -0400 Test #9404 (typecheck/should_compile/T9404) >--------------------------------------------------------------- 80368d4a14aff66b3e6bae6053adf9e30218bde5 testsuite/tests/typecheck/should_compile/T9404.hs | 6 ++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 7 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T9404.hs b/testsuite/tests/typecheck/should_compile/T9404.hs new file mode 100644 index 0000000..4cb530a --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T9404.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE UnboxedTuples #-} + +module T9404 where + +foo _ = case seq () (# #) of (# #) -> () +foo2 _ = case () `seq` (# #) of (# #) -> () diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 07d05b8..2ca9c2f 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -420,3 +420,4 @@ test('MutRec', normal, compile, ['']) test('T8856', normal, compile, ['']) test('T9117', normal, compile, ['']) test('T9117_2', expect_broken('9117'), compile, ['']) +test('T9404', normal, compile, ['']) From git at git.haskell.org Thu Aug 7 18:07:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:07:53 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #9415 (typecheck/should_fail/T9415) (2e51b04) Message-ID: <20140807180753.EEC7E240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/2e51b04d431f7d51148bea741147e898f343adaf/ghc >--------------------------------------------------------------- commit 2e51b04d431f7d51148bea741147e898f343adaf Author: Richard Eisenberg Date: Wed Aug 6 09:54:37 2014 -0400 Test #9415 (typecheck/should_fail/T9415) >--------------------------------------------------------------- 2e51b04d431f7d51148bea741147e898f343adaf testsuite/tests/typecheck/should_fail/T9415.hs | 5 +++++ testsuite/tests/typecheck/should_fail/T9415.stderr | 8 ++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 3 files changed, 14 insertions(+) diff --git a/testsuite/tests/typecheck/should_fail/T9415.hs b/testsuite/tests/typecheck/should_fail/T9415.hs new file mode 100644 index 0000000..db77ff0 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9415.hs @@ -0,0 +1,5 @@ +module T9415 where + +class D a => C a where + meth :: D a => () +class C a => D a diff --git a/testsuite/tests/typecheck/should_fail/T9415.stderr b/testsuite/tests/typecheck/should_fail/T9415.stderr new file mode 100644 index 0000000..516759e --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9415.stderr @@ -0,0 +1,8 @@ + +T9415.hs:3:1: + Cycle in class declaration (via superclasses): C -> D -> C + In the class declaration for ?C? + +T9415.hs:5:1: + Cycle in class declaration (via superclasses): D -> C -> D + In the class declaration for ?D? diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index cf2af30..85f5052 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -336,3 +336,4 @@ test('T8883', normal, compile_fail, ['']) test('T9196', normal, compile_fail, ['']) test('T9305', normal, compile_fail, ['']) test('T9323', normal, compile_fail, ['']) +test('T9415', normal, compile_fail, ['']) From git at git.haskell.org Thu Aug 7 18:07:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:07:57 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #9415. (3ba140a) Message-ID: <20140807180757.521AA240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/3ba140aa6f68481e35258724869320f0f95f5c52/ghc >--------------------------------------------------------------- commit 3ba140aa6f68481e35258724869320f0f95f5c52 Author: Richard Eisenberg Date: Wed Aug 6 09:51:26 2014 -0400 Fix #9415. Don't do an ambiguity check when there are already errors, as a superclass cycle causes the ambiguity check to loop! >--------------------------------------------------------------- 3ba140aa6f68481e35258724869320f0f95f5c52 compiler/typecheck/TcValidity.lhs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs index f835782..c4e0cdd 100644 --- a/compiler/typecheck/TcValidity.lhs +++ b/compiler/typecheck/TcValidity.lhs @@ -59,6 +59,17 @@ import Data.List ( (\\) ) %* * %************************************************************************ +Note [No ambiguity check with errors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must avoid doing the ambiguity check when there are already errors accumulated. +This is because one of the errors may be a superclass cycle, and superclass cycles +cause canonicalization to loop. Here is a representative example: + + class D a => C a where + meth :: D a => () + class C a => D a + +This fixes Trac #9415. \begin{code} checkAmbiguity :: UserTypeCtxt -> Type -> TcM () @@ -72,7 +83,8 @@ checkAmbiguity ctxt ty = return () | otherwise - = do { traceTc "Ambiguity check for" (ppr ty) + = ifErrsM (return ()) $ -- See Note [No ambiguity check with errors] + do { traceTc "Ambiguity check for" (ppr ty) ; let free_tkvs = varSetElemsKvsFirst (closeOverKinds (tyVarsOfType ty)) ; (subst, _tvs) <- tcInstSkolTyVars free_tkvs ; let ty' = substTy subst ty From git at git.haskell.org Thu Aug 7 18:08:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:08:00 +0000 (UTC) Subject: [commit: ghc] wip/rae: Clean up comments around kind checking strategies. (a7bb93d) Message-ID: <20140807180800.2950C240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/a7bb93d00f8d3b6d07a361805d5d7596da459bbc/ghc >--------------------------------------------------------------- commit a7bb93d00f8d3b6d07a361805d5d7596da459bbc Author: Richard Eisenberg Date: Thu Aug 7 08:40:21 2014 -0400 Clean up comments around kind checking strategies. This is all *much* simpler than it was before! (#9200) >--------------------------------------------------------------- a7bb93d00f8d3b6d07a361805d5d7596da459bbc compiler/typecheck/TcHsType.lhs | 154 ++-------------------------------------- 1 file changed, 5 insertions(+), 149 deletions(-) diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index fef1603..a8df9e5 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -905,155 +905,11 @@ addTypeCtxt (L _ ty) thing Note [Kind-checking strategies] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -There are three main declarations that we have to kind check carefully in the -presence of -XPolyKinds: classes, datatypes, and data/type families. They each -have a different kind-checking strategy (labeled in the parentheses above each -section). This should potentially be cleaned up in the future, but this is how -it stands now (June 2013). - -Classes (ParametricKinds): - - kind-polymorphic by default - - each un-annotated type variable is given a fresh meta kind variable - - every explicit kind variable becomes a SigTv during inference - - no generalisation is done while kind-checking the recursive group - - Taken together, this means that classes cannot participate in polymorphic - recursion. Thus, the following is not definable: - - class Fugly (a :: k) where - foo :: forall (b :: k -> *). Fugly b => b a - - But, because explicit kind variables are SigTvs, it is OK for the kind to - be forced to be the same kind that is used in a separate declaration. See - test case polykinds/T7020.hs. - -Datatypes: - Here we have two cases, whether or not a Full Kind Signature is provided. - A Full Kind Signature means that there is a top-level :: in the definition - of the datatype. For example: - - data T1 :: k -> Bool -> * where ... -- YES - data T2 (a :: k) :: Bool -> * where ... -- YES - data T3 (a :: k) (b :: Bool) :: * where ... -- YES - data T4 (a :: k) (b :: Bool) where ... -- NO - - Kind signatures are not allowed on datatypes declared in the H98 style, - so those always have no Full Kind Signature. - - Full Kind Signature (FullKindSignature): - - each un-annotated type variable defaults to * - - every explicit kind variable becomes a skolem during type inference - - these kind variables are generalised *before* kind-checking the group - - With these rules, polymorphic recursion is possible. This is essentially - because of the generalisation step before kind-checking the group -- it - gives the kind-checker enough flexibility to supply the right kind arguments - to support polymorphic recursion. - - no Full Kind Signature (ParametricKinds): - - kind-polymorphic by default - - each un-annotated type variable is given a fresh meta kind variable - - every explicit kind variable becomes a SigTv during inference - - no generalisation is done while kind-checking the recursive group - - Thus, no polymorphic recursion in this case. See also Trac #6093 & #6049. - -Type families: - Here we have three cases: open top-level families, closed top-level families, - and open associated types. (There are no closed associated types, for good - reason.) - - Open top-level families (FullKindSignature): - - All open top-level families are considered to have a Full Kind Signature - - All arguments and the result default to * - - All kind variables are skolems - - All kind variables are generalised before kind-checking the group - - This behaviour supports kind-indexed type and data families, because we - need to have generalised before kind-checking for this to work. For example: - - type family F (a :: k) - type instance F Int = Bool - type instance F Maybe = Char - type instance F (x :: * -> * -> *) = Double - - Closed top-level families (NonParametricKinds): - - kind-monomorphic by default - - each un-annotated type variable is given a fresh meta kind variable - - every explicit kind variable becomes a skolem during inference - - all such skolems are generalised before kind-checking; other kind - variables are not generalised - - all unconstrained meta kind variables are defaulted to * at the - end of kind checking - - This behaviour is to allow kind inference to occur in closed families, but - without becoming too polymorphic. For example: - - type family F a where - F Int = Bool - F Bool = Char - - We would want F to have kind * -> * from this definition, although something - like k1 -> k2 would be perfectly sound. The reason we want this restriction is - that it is better to have (F Maybe) be a kind error than simply stuck. - - The kind inference gives us also - - type family Not b where - Not False = True - Not True = False - - With an open family, the above would need kind annotations in its header. - - The tricky case is - - type family G a (b :: k) where - G Int Int = False - G Bool Maybe = True - - We want this to work. But, we also want (G Maybe Maybe) to be a kind error - (in the first argument). So, we need to generalise the skolem "k" but not - the meta kind variable associated with "a". - - Associated families (FullKindSignature): - - Kind-monomorphic by default - - Result kind defaults to * - - Each type variable is either in the class header or not: - - Type variables in the class header are given the kind inherited from - the class header (and checked against an annotation, if any) - - Un-annotated type variables default to * - - Each kind variable mentioned in the class header becomes a SigTv during - kind inference. - - Each kind variable not mentioned in the class header becomes a skolem during - kind inference. - - Only the skolem kind variables are generalised before kind checking. - - Here are some examples: - - class Foo1 a b where - type Bar1 (a :: k) (b :: k) - - The kind of Foo1 will be k -> k -> Constraint. Kind annotations on associated - type declarations propagate to the header because the type variables in Bar1's - declaration inherit the (meta) kinds of the class header. - - class Foo2 a where - type Bar2 a - - The kind of Bar2 will be k -> *. - - class Foo3 a where - type Bar3 a (b :: k) - meth :: Bar3 a Maybe -> () - - The kind of Bar3 will be k1 -> k2 -> *. This only kind-checks because the kind - of b is generalised before kind-checking. - - class Foo4 a where - type Bar4 a b - - Here, the kind of Bar4 will be k -> * -> *, because b is not mentioned in the - class header, so it defaults to *. +We kind-check declarations differently if they have a complete, user-supplied +kind signature (CUSK). This is because we can safely generalise a CUSKed +declaration before checking all of the others, supporting polymorphic recursion. +See https://ghc.haskell.org/trac/ghc/wiki/GhcKinds/KindInference#Proposednewstrategy +and #9200 for lots of discussion of how we got here. \begin{code} data KindCheckingStrategy -- See Note [Kind-checking strategies] From git at git.haskell.org Thu Aug 7 18:08:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:08:03 +0000 (UTC) Subject: [commit: ghc] wip/rae: Added more testing for #9200. (polykinds/T9200b) (f2989a8) Message-ID: <20140807180803.D6389240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/f2989a8ef77bd1aedd7f085605a86cd8fed10d76/ghc >--------------------------------------------------------------- commit f2989a8ef77bd1aedd7f085605a86cd8fed10d76 Author: Richard Eisenberg Date: Thu Aug 7 08:19:22 2014 -0400 Added more testing for #9200. (polykinds/T9200b) >--------------------------------------------------------------- f2989a8ef77bd1aedd7f085605a86cd8fed10d76 testsuite/tests/polykinds/T9200b.hs | 10 ++++++++++ testsuite/tests/polykinds/T9200b.stderr | 6 ++++++ testsuite/tests/polykinds/all.T | 1 + 3 files changed, 17 insertions(+) diff --git a/testsuite/tests/polykinds/T9200b.hs b/testsuite/tests/polykinds/T9200b.hs new file mode 100644 index 0000000..f780aba --- /dev/null +++ b/testsuite/tests/polykinds/T9200b.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds #-} + +module T9200b where + +--------- +--- test CUSK on closed type families +type family F (a :: k) where + F True = False + F False = True + F x = x diff --git a/testsuite/tests/polykinds/T9200b.stderr b/testsuite/tests/polykinds/T9200b.stderr new file mode 100644 index 0000000..5e8c730 --- /dev/null +++ b/testsuite/tests/polykinds/T9200b.stderr @@ -0,0 +1,6 @@ + +T9200b.hs:8:5: + The first argument of ?F? should have kind ?k?, + but ?True? has kind ?Bool? + In the type ?True? + In the type family declaration for ?F? diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index abb158b..82c1824 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -107,3 +107,4 @@ test('T9264', normal, compile, ['']) test('T9263', normal, run_command, ['$MAKE -s --no-print-directory T9263']) test('T9063', normal, compile, ['']) test('T9200', normal, compile, ['']) +test('T9200b', normal, compile_fail, ['']) From git at git.haskell.org Thu Aug 7 18:08:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:08:06 +0000 (UTC) Subject: [commit: ghc] wip/rae: Remove NonParametricKinds (#9200) (095d54a) Message-ID: <20140807180806.AF73D240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/095d54adbfea4d2f6f874bc69107a336fda03e22/ghc >--------------------------------------------------------------- commit 095d54adbfea4d2f6f874bc69107a336fda03e22 Author: Richard Eisenberg Date: Thu Aug 7 08:37:05 2014 -0400 Remove NonParametricKinds (#9200) >--------------------------------------------------------------- 095d54adbfea4d2f6f874bc69107a336fda03e22 compiler/typecheck/TcHsType.lhs | 2 -- 1 file changed, 2 deletions(-) diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index d075cbc..fef1603 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -1058,7 +1058,6 @@ Type families: \begin{code} data KindCheckingStrategy -- See Note [Kind-checking strategies] = ParametricKinds - | NonParametricKinds | FullKindSignature deriving (Eq) @@ -1144,7 +1143,6 @@ kcHsTyVarBndrs strat (HsQTvs { hsq_kvs = kv_ns, hsq_tvs = hs_tvs }) thing_inside -- See Note [Kind-checking strategies] (skolem_kvs, default_to_star, generalise) = case strat of ParametricKinds -> (False, False, False) - NonParametricKinds -> (True, False, True) FullKindSignature -> (True, True, True) kc_hs_tv :: HsTyVarBndr Name -> TcM (Name, TcKind) From git at git.haskell.org Thu Aug 7 18:08:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:08:09 +0000 (UTC) Subject: [commit: ghc] wip/rae: Change definition of CUSK for data and class definitions (#9200). (378c314) Message-ID: <20140807180809.84AAB240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/378c3147b73fe9e8ef78d2d8fc0bcbb311186561/ghc >--------------------------------------------------------------- commit 378c3147b73fe9e8ef78d2d8fc0bcbb311186561 Author: Richard Eisenberg Date: Wed Aug 6 09:56:50 2014 -0400 Change definition of CUSK for data and class definitions (#9200). Now, a CUSK is when (and only when) all type variables are annotated. This allows classes to participate in polymorphic recursion. >--------------------------------------------------------------- 378c3147b73fe9e8ef78d2d8fc0bcbb311186561 compiler/hsSyn/HsTypes.lhs | 7 ++++++- compiler/typecheck/TcHsType.lhs | 19 ++++++++++++++----- 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index 08a0eef..eada762 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -25,7 +25,7 @@ module HsTypes ( ConDeclField(..), pprConDeclFields, - mkHsQTvs, hsQTvBndrs, + mkHsQTvs, hsQTvBndrs, isHsKindedTyVar, mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs, hsTyVarName, mkHsWithBndrs, hsLKiTyVarNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, @@ -188,6 +188,11 @@ data HsTyVarBndr name (LHsKind name) -- The user-supplied kind signature deriving (Data, Typeable) +-- | Does this 'HsTyVarBndr' come with an explicit kind annotation? +isHsKindedTyVar :: HsTyVarBndr name -> Bool +isHsKindedTyVar (UserTyVar {}) = False +isHsKindedTyVar (KindedTyVar {}) = True + data HsType name = HsForAllTy HsExplicitFlag -- Renamer leaves this flag unchanged, to record the way -- the user wrote it originally, so that the printer can diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index cdeb191..14a3c17 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -1068,10 +1068,15 @@ kcStrategy d@(ForeignType {}) = pprPanic "kcStrategy" (ppr d) kcStrategy (FamDecl fam_decl) = kcStrategyFamDecl fam_decl kcStrategy (SynDecl {}) = ParametricKinds -kcStrategy (DataDecl { tcdDataDefn = HsDataDefn { dd_kindSig = m_ksig }}) - | Just _ <- m_ksig = FullKindSignature - | otherwise = ParametricKinds -kcStrategy (ClassDecl {}) = ParametricKinds +kcStrategy decl@(DataDecl {}) = kcStrategyAlgDecl decl +kcStrategy decl@(ClassDecl {}) = kcStrategyAlgDecl decl + +kcStrategyAlgDecl :: TyClDecl Name -> KindCheckingStrategy +kcStrategyAlgDecl decl + | all (isHsKindedTyVar . unLoc) (hsQTvBndrs $ tcdTyVars decl) + = FullKindSignature + | otherwise + = ParametricKinds -- if the ClosedTypeFamily has no equations, do the defaulting to *, etc. kcStrategyFamDecl :: FamilyDecl Name -> KindCheckingStrategy @@ -1259,7 +1264,11 @@ kcTyClTyVars :: Name -> LHsTyVarBndrs Name -> TcM a -> TcM a kcTyClTyVars name (HsQTvs { hsq_kvs = kvs, hsq_tvs = hs_tvs }) thing_inside = kcScopedKindVars kvs $ do { tc_kind <- kcLookupKind name - ; let (arg_ks, _res_k) = splitKindFunTysN (length hs_tvs) tc_kind + ; let (_, mono_kind) = splitForAllTys tc_kind + -- if we have a FullKindSignature, the tc_kind may already + -- be generalized. The kvs get matched up while kind-checking + -- the types in kc_tv, below + (arg_ks, _res_k) = splitKindFunTysN (length hs_tvs) mono_kind -- There should be enough arrows, because -- getInitialKinds used the tcdTyVars ; name_ks <- zipWithM kc_tv hs_tvs arg_ks From git at git.haskell.org Thu Aug 7 18:08:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:08:11 +0000 (UTC) Subject: [commit: ghc] wip/rae: Change treatment of CUSKs for synonyms and families (#9200). (2263e46) Message-ID: <20140807180812.0C8C8240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/2263e46e7a7e22aae6734181802c24608229abdc/ghc >--------------------------------------------------------------- commit 2263e46e7a7e22aae6734181802c24608229abdc Author: Richard Eisenberg Date: Thu Aug 7 08:28:32 2014 -0400 Change treatment of CUSKs for synonyms and families (#9200). >--------------------------------------------------------------- 2263e46e7a7e22aae6734181802c24608229abdc compiler/typecheck/TcHsType.lhs | 27 +++++++++++++++++++++++---- testsuite/tests/polykinds/T9200.hs | 12 +++++++++++- 2 files changed, 34 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index 14a3c17..d075cbc 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -1067,22 +1067,41 @@ kcStrategy :: TyClDecl Name -> KindCheckingStrategy kcStrategy d@(ForeignType {}) = pprPanic "kcStrategy" (ppr d) kcStrategy (FamDecl fam_decl) = kcStrategyFamDecl fam_decl -kcStrategy (SynDecl {}) = ParametricKinds +kcStrategy (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) + | all_tyvars_annotated tyvars + , rhs_annotated rhs + = FullKindSignature + | otherwise + = ParametricKinds + where + rhs_annotated (L _ ty) = case ty of + HsParTy lty -> rhs_annotated lty + HsKindSig {} -> True + _ -> False kcStrategy decl@(DataDecl {}) = kcStrategyAlgDecl decl kcStrategy decl@(ClassDecl {}) = kcStrategyAlgDecl decl kcStrategyAlgDecl :: TyClDecl Name -> KindCheckingStrategy kcStrategyAlgDecl decl - | all (isHsKindedTyVar . unLoc) (hsQTvBndrs $ tcdTyVars decl) + | all_tyvars_annotated $ tcdTyVars decl = FullKindSignature | otherwise = ParametricKinds --- if the ClosedTypeFamily has no equations, do the defaulting to *, etc. kcStrategyFamDecl :: FamilyDecl Name -> KindCheckingStrategy -kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily (_:_) }) = NonParametricKinds +kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily _ + , fdTyVars = tyvars + , fdKindSig = Just _ }) + | all (isHsKindedTyVar . unLoc) (hsQTvBndrs tyvars) + = FullKindSignature +-- if the ClosedTypeFamily has no equations, do the defaulting to *, etc. +kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily (_:_) }) = ParametricKinds kcStrategyFamDecl _ = FullKindSignature +-- | Are all the type variables given with a kind annotation? +all_tyvars_annotated :: LHsTyVarBndrs name -> Bool +all_tyvars_annotated = all (isHsKindedTyVar . unLoc) . hsQTvBndrs + mkKindSigVar :: Name -> TcM KindVar -- Use the specified name; don't clone it mkKindSigVar n diff --git a/testsuite/tests/polykinds/T9200.hs b/testsuite/tests/polykinds/T9200.hs index b74177a..ca05066 100644 --- a/testsuite/tests/polykinds/T9200.hs +++ b/testsuite/tests/polykinds/T9200.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds #-} +{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds, + TypeFamilies #-} module T9200 where @@ -17,3 +18,12 @@ data T1 a b c = MkT1 (S True b c) data T2 p q r = MkT2 (S p 5 r) data T3 x y q = MkT3 (S x y '()) type S (f :: k1) (g :: k2) (h :: k3) = ((T1 f g h, T2 f g h, T3 f g h) :: *) + + +---------- +-- test CUSK on closed type families +type family F (a :: k) :: k where + F True = False + F False = True + F x = x + From git at git.haskell.org Thu Aug 7 18:08:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 18:08:14 +0000 (UTC) Subject: [commit: ghc] wip/rae: Update manual (#9200). (f149b9c) Message-ID: <20140807180814.743F8240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/f149b9cb1bd828ba5325e89fba47c285ecb39846/ghc >--------------------------------------------------------------- commit f149b9cb1bd828ba5325e89fba47c285ecb39846 Author: Richard Eisenberg Date: Thu Aug 7 08:53:11 2014 -0400 Update manual (#9200). >--------------------------------------------------------------- f149b9cb1bd828ba5325e89fba47c285ecb39846 docs/users_guide/glasgow_exts.xml | 105 ++++++++++++++++++++++---------------- 1 file changed, 62 insertions(+), 43 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 00f4315..80c0cd3 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -6529,11 +6529,11 @@ data T m a = MkT (m a) (T Maybe (m a)) The recursive use of T forced the second argument to have kind *. However, just as in type inference, you can achieve polymorphic recursion by giving a -complete kind signature for T. The way to give -a complete kind signature for a data type is to use a GADT-style declaration with an -explicit kind signature thus: +complete kind signature for T. A complete +kind signature is present when all argument kinds and the result kind are known, without +any need for inference. For example: -data T :: (k -> *) -> k -> * where +data T (m :: k -> *) :: k -> * where MkT :: m a -> T Maybe (m a) -> T m a The complete user-supplied kind signature specifies the polymorphic kind for T, @@ -6545,26 +6545,41 @@ In particular, the recursive use of T is at kind * - -A GADT-style data type declaration, with an explicit "::" in the header. -For example: +For a datatype, every type variable must be annotated with a kind. In a +GADT-style declaration, there may also be a kind signature (with a top-level +:: in the header), but the presence or absence of this annotation +does not affect whether or not the declaration has a complete signature. data T1 :: (k -> *) -> k -> * where ... -- Yes T1 :: forall k. (k->*) -> k -> * data T2 (a :: k -> *) :: k -> * where ... -- Yes T2 :: forall k. (k->*) -> k -> * data T3 (a :: k -> *) (b :: k) :: * where ... -- Yes T3 :: forall k. (k->*) -> k -> * -data T4 a (b :: k) :: * where ... -- YES T4 :: forall k. * -> k -> * +data T4 (a :: k -> *) (b :: k) where ... -- Yes T4 :: forall k. (k->*) -> k -> * -data T5 a b where ... -- NO kind is inferred -data T4 (a :: k -> *) (b :: k) where ... -- NO kind is inferred - -It makes no difference where you put the "::" but it must be there. -You cannot give a complete kind signature using a Haskell-98-style data type declaration; -you must use GADT syntax. +data T5 a (b :: k) :: * where ... -- NO kind is inferred +data T6 a b where ... -- NO kind is inferred + + + + +For a class, every type variable must be annotated with a kind. +For a type synonym, every type variable and the result type must all be annotated +with kinds. + +type S1 (a :: k) = (a :: k) -- Yes S1 :: forall k. k -> k +type S2 (a :: k) = a -- No kind is inferred +type S3 (a :: k) = Proxy a -- No kind is inferred + +Note that in S2 and S3, the kind of the +right-hand side is rather apparent, but it is still not considered to have a complete +signature -- no inference can be done before detecting the signature. + + An open type or data family declaration always has a -complete user-specified kind signature; no "::" is required: +complete user-specified kind signature; un-annotated type variables default to +kind *. data family D1 a -- D1 :: * -> * data family D2 (a :: k) -- D2 :: forall k. k -> * @@ -6579,10 +6594,12 @@ variable annotation from the class declaration. It keeps its polymorphic kind in the associated type declaration. The variable b, however, gets defaulted to *. + + +A closed type familey has a complete signature when all of its type variables +are annotated and a return kind (with a top-level ::) is supplied. + -In a complete user-specified kind signature, any un-decorated type variable to the -left of the "::" is considered to have kind "*". -If you want kind polymorphism, specify a kind variable. @@ -6592,31 +6609,33 @@ If you want kind polymorphism, specify a kind variable. Although all open type families are considered to have a complete user-specified kind signature, we can relax this condition for closed type families, where we have equations on which to perform kind inference. GHC will -infer a kind for any type variable in a closed type family when that kind is -never used in pattern-matching. If you want a kind variable to be used in -pattern-matching, you must declare it explicitly. - - - -Here are some examples (assuming -XDataKinds is enabled): - -type family Not a where -- Not :: Bool -> Bool - Not False = True - Not True = False - -type family F a where -- ERROR: requires pattern-matching on a kind variable - F Int = Bool - F Maybe = Char - -type family G (a :: k) where -- G :: k -> * - G Int = Bool - G Maybe = Char - -type family SafeHead where -- SafeHead :: [k] -> Maybe k - SafeHead '[] = Nothing -- note that k is not required for pattern-matching - SafeHead (h ': t) = Just h - - +infer kinds for the arguments and result types of a closed type family. + +GHC supports kind-indexed type families, where the +family matches both on the kind and type. GHC will not infer +this behaviour without a complete user-supplied kind signature, as doing so would +sometimes infer non-principal types. + +For example: + +type family F1 a where + F1 True = False + F1 False = True + F1 x = x +-- F1 fails to compile: kind-indexing is not inferred + +type family F2 (a :: k) where + F2 True = False + F2 False = True + F2 x = x +-- F2 fails to compile: no complete signature + +type family F3 (a :: k) :: k where + F3 True = False + F3 False = True + F3 x = x +-- OK + From git at git.haskell.org Thu Aug 7 20:01:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 20:01:10 +0000 (UTC) Subject: [commit: ghc] master: testsuite: add signal_exit_code function to the driver (2cca0c0) Message-ID: <20140807200110.96053240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2cca0c065c2ef41f9e82409e85bc80f27ce2ba02/ghc >--------------------------------------------------------------- commit 2cca0c065c2ef41f9e82409e85bc80f27ce2ba02 Author: Karel Gardas Date: Thu Aug 7 22:00:25 2014 +0200 testsuite: add signal_exit_code function to the driver Summary: New function signal_exit_code hides differences between target platforms handling of fatal error signals and the applications' exit codes. E.g. on Linux the application exit code which receives fatal error signal is encoded as 128 + signal value. On the other hand on Solaris the application exit code is signal value alone. Test Plan: validated on Linux and tested on Solaris Reviewers: austin, simonmar Reviewed By: simonmar Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D122 >--------------------------------------------------------------- 2cca0c065c2ef41f9e82409e85bc80f27ce2ba02 testsuite/driver/testlib.py | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 126c8e4..9a6951b 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -232,6 +232,17 @@ def exit_code( val ): def _exit_code( name, opts, v ): opts.exit_code = v +def signal_exit_code( val ): + if opsys('solaris2'): + return exit_code( val ); + else: + # When application running on Linux receives fatal error + # signal, then its exit code is encoded as 128 + signal + # value. See http://www.tldp.org/LDP/abs/html/exitcodes.html + # I assume that Mac OS X behaves in the same way at least Mac + # OS X builder behavior suggests this. + return exit_code( val+128 ); + # ----- def timeout_multiplier( val ): From git at git.haskell.org Thu Aug 7 20:34:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 20:34:09 +0000 (UTC) Subject: [commit: ghc] branch 'wip/new-flatten-skolems-Aug14' created Message-ID: <20140807203409.33A7B240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/new-flatten-skolems-Aug14 Referencing: 8e893b1e07b02574cf478ec00fe279d1655d6c28 From git at git.haskell.org Thu Aug 7 20:34:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 20:34:12 +0000 (UTC) Subject: [commit: ghc] wip/new-flatten-skolems-Aug14: Simon PJ work in progress on re-architecting flatten-skolems (8e893b1) Message-ID: <20140807203413.0395E240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/new-flatten-skolems-Aug14 Link : http://ghc.haskell.org/trac/ghc/changeset/8e893b1e07b02574cf478ec00fe279d1655d6c28/ghc >--------------------------------------------------------------- commit 8e893b1e07b02574cf478ec00fe279d1655d6c28 Author: Simon Peyton Jones Date: Thu Aug 7 21:33:35 2014 +0100 Simon PJ work in progress on re-architecting flatten-skolems The goal is to fix the wanted/wanted interaction in Trac #9318. I'm not sure that this is anything like right yet, so don't take it too seriously. Just wanting to put it in Git. >--------------------------------------------------------------- 8e893b1e07b02574cf478ec00fe279d1655d6c28 compiler/typecheck/Inst.lhs | 19 +- compiler/typecheck/TcCanonical.lhs | 191 +++++++++--------- compiler/typecheck/TcErrors.lhs | 1 - compiler/typecheck/TcHsSyn.lhs | 1 - compiler/typecheck/TcInteract.lhs | 222 +++++++++------------ compiler/typecheck/TcMType.lhs | 15 +- compiler/typecheck/TcRnMonad.lhs | 3 +- compiler/typecheck/TcRnTypes.lhs | 62 +++--- compiler/typecheck/TcRules.lhs | 2 - compiler/typecheck/TcSMonad.lhs | 219 ++++++++------------ compiler/typecheck/TcSimplify.lhs | 22 +- compiler/typecheck/TcType.lhs | 30 ++- compiler/typecheck/TcUnify.lhs | 1 - .../tests/indexed-types/should_compile/Simple13.hs | 30 +++ .../tests/indexed-types/should_compile/Simple8.hs | 2 +- .../tests/indexed-types/should_compile/T3826.hs | 54 ++++- 16 files changed, 420 insertions(+), 454 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8e893b1e07b02574cf478ec00fe279d1655d6c28 From git at git.haskell.org Thu Aug 7 21:28:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Aug 2014 21:28:16 +0000 (UTC) Subject: [commit: ghc] master: Update perf number for T5642 (d0ee4eb) Message-ID: <20140807212816.EDE78240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d0ee4eb0879f77067e7f05e0daa80e6ca8817f1d/ghc >--------------------------------------------------------------- commit d0ee4eb0879f77067e7f05e0daa80e6ca8817f1d Author: Joachim Breitner Date: Thu Aug 7 23:27:12 2014 +0200 Update perf number for T5642 This +4% increase (from -1% before) was caused by 1fc60ea. But that commit did not cause any other regressions, so I?m not investigating further. >--------------------------------------------------------------- d0ee4eb0879f77067e7f05e0daa80e6ca8817f1d testsuite/tests/perf/compiler/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 5921554..ea62520 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -392,9 +392,10 @@ test('T5642', compiler_stats_num_field('bytes allocated', [(wordsize(32), 650000000, 10), # sample from x86/Linux - (wordsize(64), 1358833928, 10)]) + (wordsize(64), 1402242360, 10)]) # prev: 1300000000 # 2014-07-17: 1358833928 (general round of updates) + # 2014-08-07: 1402242360 (caused by 1fc60ea) ], compile,['-O']) From git at git.haskell.org Fri Aug 8 04:14:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 04:14:11 +0000 (UTC) Subject: [commit: ghc] master: Update Haddock to attoparsec-0.12.1. Adjust perf. (7d52e62) Message-ID: <20140808041411.C83DF240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7d52e628c840839ff93231022864cb8170274ab7/ghc >--------------------------------------------------------------- commit 7d52e628c840839ff93231022864cb8170274ab7 Author: Mateusz Kowalczyk Date: Fri Aug 8 06:13:13 2014 +0200 Update Haddock to attoparsec-0.12.1. Adjust perf. Please adjust the perf number on your platform if/when it fails. It should improve slightly. Updates submodule. >--------------------------------------------------------------- 7d52e628c840839ff93231022864cb8170274ab7 testsuite/tests/perf/haddock/all.T | 3 ++- utils/haddock | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index dbd2471..1ef4fbc 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -33,7 +33,7 @@ test('haddock.base', # 2014-01-22: 62189068 (x86/Linux) # 2014-06-29: 58243640 (x86/Linux) ,stats_num_field('bytes allocated', - [(wordsize(64), 7992757384, 5) + [(wordsize(64), 7946284944, 5) # 2012-08-14: 5920822352 (amd64/Linux) # 2012-09-20: 5829972376 (amd64/Linux) # 2012-10-08: 5902601224 (amd64/Linux) @@ -45,6 +45,7 @@ test('haddock.base', # 2014-01-12: 7128342344 (x86_64/Linux) # 2014-06-12: 7498123680 (x86_64/Linux) # 2014-08-05: 7992757384 (x86_64/Linux - bugfix for #314, Haddock now parses more URLs) + # 2014-08-08: 7946284944 (x86_64/Linux - Haddock updates to attoparsec-0.12.1.0) ,(platform('i386-unknown-mingw32'), 3548581572, 5) # 2013-02-10: 3358693084 (x86/Windows) # 2013-11-13: 3097751052 (x86/Windows, 64bit machine) diff --git a/utils/haddock b/utils/haddock index d9b224f..d8f1c1c 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit d9b224f124edc99f051dfc0dcab922041654c36a +Subproject commit d8f1c1cc4e8825f39ffc87fddfe6ff9c58f9ef8e From git at git.haskell.org Fri Aug 8 08:04:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 08:04:44 +0000 (UTC) Subject: [commit: ghc] master: Implement the final change to INCOHERENT from Trac #9242 (dff0623) Message-ID: <20140808080444.CBEAF240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dff0623d5ab13222c06b3ff6b32793e05b417970/ghc >--------------------------------------------------------------- commit dff0623d5ab13222c06b3ff6b32793e05b417970 Author: Simon Peyton Jones Date: Fri Aug 8 08:35:14 2014 +0100 Implement the final change to INCOHERENT from Trac #9242 The change here is to make INCOHERENT slightly more permissive: if the selected candidate is incoherent then ignore all unifying candidates This allows us to move the {-# INCOHERENT #-} pragma from from instance Typeable (f a) to Typeable (n:Nat) and Typable (s:Symbol) where it belongs, and where Trac #9242 said it should be. I don't think this will affect anyone. I've updated the user manual. >--------------------------------------------------------------- dff0623d5ab13222c06b3ff6b32793e05b417970 compiler/types/InstEnv.lhs | 83 +++++++++++--------- docs/users_guide/glasgow_exts.xml | 88 +++++++++++----------- libraries/base/Data/Typeable/Internal.hs | 37 +++++---- .../tests/typecheck/should_fail/Tcfail218_Help.hs | 7 -- testsuite/tests/typecheck/should_fail/all.T | 5 +- testsuite/tests/typecheck/should_fail/tcfail218.hs | 24 ++++-- .../tests/typecheck/should_fail/tcfail218.stderr | 10 +-- 7 files changed, 132 insertions(+), 122 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc dff0623d5ab13222c06b3ff6b32793e05b417970 From git at git.haskell.org Fri Aug 8 16:25:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 16:25:59 +0000 (UTC) Subject: [commit: ghc] master: Fix path in cabal file (ca3fc66) Message-ID: <20140808162559.159E5240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ca3fc66d4f89acf32c7263f6b3f5c0997c25d6a5/ghc >--------------------------------------------------------------- commit ca3fc66d4f89acf32c7263f6b3f5c0997c25d6a5 Author: Mateusz Kowalczyk Date: Fri Aug 8 18:25:33 2014 +0200 Fix path in cabal file Update Haddock submodule >--------------------------------------------------------------- ca3fc66d4f89acf32c7263f6b3f5c0997c25d6a5 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index d8f1c1c..f32ad30 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit d8f1c1cc4e8825f39ffc87fddfe6ff9c58f9ef8e +Subproject commit f32ad30e9b8c5d4ee54c60c9c3b282fef7d297a5 From git at git.haskell.org Fri Aug 8 18:58:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:58:05 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #9415. (beb3e69) Message-ID: <20140808185806.382E2240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/beb3e69892c493be8c35f9a030ef4dca4c12b721/ghc >--------------------------------------------------------------- commit beb3e69892c493be8c35f9a030ef4dca4c12b721 Author: Richard Eisenberg Date: Wed Aug 6 09:51:26 2014 -0400 Fix #9415. Abort typechecking when we detect a superclass cycle error, as ambiguity checking in the presence of superclass cycle errors can cause a loop. >--------------------------------------------------------------- beb3e69892c493be8c35f9a030ef4dca4c12b721 compiler/typecheck/TcTyClsDecls.lhs | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index f09bef8..2db31e3 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1369,10 +1369,24 @@ since GADTs are not kind indexed. Validity checking is done once the mutually-recursive knot has been tied, so we can look at things freely. +Note [Abort when superclass cycle is detected] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must avoid doing the ambiguity check when there are already errors accumulated. +This is because one of the errors may be a superclass cycle, and superclass cycles +cause canonicalization to loop. Here is a representative example: + + class D a => C a where + meth :: D a => () + class C a => D a + +This fixes Trac #9415. + \begin{code} checkClassCycleErrs :: Class -> TcM () checkClassCycleErrs cls - = unless (null cls_cycles) $ mapM_ recClsErr cls_cycles + = unless (null cls_cycles) $ + do { mapM_ recClsErr cls_cycles + ; failM } -- See Note [Abort when superclass cycle is detected] where cls_cycles = calcClassCycles cls checkValidTyCl :: TyThing -> TcM () @@ -1623,6 +1637,7 @@ checkValidClass cls ; checkValidTheta (ClassSCCtxt (className cls)) theta -- Now check for cyclic superclasses + -- If there are superclass cycles, checkClassCycleErrs bails. ; checkClassCycleErrs cls -- Check the class operations From git at git.haskell.org Fri Aug 8 18:58:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:58:09 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #9415 (typecheck/should_fail/T9415) (e2231ec) Message-ID: <20140808185809.850D8240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/e2231ec2f769092a0b213992fccb36cf6f4482e7/ghc >--------------------------------------------------------------- commit e2231ec2f769092a0b213992fccb36cf6f4482e7 Author: Richard Eisenberg Date: Wed Aug 6 09:54:37 2014 -0400 Test #9415 (typecheck/should_fail/T9415) >--------------------------------------------------------------- e2231ec2f769092a0b213992fccb36cf6f4482e7 testsuite/tests/typecheck/should_fail/T9415.hs | 5 +++++ testsuite/tests/typecheck/should_fail/T9415.stderr | 8 ++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 3 files changed, 14 insertions(+) diff --git a/testsuite/tests/typecheck/should_fail/T9415.hs b/testsuite/tests/typecheck/should_fail/T9415.hs new file mode 100644 index 0000000..db77ff0 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9415.hs @@ -0,0 +1,5 @@ +module T9415 where + +class D a => C a where + meth :: D a => () +class C a => D a diff --git a/testsuite/tests/typecheck/should_fail/T9415.stderr b/testsuite/tests/typecheck/should_fail/T9415.stderr new file mode 100644 index 0000000..516759e --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9415.stderr @@ -0,0 +1,8 @@ + +T9415.hs:3:1: + Cycle in class declaration (via superclasses): C -> D -> C + In the class declaration for ?C? + +T9415.hs:5:1: + Cycle in class declaration (via superclasses): D -> C -> D + In the class declaration for ?D? diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index cf2af30..85f5052 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -336,3 +336,4 @@ test('T8883', normal, compile_fail, ['']) test('T9196', normal, compile_fail, ['']) test('T9305', normal, compile_fail, ['']) test('T9323', normal, compile_fail, ['']) +test('T9415', normal, compile_fail, ['']) From git at git.haskell.org Fri Aug 8 18:58:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:58:11 +0000 (UTC) Subject: [commit: ghc] wip/rae: Change treatment of CUSKs for synonyms and families (#9200). (077d880) Message-ID: <20140808185812.9D20A240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/077d880ba2a7c3a9684ac911828d943d1e920bc7/ghc >--------------------------------------------------------------- commit 077d880ba2a7c3a9684ac911828d943d1e920bc7 Author: Richard Eisenberg Date: Thu Aug 7 08:28:32 2014 -0400 Change treatment of CUSKs for synonyms and families (#9200). >--------------------------------------------------------------- 077d880ba2a7c3a9684ac911828d943d1e920bc7 compiler/typecheck/TcHsType.lhs | 27 +++++++++++++++++++++++---- testsuite/tests/polykinds/T9200.hs | 12 +++++++++++- 2 files changed, 34 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index 14a3c17..d075cbc 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -1067,22 +1067,41 @@ kcStrategy :: TyClDecl Name -> KindCheckingStrategy kcStrategy d@(ForeignType {}) = pprPanic "kcStrategy" (ppr d) kcStrategy (FamDecl fam_decl) = kcStrategyFamDecl fam_decl -kcStrategy (SynDecl {}) = ParametricKinds +kcStrategy (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) + | all_tyvars_annotated tyvars + , rhs_annotated rhs + = FullKindSignature + | otherwise + = ParametricKinds + where + rhs_annotated (L _ ty) = case ty of + HsParTy lty -> rhs_annotated lty + HsKindSig {} -> True + _ -> False kcStrategy decl@(DataDecl {}) = kcStrategyAlgDecl decl kcStrategy decl@(ClassDecl {}) = kcStrategyAlgDecl decl kcStrategyAlgDecl :: TyClDecl Name -> KindCheckingStrategy kcStrategyAlgDecl decl - | all (isHsKindedTyVar . unLoc) (hsQTvBndrs $ tcdTyVars decl) + | all_tyvars_annotated $ tcdTyVars decl = FullKindSignature | otherwise = ParametricKinds --- if the ClosedTypeFamily has no equations, do the defaulting to *, etc. kcStrategyFamDecl :: FamilyDecl Name -> KindCheckingStrategy -kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily (_:_) }) = NonParametricKinds +kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily _ + , fdTyVars = tyvars + , fdKindSig = Just _ }) + | all (isHsKindedTyVar . unLoc) (hsQTvBndrs tyvars) + = FullKindSignature +-- if the ClosedTypeFamily has no equations, do the defaulting to *, etc. +kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily (_:_) }) = ParametricKinds kcStrategyFamDecl _ = FullKindSignature +-- | Are all the type variables given with a kind annotation? +all_tyvars_annotated :: LHsTyVarBndrs name -> Bool +all_tyvars_annotated = all (isHsKindedTyVar . unLoc) . hsQTvBndrs + mkKindSigVar :: Name -> TcM KindVar -- Use the specified name; don't clone it mkKindSigVar n diff --git a/testsuite/tests/polykinds/T9200.hs b/testsuite/tests/polykinds/T9200.hs index b74177a..ca05066 100644 --- a/testsuite/tests/polykinds/T9200.hs +++ b/testsuite/tests/polykinds/T9200.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds #-} +{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds, + TypeFamilies #-} module T9200 where @@ -17,3 +18,12 @@ data T1 a b c = MkT1 (S True b c) data T2 p q r = MkT2 (S p 5 r) data T3 x y q = MkT3 (S x y '()) type S (f :: k1) (g :: k2) (h :: k3) = ((T1 f g h, T2 f g h, T3 f g h) :: *) + + +---------- +-- test CUSK on closed type families +type family F (a :: k) :: k where + F True = False + F False = True + F x = x + From git at git.haskell.org Fri Aug 8 18:58:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:58:14 +0000 (UTC) Subject: [commit: ghc] wip/rae: Change definition of CUSK for data and class definitions (#9200). (3dc309c) Message-ID: <20140808185815.248B0240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/3dc309c10bbddb4299d97c6cf5744d444c6d8b5e/ghc >--------------------------------------------------------------- commit 3dc309c10bbddb4299d97c6cf5744d444c6d8b5e Author: Richard Eisenberg Date: Wed Aug 6 09:56:50 2014 -0400 Change definition of CUSK for data and class definitions (#9200). Now, a CUSK is when (and only when) all type variables are annotated. This allows classes to participate in polymorphic recursion. >--------------------------------------------------------------- 3dc309c10bbddb4299d97c6cf5744d444c6d8b5e compiler/hsSyn/HsTypes.lhs | 7 ++++++- compiler/typecheck/TcHsType.lhs | 19 ++++++++++++++----- 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index 08a0eef..eada762 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -25,7 +25,7 @@ module HsTypes ( ConDeclField(..), pprConDeclFields, - mkHsQTvs, hsQTvBndrs, + mkHsQTvs, hsQTvBndrs, isHsKindedTyVar, mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs, hsTyVarName, mkHsWithBndrs, hsLKiTyVarNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, @@ -188,6 +188,11 @@ data HsTyVarBndr name (LHsKind name) -- The user-supplied kind signature deriving (Data, Typeable) +-- | Does this 'HsTyVarBndr' come with an explicit kind annotation? +isHsKindedTyVar :: HsTyVarBndr name -> Bool +isHsKindedTyVar (UserTyVar {}) = False +isHsKindedTyVar (KindedTyVar {}) = True + data HsType name = HsForAllTy HsExplicitFlag -- Renamer leaves this flag unchanged, to record the way -- the user wrote it originally, so that the printer can diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index cdeb191..14a3c17 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -1068,10 +1068,15 @@ kcStrategy d@(ForeignType {}) = pprPanic "kcStrategy" (ppr d) kcStrategy (FamDecl fam_decl) = kcStrategyFamDecl fam_decl kcStrategy (SynDecl {}) = ParametricKinds -kcStrategy (DataDecl { tcdDataDefn = HsDataDefn { dd_kindSig = m_ksig }}) - | Just _ <- m_ksig = FullKindSignature - | otherwise = ParametricKinds -kcStrategy (ClassDecl {}) = ParametricKinds +kcStrategy decl@(DataDecl {}) = kcStrategyAlgDecl decl +kcStrategy decl@(ClassDecl {}) = kcStrategyAlgDecl decl + +kcStrategyAlgDecl :: TyClDecl Name -> KindCheckingStrategy +kcStrategyAlgDecl decl + | all (isHsKindedTyVar . unLoc) (hsQTvBndrs $ tcdTyVars decl) + = FullKindSignature + | otherwise + = ParametricKinds -- if the ClosedTypeFamily has no equations, do the defaulting to *, etc. kcStrategyFamDecl :: FamilyDecl Name -> KindCheckingStrategy @@ -1259,7 +1264,11 @@ kcTyClTyVars :: Name -> LHsTyVarBndrs Name -> TcM a -> TcM a kcTyClTyVars name (HsQTvs { hsq_kvs = kvs, hsq_tvs = hs_tvs }) thing_inside = kcScopedKindVars kvs $ do { tc_kind <- kcLookupKind name - ; let (arg_ks, _res_k) = splitKindFunTysN (length hs_tvs) tc_kind + ; let (_, mono_kind) = splitForAllTys tc_kind + -- if we have a FullKindSignature, the tc_kind may already + -- be generalized. The kvs get matched up while kind-checking + -- the types in kc_tv, below + (arg_ks, _res_k) = splitKindFunTysN (length hs_tvs) mono_kind -- There should be enough arrows, because -- getInitialKinds used the tcdTyVars ; name_ks <- zipWithM kc_tv hs_tvs arg_ks From git at git.haskell.org Fri Aug 8 18:58:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:58:18 +0000 (UTC) Subject: [commit: ghc] wip/rae: Added more testing for #9200. (polykinds/T9200b) (a59d668) Message-ID: <20140808185818.233DA240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/a59d66832078ef0a838ad53939de619f1b5333ea/ghc >--------------------------------------------------------------- commit a59d66832078ef0a838ad53939de619f1b5333ea Author: Richard Eisenberg Date: Thu Aug 7 08:19:22 2014 -0400 Added more testing for #9200. (polykinds/T9200b) >--------------------------------------------------------------- a59d66832078ef0a838ad53939de619f1b5333ea testsuite/tests/polykinds/T9200b.hs | 10 ++++++++++ testsuite/tests/polykinds/T9200b.stderr | 6 ++++++ testsuite/tests/polykinds/all.T | 1 + 3 files changed, 17 insertions(+) diff --git a/testsuite/tests/polykinds/T9200b.hs b/testsuite/tests/polykinds/T9200b.hs new file mode 100644 index 0000000..f780aba --- /dev/null +++ b/testsuite/tests/polykinds/T9200b.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds #-} + +module T9200b where + +--------- +--- test CUSK on closed type families +type family F (a :: k) where + F True = False + F False = True + F x = x diff --git a/testsuite/tests/polykinds/T9200b.stderr b/testsuite/tests/polykinds/T9200b.stderr new file mode 100644 index 0000000..5e8c730 --- /dev/null +++ b/testsuite/tests/polykinds/T9200b.stderr @@ -0,0 +1,6 @@ + +T9200b.hs:8:5: + The first argument of ?F? should have kind ?k?, + but ?True? has kind ?Bool? + In the type ?True? + In the type family declaration for ?F? diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index abb158b..82c1824 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -107,3 +107,4 @@ test('T9264', normal, compile, ['']) test('T9263', normal, run_command, ['$MAKE -s --no-print-directory T9263']) test('T9063', normal, compile, ['']) test('T9200', normal, compile, ['']) +test('T9200b', normal, compile_fail, ['']) From git at git.haskell.org Fri Aug 8 18:58:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:58:21 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #9200. (polykinds/T9200) (9bca799) Message-ID: <20140808185821.58E7C240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/9bca7991ce6d30abe87117ca127d50b09fb4f70d/ghc >--------------------------------------------------------------- commit 9bca7991ce6d30abe87117ca127d50b09fb4f70d Author: Richard Eisenberg Date: Sun Aug 3 21:37:45 2014 -0400 Test #9200. (polykinds/T9200) >--------------------------------------------------------------- 9bca7991ce6d30abe87117ca127d50b09fb4f70d testsuite/tests/polykinds/T9200.hs | 19 +++++++++++++++++++ testsuite/tests/polykinds/all.T | 1 + 2 files changed, 20 insertions(+) diff --git a/testsuite/tests/polykinds/T9200.hs b/testsuite/tests/polykinds/T9200.hs new file mode 100644 index 0000000..b74177a --- /dev/null +++ b/testsuite/tests/polykinds/T9200.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds #-} + +module T9200 where + +------ +-- test CUSK on classes + +class C (f :: k) (a :: k2) where + c_meth :: D a => () + +class C () a => D a + + +--------- +--- test CUSK on type synonyms +data T1 a b c = MkT1 (S True b c) +data T2 p q r = MkT2 (S p 5 r) +data T3 x y q = MkT3 (S x y '()) +type S (f :: k1) (g :: k2) (h :: k3) = ((T1 f g h, T2 f g h, T3 f g h) :: *) diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 22a159d..abb158b 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -106,3 +106,4 @@ test('T9222', normal, compile, ['']) test('T9264', normal, compile, ['']) test('T9263', normal, run_command, ['$MAKE -s --no-print-directory T9263']) test('T9063', normal, compile, ['']) +test('T9200', normal, compile, ['']) From git at git.haskell.org Fri Aug 8 18:58:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:58:24 +0000 (UTC) Subject: [commit: ghc] wip/rae: Remove NonParametricKinds (#9200) (22e0f56) Message-ID: <20140808185824.7881C240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/22e0f5681344324333da5684b63bc69d9b5543f5/ghc >--------------------------------------------------------------- commit 22e0f5681344324333da5684b63bc69d9b5543f5 Author: Richard Eisenberg Date: Thu Aug 7 08:37:05 2014 -0400 Remove NonParametricKinds (#9200) This commit also removes 'KindCheckingStrategy' and related gubbins, instead including the notion of a CUSK into HsDecls. >--------------------------------------------------------------- 22e0f5681344324333da5684b63bc69d9b5543f5 compiler/hsSyn/HsDecls.lhs | 48 ++++++++ compiler/hsSyn/HsTypes.lhs | 6 +- compiler/typecheck/TcHsType.lhs | 229 +++--------------------------------- compiler/typecheck/TcTyClsDecls.lhs | 20 ++-- 4 files changed, 77 insertions(+), 226 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 22e0f5681344324333da5684b63bc69d9b5543f5 From git at git.haskell.org Fri Aug 8 18:58:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:58:26 +0000 (UTC) Subject: [commit: ghc] wip/rae: Update manual (#9200). (c96387f) Message-ID: <20140808185827.0161A240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/c96387f5ab07542fe1a0110137be05a510c16015/ghc >--------------------------------------------------------------- commit c96387f5ab07542fe1a0110137be05a510c16015 Author: Richard Eisenberg Date: Thu Aug 7 08:53:11 2014 -0400 Update manual (#9200). >--------------------------------------------------------------- c96387f5ab07542fe1a0110137be05a510c16015 docs/users_guide/glasgow_exts.xml | 105 ++++++++++++++++++++++---------------- 1 file changed, 62 insertions(+), 43 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 00f4315..80c0cd3 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -6529,11 +6529,11 @@ data T m a = MkT (m a) (T Maybe (m a)) The recursive use of T forced the second argument to have kind *. However, just as in type inference, you can achieve polymorphic recursion by giving a -complete kind signature for T. The way to give -a complete kind signature for a data type is to use a GADT-style declaration with an -explicit kind signature thus: +complete kind signature for T. A complete +kind signature is present when all argument kinds and the result kind are known, without +any need for inference. For example: -data T :: (k -> *) -> k -> * where +data T (m :: k -> *) :: k -> * where MkT :: m a -> T Maybe (m a) -> T m a The complete user-supplied kind signature specifies the polymorphic kind for T, @@ -6545,26 +6545,41 @@ In particular, the recursive use of T is at kind * - -A GADT-style data type declaration, with an explicit "::" in the header. -For example: +For a datatype, every type variable must be annotated with a kind. In a +GADT-style declaration, there may also be a kind signature (with a top-level +:: in the header), but the presence or absence of this annotation +does not affect whether or not the declaration has a complete signature. data T1 :: (k -> *) -> k -> * where ... -- Yes T1 :: forall k. (k->*) -> k -> * data T2 (a :: k -> *) :: k -> * where ... -- Yes T2 :: forall k. (k->*) -> k -> * data T3 (a :: k -> *) (b :: k) :: * where ... -- Yes T3 :: forall k. (k->*) -> k -> * -data T4 a (b :: k) :: * where ... -- YES T4 :: forall k. * -> k -> * +data T4 (a :: k -> *) (b :: k) where ... -- Yes T4 :: forall k. (k->*) -> k -> * -data T5 a b where ... -- NO kind is inferred -data T4 (a :: k -> *) (b :: k) where ... -- NO kind is inferred - -It makes no difference where you put the "::" but it must be there. -You cannot give a complete kind signature using a Haskell-98-style data type declaration; -you must use GADT syntax. +data T5 a (b :: k) :: * where ... -- NO kind is inferred +data T6 a b where ... -- NO kind is inferred + + + + +For a class, every type variable must be annotated with a kind. +For a type synonym, every type variable and the result type must all be annotated +with kinds. + +type S1 (a :: k) = (a :: k) -- Yes S1 :: forall k. k -> k +type S2 (a :: k) = a -- No kind is inferred +type S3 (a :: k) = Proxy a -- No kind is inferred + +Note that in S2 and S3, the kind of the +right-hand side is rather apparent, but it is still not considered to have a complete +signature -- no inference can be done before detecting the signature. + + An open type or data family declaration always has a -complete user-specified kind signature; no "::" is required: +complete user-specified kind signature; un-annotated type variables default to +kind *. data family D1 a -- D1 :: * -> * data family D2 (a :: k) -- D2 :: forall k. k -> * @@ -6579,10 +6594,12 @@ variable annotation from the class declaration. It keeps its polymorphic kind in the associated type declaration. The variable b, however, gets defaulted to *. + + +A closed type familey has a complete signature when all of its type variables +are annotated and a return kind (with a top-level ::) is supplied. + -In a complete user-specified kind signature, any un-decorated type variable to the -left of the "::" is considered to have kind "*". -If you want kind polymorphism, specify a kind variable. @@ -6592,31 +6609,33 @@ If you want kind polymorphism, specify a kind variable. Although all open type families are considered to have a complete user-specified kind signature, we can relax this condition for closed type families, where we have equations on which to perform kind inference. GHC will -infer a kind for any type variable in a closed type family when that kind is -never used in pattern-matching. If you want a kind variable to be used in -pattern-matching, you must declare it explicitly. - - - -Here are some examples (assuming -XDataKinds is enabled): - -type family Not a where -- Not :: Bool -> Bool - Not False = True - Not True = False - -type family F a where -- ERROR: requires pattern-matching on a kind variable - F Int = Bool - F Maybe = Char - -type family G (a :: k) where -- G :: k -> * - G Int = Bool - G Maybe = Char - -type family SafeHead where -- SafeHead :: [k] -> Maybe k - SafeHead '[] = Nothing -- note that k is not required for pattern-matching - SafeHead (h ': t) = Just h - - +infer kinds for the arguments and result types of a closed type family. + +GHC supports kind-indexed type families, where the +family matches both on the kind and type. GHC will not infer +this behaviour without a complete user-supplied kind signature, as doing so would +sometimes infer non-principal types. + +For example: + +type family F1 a where + F1 True = False + F1 False = True + F1 x = x +-- F1 fails to compile: kind-indexing is not inferred + +type family F2 (a :: k) where + F2 True = False + F2 False = True + F2 x = x +-- F2 fails to compile: no complete signature + +type family F3 (a :: k) :: k where + F3 True = False + F3 False = True + F3 x = x +-- OK + From git at git.haskell.org Fri Aug 8 18:58:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:58:29 +0000 (UTC) Subject: [commit: ghc] wip/rae: Testsuite wibbles around #9200 (7311db9) Message-ID: <20140808185830.52ACA240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/7311db9ce5a2c5112e299732b65e6a88100398be/ghc >--------------------------------------------------------------- commit 7311db9ce5a2c5112e299732b65e6a88100398be Author: Richard Eisenberg Date: Fri Aug 8 08:14:52 2014 -0400 Testsuite wibbles around #9200 >--------------------------------------------------------------- 7311db9ce5a2c5112e299732b65e6a88100398be testsuite/tests/ghci/scripts/T7939.hs | 2 +- testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot | 2 +- testsuite/tests/polykinds/T7053.hs | 2 +- testsuite/tests/polykinds/T7053.stderr | 8 -------- testsuite/tests/polykinds/all.T | 2 +- 5 files changed, 4 insertions(+), 12 deletions(-) diff --git a/testsuite/tests/ghci/scripts/T7939.hs b/testsuite/tests/ghci/scripts/T7939.hs index 93b9016..fbdf883 100644 --- a/testsuite/tests/ghci/scripts/T7939.hs +++ b/testsuite/tests/ghci/scripts/T7939.hs @@ -22,6 +22,6 @@ type family K a where K '[] = Nothing K (h ': t) = Just h -type family L (a :: k) b :: k where +type family L (a :: k) (b :: *) :: k where L Int Int = Bool L Maybe Bool = IO diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot b/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot index 0388084..503e1ad 100644 --- a/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot +++ b/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot @@ -9,5 +9,5 @@ type family Bar a where Bar Int = Bool Bar Double = Char -type family Baz (a :: k) where +type family Baz (a :: k) :: * where Baz Int = Bool diff --git a/testsuite/tests/polykinds/T7053.hs b/testsuite/tests/polykinds/T7053.hs index 4db1e0d..d45dbad 100644 --- a/testsuite/tests/polykinds/T7053.hs +++ b/testsuite/tests/polykinds/T7053.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE PolyKinds, GADTs #-} module T7053 where diff --git a/testsuite/tests/polykinds/T7053.stderr b/testsuite/tests/polykinds/T7053.stderr deleted file mode 100644 index c9ebcfe..0000000 --- a/testsuite/tests/polykinds/T7053.stderr +++ /dev/null @@ -1,8 +0,0 @@ - -T7053.hs:6:52: - Kind occurs check - The first argument of ?a? should have kind ?k0?, - but ?b? has kind ?k0 -> k1? - In the type ?TypeRep (a b)? - In the definition of data constructor ?TyApp? - In the data declaration for ?TypeRep? diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 82c1824..5b02dda 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -54,7 +54,7 @@ test('T6137', normal, compile,['']) test('T6093', normal, compile,['']) test('T6049', normal, compile,['']) test('T6129', normal, compile_fail,['']) -test('T7053', normal, compile_fail,['']) +test('T7053', normal, compile,['']) test('T7053a', normal, compile,['']) test('T7020', normal, compile,['']) test('T7022', normal, run_command, ['$MAKE -s --no-print-directory T7022']) From git at git.haskell.org Fri Aug 8 18:59:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:59:39 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #9371 (indexed-types/should_fail/T9371) (77b065b) Message-ID: <20140808185939.E2B21240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/77b065b1a5462e7590989b7b4b6bf96099dbf1a3/ghc >--------------------------------------------------------------- commit 77b065b1a5462e7590989b7b4b6bf96099dbf1a3 Author: Richard Eisenberg Date: Sun Aug 3 17:54:54 2014 -0400 Test #9371 (indexed-types/should_fail/T9371) >--------------------------------------------------------------- 77b065b1a5462e7590989b7b4b6bf96099dbf1a3 testsuite/tests/indexed-types/should_fail/T9371.hs | 25 ++++++++++++++++++++++ .../tests/indexed-types/should_fail/T9371.stderr | 5 +++++ testsuite/tests/indexed-types/should_fail/all.T | 1 + 3 files changed, 31 insertions(+) diff --git a/testsuite/tests/indexed-types/should_fail/T9371.hs b/testsuite/tests/indexed-types/should_fail/T9371.hs new file mode 100644 index 0000000..cfec4c0 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9371.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} + +module T9371 where + +import Data.Monoid + +class C x where + data D x :: * + makeD :: D x + +instance {-# OVERLAPPABLE #-} Monoid x => C x where + data D x = D1 (Either x ()) + makeD = D1 (Left mempty) + +instance (Monoid x, Monoid y) => C (x, y) where + data D (x,y) = D2 (x,y) + makeD = D2 (mempty, mempty) + +instance Show x => Show (D x) where + show (D1 x) = show x + + +main = print (makeD :: D (String, String)) diff --git a/testsuite/tests/indexed-types/should_fail/T9371.stderr b/testsuite/tests/indexed-types/should_fail/T9371.stderr new file mode 100644 index 0000000..695a7b4 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9371.stderr @@ -0,0 +1,5 @@ + +T9371.hs:14:10: + Conflicting family instance declarations: + D -- Defined at T9371.hs:14:10 + D (x, y) -- Defined at T9371.hs:18:10 diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 0851c08..6d284cf 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -125,3 +125,4 @@ test('T9171', normal, compile_fail, ['']) test('T9097', normal, compile_fail, ['']) test('T9160', normal, compile_fail, ['']) test('T9357', normal, compile_fail, ['']) +test('T9371', normal, compile_fail, ['']) From git at git.haskell.org Fri Aug 8 18:59:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:59:42 +0000 (UTC) Subject: [commit: ghc] wip/rae: Comments only: explain that TauTv sometimes gets sigma-types. (6c1b709) Message-ID: <20140808185942.A1873240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/6c1b709946240f4d0ea37a7783c50dedfd009469/ghc >--------------------------------------------------------------- commit 6c1b709946240f4d0ea37a7783c50dedfd009469 Author: Richard Eisenberg Date: Sun Aug 3 18:51:37 2014 -0400 Comments only: explain that TauTv sometimes gets sigma-types. >--------------------------------------------------------------- 6c1b709946240f4d0ea37a7783c50dedfd009469 compiler/typecheck/TcType.lhs | 24 ++++++++++++++++++++++-- compiler/typecheck/TcUnify.lhs | 1 + 2 files changed, 23 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index f12ec9d..c779fbb 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -264,6 +264,25 @@ Similarly consider When doing kind inference on {S,T} we don't want *skolems* for k1,k2, because they end up unifying; we want those SigTvs again. +Note [TauTv sometimes gets sigma-types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Despite the name TauTv, a TauTv metavariable can be *unified* with a +sigma-type -- it's just that the solver will never make this choice. +This is because sigma-types sometimes have implicit parameters (type +parameters & dictionaries). We need to know up front where these +implicit parameters occur, so that we can instantiate for them. If, +say, unification didn't expose that a meta-variable was really a forall, +and the solver did discover this, we'd be in trouble, because the forall-type's +implicit parameters wouldn't be instantiated. Indeed, this is the whole +point of having TauTvs at all. + +But, it's OK if the unifier discovers that a TauTv should be a sigma-type. +That's because the unifier is run while we're walking through the expression, +so when it's time to instantiate, we can zonk away any known meta-variables, +expose the sigma-type, and instantiate away. + +This is all implemented in checkTauTvUpdate in TcUnify. + \begin{code} -- A TyVarDetails is inside a TyVar data TcTyVarDetails @@ -303,8 +322,9 @@ instance Outputable MetaDetails where data MetaInfo = TauTv -- This MetaTv is an ordinary unification variable - -- A TauTv is always filled in with a tau-type, which - -- never contains any ForAlls + -- A TauTv is usually filled with a tau-type, which + -- cannot have any foralls. But not always; see + -- Note [TauTv sometimes gets sigma-types] | PolyTv -- Like TauTv, but can unify with a sigma-type diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index ef06ddd..6552ebe 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -899,6 +899,7 @@ checkTauTvUpdate dflags tv ty -- Checks for (a) occurrence of tv -- (b) type family applications -- See Note [Conservative unification check] + -- and Note [TauTv sometimes gets sigma-types] in TcType defer_me (LitTy {}) = False defer_me (TyVarTy tv') = tv == tv' defer_me (TyConApp tc tys) = isSynFamilyTyCon tc || any defer_me tys From git at git.haskell.org Fri Aug 8 18:59:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:59:44 +0000 (UTC) Subject: [commit: ghc] wip/rae: Remove tcInfExpr (#9404) (c26714c) Message-ID: <20140808185944.E3FD7240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/c26714caf71bbf7c5f763b626fe10c5b52a35726/ghc >--------------------------------------------------------------- commit c26714caf71bbf7c5f763b626fe10c5b52a35726 Author: Richard Eisenberg Date: Sun Aug 3 21:29:51 2014 -0400 Remove tcInfExpr (#9404) It seems that tcInfExpr (a special case for inferring a type without a known result type) is unnecessary. This removes it in favor of using the main tcExpr exclusively. >--------------------------------------------------------------- c26714caf71bbf7c5f763b626fe10c5b52a35726 compiler/typecheck/TcExpr.lhs | 26 +------------------------- 1 file changed, 1 insertion(+), 25 deletions(-) diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index 7e6c495..b23e622 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -125,16 +125,9 @@ tcInferRho expr = addErrCtxt (exprCtxt expr) (tcInferRhoNC expr) tcInferRhoNC (L loc expr) = setSrcSpan loc $ - do { (expr', rho) <- tcInfExpr expr + do { (expr', rho) <- tcInfer (tcExpr expr) ; return (L loc expr', rho) } -tcInfExpr :: HsExpr Name -> TcM (HsExpr TcId, TcRhoType) -tcInfExpr (HsVar f) = tcInferId f -tcInfExpr (HsPar e) = do { (e', ty) <- tcInferRhoNC e - ; return (HsPar e', ty) } -tcInfExpr (HsApp e1 e2) = tcInferApp e1 [e2] -tcInfExpr e = tcInfer (tcExpr e) - tcHole :: OccName -> TcRhoType -> TcM (HsExpr TcId) tcHole occ res_ty = do { ty <- newFlexiTyVarTy liftedTypeKind @@ -937,23 +930,6 @@ mk_app_msg fun = sep [ ptext (sLit "The function") <+> quotes (ppr fun) , ptext (sLit "is applied to")] ---------------- -tcInferApp :: LHsExpr Name -> [LHsExpr Name] -- Function and args - -> TcM (HsExpr TcId, TcRhoType) -- Translated fun and args - -tcInferApp (L _ (HsPar e)) args = tcInferApp e args -tcInferApp (L _ (HsApp e1 e2)) args = tcInferApp e1 (e2:args) -tcInferApp fun args - = -- Very like the tcApp version, except that there is - -- no expected result type passed in - do { (fun1, fun_tau) <- tcInferFun fun - ; (co_fun, expected_arg_tys, actual_res_ty) - <- matchExpectedFunTys (mk_app_msg fun) (length args) fun_tau - ; args1 <- tcArgs fun args expected_arg_tys - ; let fun2 = mkLHsWrapCo co_fun fun1 - app = foldl mkHsApp fun2 args1 - ; return (unLoc app, actual_res_ty) } - ----------------- tcInferFun :: LHsExpr Name -> TcM (LHsExpr TcId, TcRhoType) -- Infer and instantiate the type of a function tcInferFun (L loc (HsVar name)) From git at git.haskell.org Fri Aug 8 18:59:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:59:47 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix Trac #9371. (0766407) Message-ID: <20140808185947.994EE240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/0766407454e1f324ab49b6136a8b7b02c5a4aa02/ghc >--------------------------------------------------------------- commit 0766407454e1f324ab49b6136a8b7b02c5a4aa02 Author: Richard Eisenberg Date: Sun Aug 3 18:40:30 2014 -0400 Fix Trac #9371. This was very simple: lists of different lengths are *maybe* apart, not *surely* apart. >--------------------------------------------------------------- 0766407454e1f324ab49b6136a8b7b02c5a4aa02 compiler/types/Unify.lhs | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs index f44e260..1eb1c2b 100644 --- a/compiler/types/Unify.lhs +++ b/compiler/types/Unify.lhs @@ -418,6 +418,26 @@ substituted, we can't properly unify the types. But, that skolem variable may later be instantiated with a unifyable type. So, we return maybeApart in these cases. +Note [Lists of different lengths are MaybeApart] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It is unusual to call tcUnifyTys or tcUnifyTysFG with lists of different +lengths. The place where we know this can happen is from compatibleBranches in +FamInstEnv, when checking data family instances. Data family instances may be +eta-reduced; see Note [Eta reduction for data family axioms] in TcInstDcls. + +We wish to say that + + D :: * -> * -> * + axDF1 :: D Int ~ DFInst1 + axDF2 :: D Int Bool ~ DFInst2 + +overlap. If we conclude that lists of different lengths are SurelyApart, then +it will look like these do *not* overlap, causing disaster. See Trac #9371. + +In usages of tcUnifyTys outside of family instances, we always use tcUnifyTys, +which can't tell the difference between MaybeApart and SurelyApart, so those +usages won't notice this design choice. + \begin{code} tcUnifyTy :: Type -> Type -- All tyvars are bindable -> Maybe TvSubst -- A regular one-shot (idempotent) substitution @@ -593,7 +613,7 @@ unifyList subst orig_xs orig_ys go subst [] [] = return subst go subst (x:xs) (y:ys) = do { subst' <- unify subst x y ; go subst' xs ys } - go _ _ _ = surelyApart + go subst _ _ = maybeApart subst -- See Note [Lists of different lengths are MaybeApart] --------------------------------- uVar :: TvSubstEnv -- An existing substitution to extend From git at git.haskell.org Fri Aug 8 18:59:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:59:51 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #9404 (typecheck/should_compile/T9404) (b99d684) Message-ID: <20140808185951.8D38F240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/b99d684ae2abe5637bdd2fb14009ddbc4bfb420e/ghc >--------------------------------------------------------------- commit b99d684ae2abe5637bdd2fb14009ddbc4bfb420e Author: Richard Eisenberg Date: Thu Aug 7 09:20:41 2014 -0400 Test #9404 (typecheck/should_compile/T9404) >--------------------------------------------------------------- b99d684ae2abe5637bdd2fb14009ddbc4bfb420e testsuite/tests/typecheck/should_compile/T9404.hs | 6 ++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 7 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T9404.hs b/testsuite/tests/typecheck/should_compile/T9404.hs new file mode 100644 index 0000000..4cb530a --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T9404.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE UnboxedTuples #-} + +module T9404 where + +foo _ = case seq () (# #) of (# #) -> () +foo2 _ = case () `seq` (# #) of (# #) -> () diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 07d05b8..2ca9c2f 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -420,3 +420,4 @@ test('MutRec', normal, compile, ['']) test('T8856', normal, compile, ['']) test('T9117', normal, compile, ['']) test('T9117_2', expect_broken('9117'), compile, ['']) +test('T9404', normal, compile, ['']) From git at git.haskell.org Fri Aug 8 18:59:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:59:55 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #9415 (typecheck/should_fail/T9415) (554f08e) Message-ID: <20140808185955.3579F240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/554f08e49d1b73fa07a97646b797b1cb058c02ec/ghc >--------------------------------------------------------------- commit 554f08e49d1b73fa07a97646b797b1cb058c02ec Author: Richard Eisenberg Date: Wed Aug 6 09:54:37 2014 -0400 Test #9415 (typecheck/should_fail/T9415) >--------------------------------------------------------------- 554f08e49d1b73fa07a97646b797b1cb058c02ec testsuite/tests/typecheck/should_fail/T9415.hs | 5 +++++ testsuite/tests/typecheck/should_fail/T9415.stderr | 8 ++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 3 files changed, 14 insertions(+) diff --git a/testsuite/tests/typecheck/should_fail/T9415.hs b/testsuite/tests/typecheck/should_fail/T9415.hs new file mode 100644 index 0000000..db77ff0 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9415.hs @@ -0,0 +1,5 @@ +module T9415 where + +class D a => C a where + meth :: D a => () +class C a => D a diff --git a/testsuite/tests/typecheck/should_fail/T9415.stderr b/testsuite/tests/typecheck/should_fail/T9415.stderr new file mode 100644 index 0000000..516759e --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9415.stderr @@ -0,0 +1,8 @@ + +T9415.hs:3:1: + Cycle in class declaration (via superclasses): C -> D -> C + In the class declaration for ?C? + +T9415.hs:5:1: + Cycle in class declaration (via superclasses): D -> C -> D + In the class declaration for ?D? diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index b528047..4f001f5 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -333,3 +333,4 @@ test('T8883', normal, compile_fail, ['']) test('T9196', normal, compile_fail, ['']) test('T9305', normal, compile_fail, ['']) test('T9323', normal, compile_fail, ['']) +test('T9415', normal, compile_fail, ['']) From git at git.haskell.org Fri Aug 8 18:59:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 18:59:58 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #9415. (eb8d8a6) Message-ID: <20140808185958.6E639240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/eb8d8a649aab52758d040fe9158baac6c42cb893/ghc >--------------------------------------------------------------- commit eb8d8a649aab52758d040fe9158baac6c42cb893 Author: Richard Eisenberg Date: Wed Aug 6 09:51:26 2014 -0400 Fix #9415. Abort typechecking when we detect a superclass cycle error, as ambiguity checking in the presence of superclass cycle errors can cause a loop. >--------------------------------------------------------------- eb8d8a649aab52758d040fe9158baac6c42cb893 compiler/typecheck/TcTyClsDecls.lhs | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index f09bef8..2db31e3 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1369,10 +1369,24 @@ since GADTs are not kind indexed. Validity checking is done once the mutually-recursive knot has been tied, so we can look at things freely. +Note [Abort when superclass cycle is detected] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must avoid doing the ambiguity check when there are already errors accumulated. +This is because one of the errors may be a superclass cycle, and superclass cycles +cause canonicalization to loop. Here is a representative example: + + class D a => C a where + meth :: D a => () + class C a => D a + +This fixes Trac #9415. + \begin{code} checkClassCycleErrs :: Class -> TcM () checkClassCycleErrs cls - = unless (null cls_cycles) $ mapM_ recClsErr cls_cycles + = unless (null cls_cycles) $ + do { mapM_ recClsErr cls_cycles + ; failM } -- See Note [Abort when superclass cycle is detected] where cls_cycles = calcClassCycles cls checkValidTyCl :: TyThing -> TcM () @@ -1623,6 +1637,7 @@ checkValidClass cls ; checkValidTheta (ClassSCCtxt (className cls)) theta -- Now check for cyclic superclasses + -- If there are superclass cycles, checkClassCycleErrs bails. ; checkClassCycleErrs cls -- Check the class operations From git at git.haskell.org Fri Aug 8 19:00:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 19:00:02 +0000 (UTC) Subject: [commit: ghc] wip/rae: Update manual (#9200). (ba5c950) Message-ID: <20140808190003.3B741240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/ba5c950b5dfc46e8e168fcc96653c01eea965256/ghc >--------------------------------------------------------------- commit ba5c950b5dfc46e8e168fcc96653c01eea965256 Author: Richard Eisenberg Date: Thu Aug 7 08:53:11 2014 -0400 Update manual (#9200). >--------------------------------------------------------------- ba5c950b5dfc46e8e168fcc96653c01eea965256 docs/users_guide/glasgow_exts.xml | 105 ++++++++++++++++++++++---------------- 1 file changed, 62 insertions(+), 43 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index de0d494..bfdeea4 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -6527,11 +6527,11 @@ data T m a = MkT (m a) (T Maybe (m a)) The recursive use of T forced the second argument to have kind *. However, just as in type inference, you can achieve polymorphic recursion by giving a -complete kind signature for T. The way to give -a complete kind signature for a data type is to use a GADT-style declaration with an -explicit kind signature thus: +complete kind signature for T. A complete +kind signature is present when all argument kinds and the result kind are known, without +any need for inference. For example: -data T :: (k -> *) -> k -> * where +data T (m :: k -> *) :: k -> * where MkT :: m a -> T Maybe (m a) -> T m a The complete user-supplied kind signature specifies the polymorphic kind for T, @@ -6543,26 +6543,41 @@ In particular, the recursive use of T is at kind * - -A GADT-style data type declaration, with an explicit "::" in the header. -For example: +For a datatype, every type variable must be annotated with a kind. In a +GADT-style declaration, there may also be a kind signature (with a top-level +:: in the header), but the presence or absence of this annotation +does not affect whether or not the declaration has a complete signature. data T1 :: (k -> *) -> k -> * where ... -- Yes T1 :: forall k. (k->*) -> k -> * data T2 (a :: k -> *) :: k -> * where ... -- Yes T2 :: forall k. (k->*) -> k -> * data T3 (a :: k -> *) (b :: k) :: * where ... -- Yes T3 :: forall k. (k->*) -> k -> * -data T4 a (b :: k) :: * where ... -- YES T4 :: forall k. * -> k -> * +data T4 (a :: k -> *) (b :: k) where ... -- Yes T4 :: forall k. (k->*) -> k -> * -data T5 a b where ... -- NO kind is inferred -data T4 (a :: k -> *) (b :: k) where ... -- NO kind is inferred - -It makes no difference where you put the "::" but it must be there. -You cannot give a complete kind signature using a Haskell-98-style data type declaration; -you must use GADT syntax. +data T5 a (b :: k) :: * where ... -- NO kind is inferred +data T6 a b where ... -- NO kind is inferred + + + + +For a class, every type variable must be annotated with a kind. +For a type synonym, every type variable and the result type must all be annotated +with kinds. + +type S1 (a :: k) = (a :: k) -- Yes S1 :: forall k. k -> k +type S2 (a :: k) = a -- No kind is inferred +type S3 (a :: k) = Proxy a -- No kind is inferred + +Note that in S2 and S3, the kind of the +right-hand side is rather apparent, but it is still not considered to have a complete +signature -- no inference can be done before detecting the signature. + + An open type or data family declaration always has a -complete user-specified kind signature; no "::" is required: +complete user-specified kind signature; un-annotated type variables default to +kind *. data family D1 a -- D1 :: * -> * data family D2 (a :: k) -- D2 :: forall k. k -> * @@ -6577,10 +6592,12 @@ variable annotation from the class declaration. It keeps its polymorphic kind in the associated type declaration. The variable b, however, gets defaulted to *. + + +A closed type familey has a complete signature when all of its type variables +are annotated and a return kind (with a top-level ::) is supplied. + -In a complete user-specified kind signature, any un-decorated type variable to the -left of the "::" is considered to have kind "*". -If you want kind polymorphism, specify a kind variable. @@ -6590,31 +6607,33 @@ If you want kind polymorphism, specify a kind variable. Although all open type families are considered to have a complete user-specified kind signature, we can relax this condition for closed type families, where we have equations on which to perform kind inference. GHC will -infer a kind for any type variable in a closed type family when that kind is -never used in pattern-matching. If you want a kind variable to be used in -pattern-matching, you must declare it explicitly. - - - -Here are some examples (assuming -XDataKinds is enabled): - -type family Not a where -- Not :: Bool -> Bool - Not False = True - Not True = False - -type family F a where -- ERROR: requires pattern-matching on a kind variable - F Int = Bool - F Maybe = Char - -type family G (a :: k) where -- G :: k -> * - G Int = Bool - G Maybe = Char - -type family SafeHead where -- SafeHead :: [k] -> Maybe k - SafeHead '[] = Nothing -- note that k is not required for pattern-matching - SafeHead (h ': t) = Just h - - +infer kinds for the arguments and result types of a closed type family. + +GHC supports kind-indexed type families, where the +family matches both on the kind and type. GHC will not infer +this behaviour without a complete user-supplied kind signature, as doing so would +sometimes infer non-principal types. + +For example: + +type family F1 a where + F1 True = False + F1 False = True + F1 x = x +-- F1 fails to compile: kind-indexing is not inferred + +type family F2 (a :: k) where + F2 True = False + F2 False = True + F2 x = x +-- F2 fails to compile: no complete signature + +type family F3 (a :: k) :: k where + F3 True = False + F3 False = True + F3 x = x +-- OK + From git at git.haskell.org Fri Aug 8 19:00:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 19:00:04 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #9200. (polykinds/T9200) (fcc6891) Message-ID: <20140808190004.E73D8240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/fcc68914c5fbce8a12486ce947a341b9ed01557a/ghc >--------------------------------------------------------------- commit fcc68914c5fbce8a12486ce947a341b9ed01557a Author: Richard Eisenberg Date: Sun Aug 3 21:37:45 2014 -0400 Test #9200. (polykinds/T9200) >--------------------------------------------------------------- fcc68914c5fbce8a12486ce947a341b9ed01557a testsuite/tests/polykinds/T9200.hs | 19 +++++++++++++++++++ testsuite/tests/polykinds/all.T | 1 + 2 files changed, 20 insertions(+) diff --git a/testsuite/tests/polykinds/T9200.hs b/testsuite/tests/polykinds/T9200.hs new file mode 100644 index 0000000..b74177a --- /dev/null +++ b/testsuite/tests/polykinds/T9200.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds #-} + +module T9200 where + +------ +-- test CUSK on classes + +class C (f :: k) (a :: k2) where + c_meth :: D a => () + +class C () a => D a + + +--------- +--- test CUSK on type synonyms +data T1 a b c = MkT1 (S True b c) +data T2 p q r = MkT2 (S p 5 r) +data T3 x y q = MkT3 (S x y '()) +type S (f :: k1) (g :: k2) (h :: k3) = ((T1 f g h, T2 f g h, T3 f g h) :: *) diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 22a159d..abb158b 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -106,3 +106,4 @@ test('T9222', normal, compile, ['']) test('T9264', normal, compile, ['']) test('T9263', normal, run_command, ['$MAKE -s --no-print-directory T9263']) test('T9063', normal, compile, ['']) +test('T9200', normal, compile, ['']) From git at git.haskell.org Fri Aug 8 19:00:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 19:00:07 +0000 (UTC) Subject: [commit: ghc] wip/rae: Remove NonParametricKinds (#9200) (4be9aee) Message-ID: <20140808190007.6398C240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/4be9aeea0346069b088bad9b5c962bf4ea6030b6/ghc >--------------------------------------------------------------- commit 4be9aeea0346069b088bad9b5c962bf4ea6030b6 Author: Richard Eisenberg Date: Thu Aug 7 08:37:05 2014 -0400 Remove NonParametricKinds (#9200) This commit also removes 'KindCheckingStrategy' and related gubbins, instead including the notion of a CUSK into HsDecls. >--------------------------------------------------------------- 4be9aeea0346069b088bad9b5c962bf4ea6030b6 compiler/hsSyn/HsDecls.lhs | 48 ++++++++ compiler/hsSyn/HsTypes.lhs | 6 +- compiler/typecheck/TcHsType.lhs | 229 +++--------------------------------- compiler/typecheck/TcTyClsDecls.lhs | 20 ++-- 4 files changed, 77 insertions(+), 226 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4be9aeea0346069b088bad9b5c962bf4ea6030b6 From git at git.haskell.org Fri Aug 8 19:00:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 19:00:09 +0000 (UTC) Subject: [commit: ghc] wip/rae: Change treatment of CUSKs for synonyms and families (#9200). (50a5baf) Message-ID: <20140808190009.E63FB240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/50a5bafe6b3eab22ca2028ad38bbd7fcbb78354d/ghc >--------------------------------------------------------------- commit 50a5bafe6b3eab22ca2028ad38bbd7fcbb78354d Author: Richard Eisenberg Date: Thu Aug 7 08:28:32 2014 -0400 Change treatment of CUSKs for synonyms and families (#9200). >--------------------------------------------------------------- 50a5bafe6b3eab22ca2028ad38bbd7fcbb78354d compiler/typecheck/TcHsType.lhs | 27 +++++++++++++++++++++++---- testsuite/tests/polykinds/T9200.hs | 12 +++++++++++- 2 files changed, 34 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index 14a3c17..d075cbc 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -1067,22 +1067,41 @@ kcStrategy :: TyClDecl Name -> KindCheckingStrategy kcStrategy d@(ForeignType {}) = pprPanic "kcStrategy" (ppr d) kcStrategy (FamDecl fam_decl) = kcStrategyFamDecl fam_decl -kcStrategy (SynDecl {}) = ParametricKinds +kcStrategy (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) + | all_tyvars_annotated tyvars + , rhs_annotated rhs + = FullKindSignature + | otherwise + = ParametricKinds + where + rhs_annotated (L _ ty) = case ty of + HsParTy lty -> rhs_annotated lty + HsKindSig {} -> True + _ -> False kcStrategy decl@(DataDecl {}) = kcStrategyAlgDecl decl kcStrategy decl@(ClassDecl {}) = kcStrategyAlgDecl decl kcStrategyAlgDecl :: TyClDecl Name -> KindCheckingStrategy kcStrategyAlgDecl decl - | all (isHsKindedTyVar . unLoc) (hsQTvBndrs $ tcdTyVars decl) + | all_tyvars_annotated $ tcdTyVars decl = FullKindSignature | otherwise = ParametricKinds --- if the ClosedTypeFamily has no equations, do the defaulting to *, etc. kcStrategyFamDecl :: FamilyDecl Name -> KindCheckingStrategy -kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily (_:_) }) = NonParametricKinds +kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily _ + , fdTyVars = tyvars + , fdKindSig = Just _ }) + | all (isHsKindedTyVar . unLoc) (hsQTvBndrs tyvars) + = FullKindSignature +-- if the ClosedTypeFamily has no equations, do the defaulting to *, etc. +kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily (_:_) }) = ParametricKinds kcStrategyFamDecl _ = FullKindSignature +-- | Are all the type variables given with a kind annotation? +all_tyvars_annotated :: LHsTyVarBndrs name -> Bool +all_tyvars_annotated = all (isHsKindedTyVar . unLoc) . hsQTvBndrs + mkKindSigVar :: Name -> TcM KindVar -- Use the specified name; don't clone it mkKindSigVar n diff --git a/testsuite/tests/polykinds/T9200.hs b/testsuite/tests/polykinds/T9200.hs index b74177a..ca05066 100644 --- a/testsuite/tests/polykinds/T9200.hs +++ b/testsuite/tests/polykinds/T9200.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds #-} +{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds, + TypeFamilies #-} module T9200 where @@ -17,3 +18,12 @@ data T1 a b c = MkT1 (S True b c) data T2 p q r = MkT2 (S p 5 r) data T3 x y q = MkT3 (S x y '()) type S (f :: k1) (g :: k2) (h :: k3) = ((T1 f g h, T2 f g h, T3 f g h) :: *) + + +---------- +-- test CUSK on closed type families +type family F (a :: k) :: k where + F True = False + F False = True + F x = x + From git at git.haskell.org Fri Aug 8 19:00:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 19:00:12 +0000 (UTC) Subject: [commit: ghc] wip/rae: Change definition of CUSK for data and class definitions (#9200). (8bbc557) Message-ID: <20140808190012.A3331240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/8bbc5575ef80d401195fafe9b41859a63294da34/ghc >--------------------------------------------------------------- commit 8bbc5575ef80d401195fafe9b41859a63294da34 Author: Richard Eisenberg Date: Wed Aug 6 09:56:50 2014 -0400 Change definition of CUSK for data and class definitions (#9200). Now, a CUSK is when (and only when) all type variables are annotated. This allows classes to participate in polymorphic recursion. >--------------------------------------------------------------- 8bbc5575ef80d401195fafe9b41859a63294da34 compiler/hsSyn/HsTypes.lhs | 7 ++++++- compiler/typecheck/TcHsType.lhs | 19 ++++++++++++++----- 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index 08a0eef..eada762 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -25,7 +25,7 @@ module HsTypes ( ConDeclField(..), pprConDeclFields, - mkHsQTvs, hsQTvBndrs, + mkHsQTvs, hsQTvBndrs, isHsKindedTyVar, mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs, hsTyVarName, mkHsWithBndrs, hsLKiTyVarNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, @@ -188,6 +188,11 @@ data HsTyVarBndr name (LHsKind name) -- The user-supplied kind signature deriving (Data, Typeable) +-- | Does this 'HsTyVarBndr' come with an explicit kind annotation? +isHsKindedTyVar :: HsTyVarBndr name -> Bool +isHsKindedTyVar (UserTyVar {}) = False +isHsKindedTyVar (KindedTyVar {}) = True + data HsType name = HsForAllTy HsExplicitFlag -- Renamer leaves this flag unchanged, to record the way -- the user wrote it originally, so that the printer can diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index cdeb191..14a3c17 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -1068,10 +1068,15 @@ kcStrategy d@(ForeignType {}) = pprPanic "kcStrategy" (ppr d) kcStrategy (FamDecl fam_decl) = kcStrategyFamDecl fam_decl kcStrategy (SynDecl {}) = ParametricKinds -kcStrategy (DataDecl { tcdDataDefn = HsDataDefn { dd_kindSig = m_ksig }}) - | Just _ <- m_ksig = FullKindSignature - | otherwise = ParametricKinds -kcStrategy (ClassDecl {}) = ParametricKinds +kcStrategy decl@(DataDecl {}) = kcStrategyAlgDecl decl +kcStrategy decl@(ClassDecl {}) = kcStrategyAlgDecl decl + +kcStrategyAlgDecl :: TyClDecl Name -> KindCheckingStrategy +kcStrategyAlgDecl decl + | all (isHsKindedTyVar . unLoc) (hsQTvBndrs $ tcdTyVars decl) + = FullKindSignature + | otherwise + = ParametricKinds -- if the ClosedTypeFamily has no equations, do the defaulting to *, etc. kcStrategyFamDecl :: FamilyDecl Name -> KindCheckingStrategy @@ -1259,7 +1264,11 @@ kcTyClTyVars :: Name -> LHsTyVarBndrs Name -> TcM a -> TcM a kcTyClTyVars name (HsQTvs { hsq_kvs = kvs, hsq_tvs = hs_tvs }) thing_inside = kcScopedKindVars kvs $ do { tc_kind <- kcLookupKind name - ; let (arg_ks, _res_k) = splitKindFunTysN (length hs_tvs) tc_kind + ; let (_, mono_kind) = splitForAllTys tc_kind + -- if we have a FullKindSignature, the tc_kind may already + -- be generalized. The kvs get matched up while kind-checking + -- the types in kc_tv, below + (arg_ks, _res_k) = splitKindFunTysN (length hs_tvs) mono_kind -- There should be enough arrows, because -- getInitialKinds used the tcdTyVars ; name_ks <- zipWithM kc_tv hs_tvs arg_ks From git at git.haskell.org Fri Aug 8 19:00:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 19:00:15 +0000 (UTC) Subject: [commit: ghc] wip/rae: Added more testing for #9200. (polykinds/T9200b) (24b1791) Message-ID: <20140808190015.22568240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/24b17914068fecf3921a2c1aa8a18e7b2a5a9fa7/ghc >--------------------------------------------------------------- commit 24b17914068fecf3921a2c1aa8a18e7b2a5a9fa7 Author: Richard Eisenberg Date: Thu Aug 7 08:19:22 2014 -0400 Added more testing for #9200. (polykinds/T9200b) >--------------------------------------------------------------- 24b17914068fecf3921a2c1aa8a18e7b2a5a9fa7 testsuite/tests/polykinds/T9200b.hs | 10 ++++++++++ testsuite/tests/polykinds/T9200b.stderr | 6 ++++++ testsuite/tests/polykinds/all.T | 1 + 3 files changed, 17 insertions(+) diff --git a/testsuite/tests/polykinds/T9200b.hs b/testsuite/tests/polykinds/T9200b.hs new file mode 100644 index 0000000..f780aba --- /dev/null +++ b/testsuite/tests/polykinds/T9200b.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds #-} + +module T9200b where + +--------- +--- test CUSK on closed type families +type family F (a :: k) where + F True = False + F False = True + F x = x diff --git a/testsuite/tests/polykinds/T9200b.stderr b/testsuite/tests/polykinds/T9200b.stderr new file mode 100644 index 0000000..5e8c730 --- /dev/null +++ b/testsuite/tests/polykinds/T9200b.stderr @@ -0,0 +1,6 @@ + +T9200b.hs:8:5: + The first argument of ?F? should have kind ?k?, + but ?True? has kind ?Bool? + In the type ?True? + In the type family declaration for ?F? diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index abb158b..82c1824 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -107,3 +107,4 @@ test('T9264', normal, compile, ['']) test('T9263', normal, run_command, ['$MAKE -s --no-print-directory T9263']) test('T9063', normal, compile, ['']) test('T9200', normal, compile, ['']) +test('T9200b', normal, compile_fail, ['']) From git at git.haskell.org Fri Aug 8 19:00:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 19:00:17 +0000 (UTC) Subject: [commit: ghc] wip/rae: Testsuite wibbles around #9200 (b8da952) Message-ID: <20140808190017.89F48240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/b8da9527cc8c5028548d27c4ffc6f20bfc007e41/ghc >--------------------------------------------------------------- commit b8da9527cc8c5028548d27c4ffc6f20bfc007e41 Author: Richard Eisenberg Date: Fri Aug 8 08:14:52 2014 -0400 Testsuite wibbles around #9200 >--------------------------------------------------------------- b8da9527cc8c5028548d27c4ffc6f20bfc007e41 testsuite/tests/ghci/scripts/T7939.hs | 2 +- testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot | 2 +- testsuite/tests/polykinds/T7053.hs | 2 +- testsuite/tests/polykinds/T7053.stderr | 8 -------- testsuite/tests/polykinds/all.T | 2 +- 5 files changed, 4 insertions(+), 12 deletions(-) diff --git a/testsuite/tests/ghci/scripts/T7939.hs b/testsuite/tests/ghci/scripts/T7939.hs index 93b9016..fbdf883 100644 --- a/testsuite/tests/ghci/scripts/T7939.hs +++ b/testsuite/tests/ghci/scripts/T7939.hs @@ -22,6 +22,6 @@ type family K a where K '[] = Nothing K (h ': t) = Just h -type family L (a :: k) b :: k where +type family L (a :: k) (b :: *) :: k where L Int Int = Bool L Maybe Bool = IO diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot b/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot index 0388084..503e1ad 100644 --- a/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot +++ b/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot @@ -9,5 +9,5 @@ type family Bar a where Bar Int = Bool Bar Double = Char -type family Baz (a :: k) where +type family Baz (a :: k) :: * where Baz Int = Bool diff --git a/testsuite/tests/polykinds/T7053.hs b/testsuite/tests/polykinds/T7053.hs index 4db1e0d..d45dbad 100644 --- a/testsuite/tests/polykinds/T7053.hs +++ b/testsuite/tests/polykinds/T7053.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE PolyKinds, GADTs #-} module T7053 where diff --git a/testsuite/tests/polykinds/T7053.stderr b/testsuite/tests/polykinds/T7053.stderr deleted file mode 100644 index c9ebcfe..0000000 --- a/testsuite/tests/polykinds/T7053.stderr +++ /dev/null @@ -1,8 +0,0 @@ - -T7053.hs:6:52: - Kind occurs check - The first argument of ?a? should have kind ?k0?, - but ?b? has kind ?k0 -> k1? - In the type ?TypeRep (a b)? - In the definition of data constructor ?TyApp? - In the data declaration for ?TypeRep? diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 82c1824..5b02dda 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -54,7 +54,7 @@ test('T6137', normal, compile,['']) test('T6093', normal, compile,['']) test('T6049', normal, compile,['']) test('T6129', normal, compile_fail,['']) -test('T7053', normal, compile_fail,['']) +test('T7053', normal, compile,['']) test('T7053a', normal, compile,['']) test('T7020', normal, compile,['']) test('T7022', normal, run_command, ['$MAKE -s --no-print-directory T7022']) From git at git.haskell.org Fri Aug 8 19:00:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Aug 2014 19:00:19 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Testsuite wibbles around #9200 (b8da952) Message-ID: <20140808190019.C151F240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: 2cca0c0 testsuite: add signal_exit_code function to the driver d0ee4eb Update perf number for T5642 7d52e62 Update Haddock to attoparsec-0.12.1. Adjust perf. dff0623 Implement the final change to INCOHERENT from Trac #9242 ca3fc66 Fix path in cabal file 77b065b Test #9371 (indexed-types/should_fail/T9371) 0766407 Fix Trac #9371. 6c1b709 Comments only: explain that TauTv sometimes gets sigma-types. c26714c Remove tcInfExpr (#9404) b99d684 Test #9404 (typecheck/should_compile/T9404) eb8d8a6 Fix #9415. 554f08e Test #9415 (typecheck/should_fail/T9415) fcc6891 Test #9200. (polykinds/T9200) 8bbc557 Change definition of CUSK for data and class definitions (#9200). 24b1791 Added more testing for #9200. (polykinds/T9200b) 50a5baf Change treatment of CUSKs for synonyms and families (#9200). 4be9aee Remove NonParametricKinds (#9200) ba5c950 Update manual (#9200). b8da952 Testsuite wibbles around #9200 From git at git.haskell.org Sat Aug 9 13:51:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 Aug 2014 13:51:08 +0000 (UTC) Subject: [commit: ghc] master: configure.ac: drop unused HAVE_BIN_SH (16776e9) Message-ID: <20140809135108.8B536240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/16776e9b149b0c83b9c60ad3104f1c229cef1e48/ghc >--------------------------------------------------------------- commit 16776e9b149b0c83b9c60ad3104f1c229cef1e48 Author: Sergei Trofimovich Date: Sat Aug 9 16:48:57 2014 +0300 configure.ac: drop unused HAVE_BIN_SH Summary: This hugs heritage gone away with commit f1dffa0224c9e8dcf1d3908e888e7d683485791b in 2001 Signed-off-by: Sergei Trofimovich Test Plan: tried to find HAVE_BIN_SH in internet, no success Reviewers: simonmar, austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D117 >--------------------------------------------------------------- 16776e9b149b0c83b9c60ad3104f1c229cef1e48 configure.ac | 3 --- 1 file changed, 3 deletions(-) diff --git a/configure.ac b/configure.ac index d952428..533ea29 100644 --- a/configure.ac +++ b/configure.ac @@ -678,9 +678,6 @@ chmod +x install-sh dnl ** figure out how to do a BSD-ish install AC_PROG_INSTALL -dnl If you can run configure, you certainly have /bin/sh -AC_DEFINE([HAVE_BIN_SH], [1], [Define to 1 if you have /bin/sh.]) - dnl ** how to invoke `ar' and `ranlib' FP_PROG_AR_SUPPORTS_ATFILE FP_PROG_AR_NEEDS_RANLIB From git at git.haskell.org Sat Aug 9 19:44:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 Aug 2014 19:44:42 +0000 (UTC) Subject: [commit: ghc] master: Tweak Haddock in GHC.Types (4e020b3) Message-ID: <20140809194443.029B3240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4e020b33f6d5e86d1a60761ea1c63900d501c475/ghc >--------------------------------------------------------------- commit 4e020b33f6d5e86d1a60761ea1c63900d501c475 Author: Reid Barton Date: Sat Aug 9 14:01:20 2014 -0400 Tweak Haddock in GHC.Types >--------------------------------------------------------------- 4e020b33f6d5e86d1a60761ea1c63900d501c475 libraries/ghc-prim/GHC/Types.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index f6f4233..e9f1428 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -163,7 +163,7 @@ data (~) a b = Eq# ((~#) a b) data Coercible a b = MkCoercible ((~#) a b) -- Also see Note [Kind-changing of (~) and Coercible] --- | Alias for tagToEnum#. Returns True of its parameter is 1# and False +-- | Alias for 'tagToEnum#'. Returns True if its parameter is 1# and False -- if it is 0#. {-# INLINE isTrue# #-} @@ -225,7 +225,7 @@ isTrue# x = tagToEnum# x -- you're reading this in 2023 then things went wrong). See #8326. -- --- | SPEC is used by GHC in the @SpecConstr@ pass in order to inform +-- | 'SPEC' is used by GHC in the @SpecConstr@ pass in order to inform -- the compiler when to be particularly aggressive. In particular, it -- tells GHC to specialize regardless of size or the number of -- specializations. However, not all loops fall into this category. From git at git.haskell.org Sat Aug 9 19:44:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 Aug 2014 19:44:44 +0000 (UTC) Subject: [commit: ghc] master: Tweak Haddock markup in GHC.Magic (a2ac57b) Message-ID: <20140809194445.1C395240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a2ac57b4026380467304823a225fea05dcba1abc/ghc >--------------------------------------------------------------- commit a2ac57b4026380467304823a225fea05dcba1abc Author: Reid Barton Date: Fri Aug 8 22:29:51 2014 -0400 Tweak Haddock markup in GHC.Magic >--------------------------------------------------------------- a2ac57b4026380467304823a225fea05dcba1abc libraries/ghc-prim/GHC/Magic.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/libraries/ghc-prim/GHC/Magic.hs b/libraries/ghc-prim/GHC/Magic.hs index f616343..081b838 100644 --- a/libraries/ghc-prim/GHC/Magic.hs +++ b/libraries/ghc-prim/GHC/Magic.hs @@ -19,15 +19,15 @@ module GHC.Magic ( inline, lazy ) where --- | The call '(inline f)' arranges that 'f' is inlined, regardless of --- its size. More precisely, the call '(inline f)' rewrites to the --- right-hand side of 'f'\'s definition. This allows the programmer to +-- | The call @inline f@ arranges that 'f' is inlined, regardless of +-- its size. More precisely, the call @inline f@ rewrites to the +-- right-hand side of @f@'s definition. This allows the programmer to -- control inlining from a particular call site rather than the -- definition site of the function (c.f. 'INLINE' pragmas). -- -- This inlining occurs regardless of the argument to the call or the --- size of 'f'\'s definition; it is unconditional. The main caveat is --- that 'f'\'s definition must be visible to the compiler; it is +-- size of @f@'s definition; it is unconditional. The main caveat is +-- that @f@'s definition must be visible to the compiler; it is -- therefore recommended to mark the function with an 'INLINABLE' -- pragma at its definition so that GHC guarantees to record its -- unfolding regardless of size. @@ -39,7 +39,7 @@ inline :: a -> a inline x = x -- | The 'lazy' function restrains strictness analysis a little. The --- call '(lazy e)' means the same as 'e', but 'lazy' has a magical +-- call @lazy e@ means the same as 'e', but 'lazy' has a magical -- property so far as strictness analysis is concerned: it is lazy in -- its first argument, even though its semantics is strict. After -- strictness analysis has run, calls to 'lazy' are inlined to be the From git at git.haskell.org Sat Aug 9 19:44:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 Aug 2014 19:44:47 +0000 (UTC) Subject: [commit: ghc] master: testsuite: add list of llvm_ways (44c1e3f) Message-ID: <20140809194447.7C820240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/44c1e3f4e2c06eae02dd3d53cdece97d4b07bda7/ghc >--------------------------------------------------------------- commit 44c1e3f4e2c06eae02dd3d53cdece97d4b07bda7 Author: Reid Barton Date: Sat Aug 9 14:49:33 2014 -0400 testsuite: add list of llvm_ways >--------------------------------------------------------------- 44c1e3f4e2c06eae02dd3d53cdece97d4b07bda7 testsuite/config/ghc | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/testsuite/config/ghc b/testsuite/config/ghc index f763e72..031d955 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -160,6 +160,10 @@ opt_ways = map (lambda x: x[0], \ filter(lambda x: '-O' in x[1], \ config.way_flags('dummy_name').items())) +llvm_ways = map (lambda x: x[0], \ + filter(lambda x: '-fllvm' in x[1], \ + config.way_flags('dummy_name').items())) + def get_compiler_info(): # This should really not go through the shell h = os.popen('"' + config.compiler + '" --info', 'r') From git at git.haskell.org Sat Aug 9 19:44:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 Aug 2014 19:44:49 +0000 (UTC) Subject: [commit: ghc] master: Add test case for #9013 (caa9c8aa) Message-ID: <20140809194450.42D32240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/caa9c8aa7d17af04e16070e15ba274da0ab93247/ghc >--------------------------------------------------------------- commit caa9c8aa7d17af04e16070e15ba274da0ab93247 Author: Reid Barton Date: Sat Aug 9 15:08:34 2014 -0400 Add test case for #9013 >--------------------------------------------------------------- caa9c8aa7d17af04e16070e15ba274da0ab93247 testsuite/.gitignore | 1 + testsuite/tests/codeGen/should_run/T9013.hs | 14 ++++++++++++++ .../codeGen/should_run/{T5149.stdout => T9013.stdout} | 0 testsuite/tests/codeGen/should_run/all.T | 5 +++++ 4 files changed, 20 insertions(+) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index d160143..f0f8132 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -180,6 +180,7 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/codeGen/should_run/T8103 /tests/codeGen/should_run/T8256 /tests/codeGen/should_run/T9001 +/tests/codeGen/should_run/T9013 /tests/codeGen/should_run/Word2Float64 /tests/codeGen/should_run/cgrun001 /tests/codeGen/should_run/cgrun002 diff --git a/testsuite/tests/codeGen/should_run/T9013.hs b/testsuite/tests/codeGen/should_run/T9013.hs new file mode 100644 index 0000000..35c074e --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T9013.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +import GHC.Prim +import GHC.Word + +big :: Word +big = maxBound + +carry :: Word +carry = case big of + W# w -> case plusWord2# w w of + (# hi, lo #) -> W# hi + +main = print carry diff --git a/testsuite/tests/codeGen/should_run/T5149.stdout b/testsuite/tests/codeGen/should_run/T9013.stdout similarity index 100% copy from testsuite/tests/codeGen/should_run/T5149.stdout copy to testsuite/tests/codeGen/should_run/T9013.stdout diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 2d66c42..a5983a5 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -120,3 +120,8 @@ test('CopySmallArray', normal, compile_and_run, ['']) test('CopySmallArrayStressTest', reqlib('random'), compile_and_run, ['']) test('SizeOfSmallArray', normal, compile_and_run, ['']) test('T9001', normal, compile_and_run, ['']) +test('T9013', + [ omit_ways(['ghci']), # ghci doesn't support unboxed tuples + when(arch('x86') or arch('x86_64'), + expect_broken_for(9013, list(set(opt_ways) - set(llvm_ways)))) ], + compile_and_run, ['']) From git at git.haskell.org Sat Aug 9 19:44:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 Aug 2014 19:44:52 +0000 (UTC) Subject: [commit: ghc] master: Remove obsolete "-- #hide" Haddock pragmas (8e01ca6) Message-ID: <20140809194454.E04A8240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8e01ca6872c1db9b1b2f7c0ba05d01b1c3436307/ghc >--------------------------------------------------------------- commit 8e01ca6872c1db9b1b2f7c0ba05d01b1c3436307 Author: Reid Barton Date: Sat Aug 9 15:12:42 2014 -0400 Remove obsolete "-- #hide" Haddock pragmas The modules already have the modern version {-# OPTIONS_HADDOCK hide #-}. >--------------------------------------------------------------- 8e01ca6872c1db9b1b2f7c0ba05d01b1c3436307 libraries/ghc-prim/GHC/Classes.hs | 1 - libraries/ghc-prim/GHC/IntWord64.hs | 1 - 2 files changed, 2 deletions(-) diff --git a/libraries/ghc-prim/GHC/Classes.hs b/libraries/ghc-prim/GHC/Classes.hs index f1c3fb0..5bb4cb6 100644 --- a/libraries/ghc-prim/GHC/Classes.hs +++ b/libraries/ghc-prim/GHC/Classes.hs @@ -17,7 +17,6 @@ -- ----------------------------------------------------------------------------- --- #hide module GHC.Classes where -- GHC.Magic is used in some derived instances diff --git a/libraries/ghc-prim/GHC/IntWord64.hs b/libraries/ghc-prim/GHC/IntWord64.hs index a8ca8c4..52dc08e 100644 --- a/libraries/ghc-prim/GHC/IntWord64.hs +++ b/libraries/ghc-prim/GHC/IntWord64.hs @@ -17,7 +17,6 @@ #include "MachDeps.h" --- #hide module GHC.IntWord64 ( #if WORD_SIZE_IN_BITS < 64 Int64#, Word64#, module GHC.IntWord64 From git at git.haskell.org Sun Aug 10 00:09:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 00:09:22 +0000 (UTC) Subject: [commit: ghc] master: Add a test for plusWord2#, addIntC#, subIntC# (b7b7633) Message-ID: <20140810000922.55A24240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b7b7633dfc350322756b8735a4d7c9a5c42d1721/ghc >--------------------------------------------------------------- commit b7b7633dfc350322756b8735a4d7c9a5c42d1721 Author: Reid Barton Date: Sat Aug 9 19:20:53 2014 -0400 Add a test for plusWord2#, addIntC#, subIntC# >--------------------------------------------------------------- b7b7633dfc350322756b8735a4d7c9a5c42d1721 testsuite/.gitignore | 1 + .../tests/numeric/should_run/CarryOverflow.hs | 89 ++++++++++++++++++++++ .../tests/numeric/should_run/CarryOverflow.stdout | 1 + testsuite/tests/numeric/should_run/all.T | 1 + 4 files changed, 92 insertions(+) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index f0f8132..e6e6bb2 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1009,6 +1009,7 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/numeric/should_run/3676 /tests/numeric/should_run/4381 /tests/numeric/should_run/4383 +/tests/numeric/should_run/CarryOverflow /tests/numeric/should_run/NumDecimals /tests/numeric/should_run/T3676 /tests/numeric/should_run/T4381 diff --git a/testsuite/tests/numeric/should_run/CarryOverflow.hs b/testsuite/tests/numeric/should_run/CarryOverflow.hs new file mode 100644 index 0000000..f83c1cf --- /dev/null +++ b/testsuite/tests/numeric/should_run/CarryOverflow.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +import GHC.Prim +import GHC.Word +import GHC.Exts + +import Control.Monad +import Data.Bits +import Data.List +import System.Exit + +allEqual :: Eq a => [a] -> Bool +allEqual [] = error "allEqual: nothing to compare" +allEqual (x:xs) = all (== x) xs + +testWords :: [Word] +testWords = map head . group . sort $ + concatMap (\w -> [w - 1, w, w + 1]) $ + concatMap (\w -> [w, maxBound - w]) $ + trailingOnes ++ randoms + where trailingOnes = takeWhile (/= 0) $ iterate (`div` 2) $ maxBound + -- What would a Haskell program be without some Fibonacci numbers? + randoms = take 40 $ drop 100 fibs + fibs = 0 : 1 : zipWith (+) fibs (tail fibs) + + +wordSizeInBits :: Int +wordSizeInBits = length $ takeWhile (/= 0) $ iterate (`div` 2) (maxBound :: Word) + + +-- plusWord2# (Word# carry) + +ways_plusWord2# :: [Word -> Word -> Bool] +ways_plusWord2# = [ltTest, integerTest, primopTest] + where ltTest x y = + let r = x + y in r < x + integerTest x y = + let r = fromIntegral x + fromIntegral y :: Integer + in r > fromIntegral (maxBound :: Word) + primopTest (W# x) (W# y) = case plusWord2# x y of + (# 0##, _ #) -> False + (# 1##, _ #) -> True + _ -> error "unexpected result from plusWord2#" + +-- addIntC# (Int# addition overflow) + +ways_addIntC# :: [Int -> Int -> Bool] +ways_addIntC# = [ltTest, integerTest, highBitTest, primopTest] + where ltTest x y = + let r = x + y in (y > 0 && r < x) || (y < 0 && r > x) + integerTest x y = + let r = fromIntegral x + fromIntegral y :: Integer + in r < fromIntegral (minBound :: Int) || r > fromIntegral (maxBound :: Int) + highBitTest x y = + let r = x + y in testBit ((x `xor` r) .&. (y `xor` r)) (wordSizeInBits - 1) + primopTest (I# x) (I# y) = case addIntC# x y of + (# _, 0# #) -> False + _ -> True + +-- subIntC# (Int# subtraction overflow) + +ways_subIntC# :: [Int -> Int -> Bool] +ways_subIntC# = [ltTest, integerTest, highBitTest, primopTest] + where ltTest x y = + let r = x - y in (y > 0 && r > x) || (y < 0 && r < x) + integerTest x y = + let r = fromIntegral x - fromIntegral y :: Integer + in r < fromIntegral (minBound :: Int) || r > fromIntegral (maxBound :: Int) + highBitTest x y = + let r = x - y in testBit ((x `xor` r) .&. complement (y `xor` r)) (wordSizeInBits - 1) + primopTest (I# x) (I# y) = case subIntC# x y of + (# _, 0# #) -> False + _ -> True + +runTest :: Show a => String -> [a -> a -> Bool] -> a -> a -> IO () +runTest label ways x y = do + let results = map (\f -> f x y) ways + unless (allEqual results) $ do + putStrLn $ "Failed (" ++ label ++ "): " ++ show (x,y) ++ " " ++ show results + exitWith (ExitFailure 1) + +main :: IO () +main = do + forM_ testWords $ \x -> + forM_ testWords $ \y -> do + runTest "ways_plusWord2#" ways_plusWord2# x y + runTest "ways_addIntC#" ways_addIntC# (fromIntegral x) (fromIntegral y) + runTest "ways_subIntC#" ways_subIntC# (fromIntegral x) (fromIntegral y) + putStrLn "Passed" diff --git a/testsuite/tests/numeric/should_run/CarryOverflow.stdout b/testsuite/tests/numeric/should_run/CarryOverflow.stdout new file mode 100644 index 0000000..863339f --- /dev/null +++ b/testsuite/tests/numeric/should_run/CarryOverflow.stdout @@ -0,0 +1 @@ +Passed diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index 3953fe6..72c8e6a 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -62,3 +62,4 @@ test('T7014', test('T7233', normal, compile_and_run, ['']) test('NumDecimals', normal, compile_and_run, ['']) test('T8726', normal, compile_and_run, ['']) +test('CarryOverflow', omit_ways(['ghci']), compile_and_run, ['']) From git at git.haskell.org Sun Aug 10 00:09:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 00:09:24 +0000 (UTC) Subject: [commit: ghc] master: Clarify documentation of addIntC#, subIntC# (e83e873) Message-ID: <20140810000924.B00DF240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e83e873dabb5c2b9280782a4ae3a6fab528c5214/ghc >--------------------------------------------------------------- commit e83e873dabb5c2b9280782a4ae3a6fab528c5214 Author: Reid Barton Date: Sat Aug 9 19:24:12 2014 -0400 Clarify documentation of addIntC#, subIntC# >--------------------------------------------------------------- e83e873dabb5c2b9280782a4ae3a6fab528c5214 compiler/prelude/primops.txt.pp | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 19cd812..0c33233 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -247,13 +247,19 @@ primop NotIOp "notI#" Monadic Int# -> Int# primop IntNegOp "negateInt#" Monadic Int# -> Int# primop IntAddCOp "addIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) - {Add with carry. First member of result is (wrapped) sum; - second member is 0 iff no overflow occured.} + {Add signed integers reporting overflow. + First member of result is the sum truncated to an {\tt Int#}; + second member is zero if the true sum fits in an {\tt Int#}, + nonzero if overflow occurred (the sum is either too large + or too small to fit in an {\tt Int#}).} with code_size = 2 primop IntSubCOp "subIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) - {Subtract with carry. First member of result is (wrapped) difference; - second member is 0 iff no overflow occured.} + {Subtract signed integers reporting overflow. + First member of result is the difference truncated to an {\tt Int#}; + second member is zero if the true difference fits in an {\tt Int#}, + nonzero if overflow occurred (the difference is either too large + or too small to fit in an {\tt Int#}).} with code_size = 2 primop IntGtOp ">#" Compare Int# -> Int# -> Int# From git at git.haskell.org Sun Aug 10 19:21:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 19:21:18 +0000 (UTC) Subject: [commit: ghc] master: systools info: fix warning about C compiler (message said about linker) (3260467) Message-ID: <20140810192118.F115B240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/326046739801a380c5457ef4c87bce8fb95497ba/ghc >--------------------------------------------------------------- commit 326046739801a380c5457ef4c87bce8fb95497ba Author: Sergei Trofimovich Date: Sun Aug 10 22:12:28 2014 +0300 systools info: fix warning about C compiler (message said about linker) Summary: Signed-off-by: Sergei Trofimovich Test Plan: build-tested Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D132 >--------------------------------------------------------------- 326046739801a380c5457ef4c87bce8fb95497ba compiler/main/SysTools.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 1c1c52c..72fa19b 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -809,10 +809,10 @@ getCompilerInfo' dflags = do ) (\err -> do debugTraceMsg dflags 2 - (text "Error (figuring out compiler information):" <+> + (text "Error (figuring out C compiler information):" <+> text (show err)) errorMsg dflags $ hang (text "Warning:") 9 $ - text "Couldn't figure out linker information!" $$ + text "Couldn't figure out C compiler information!" $$ text "Make sure you're using GNU gcc, or clang" return UnknownCC) return info From git at git.haskell.org Sun Aug 10 19:23:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 19:23:03 +0000 (UTC) Subject: [commit: ghc] master: Tweak linting rules. (ba9277c) Message-ID: <20140810192303.84656240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ba9277c72ab39bbd85ef52524151bf27a6c106f8/ghc >--------------------------------------------------------------- commit ba9277c72ab39bbd85ef52524151bf27a6c106f8 Author: Edward Z. Yang Date: Sat Aug 9 02:05:53 2014 +0100 Tweak linting rules. Summary: - Removed the default text rule that was applied to all files; it produced way too many spurious warnings. For now, text lint is applied to C, Haskell and Shell. Add more if you care. - Makefiles and shell scripts had their max line length bumped a healthy amount. A pile of files still fail to lint, so these might even still be too aggressive. Signed-off-by: Edward Z. Yang Test Plan: none Reviewers: hvr, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D131 >--------------------------------------------------------------- ba9277c72ab39bbd85ef52524151bf27a6c106f8 .arclint | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/.arclint b/.arclint index bb16f08..f798015 100644 --- a/.arclint +++ b/.arclint @@ -12,24 +12,34 @@ "nolint": { "type": "nolint" }, - "text": { + "haskell": { "type": "text", - "exclude": [ "(\\.xml)", "(Makefile)", "(\\.mk)" ], + "include": ["(\\.(l?hs(-boot)?|x|y\\.pp)(\\.in)?$)"], "severity": { "5": "disabled" } }, + "c": { + "type": "text", + "include": ["(\\.(c|h)(\\.in)?$)"] + }, "text-xml": { "type": "text", - "include": "(\\.xml)", + "include": "(\\.xml$)", "severity": { "5": "disabled", "3": "disabled" } }, + "shell": { + "type": "text", + "include": [ "(\\.sh$)" ], + "text.max-line-length": 200 + }, "makefiles": { "type": "text", - "include": [ "(Makefile)", "(\\.mk)" ], + "include": [ "(Makefile$)", "(\\.mk$)" ], + "text.max-line-length": 200, "severity": { "2": "disabled" } From git at git.haskell.org Sun Aug 10 20:20:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 20:20:07 +0000 (UTC) Subject: [commit: ghc] master: fix T4201 to avoid GNU grep specific -B option by usage of pure POSIX tools (02be4ff) Message-ID: <20140810202008.36D17240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/02be4ff783f192268904d85131c5a748097fbbc9/ghc >--------------------------------------------------------------- commit 02be4ff783f192268904d85131c5a748097fbbc9 Author: Karel Gardas Date: Sun Aug 10 22:19:31 2014 +0200 fix T4201 to avoid GNU grep specific -B option by usage of pure POSIX tools Test Plan: validated on Linux and tested on Solaris Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D135 >--------------------------------------------------------------- 02be4ff783f192268904d85131c5a748097fbbc9 testsuite/tests/simplCore/should_compile/Makefile | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile index 605d3a5..d615a5e 100644 --- a/testsuite/tests/simplCore/should_compile/Makefile +++ b/testsuite/tests/simplCore/should_compile/Makefile @@ -35,9 +35,12 @@ T4306: '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4306.hi | grep 'wupd ::' T4201: - $(RM) -f T4201.hi T4201.o + $(RM) -f T4201.hi T4201.o T4201.list '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4201.hs - '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4201.hi | grep -B2 'Sym' + '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4201.hi > T4201.list + # poor man idea about how to replace GNU grep -B2 "Sym" invocation with pure POSIX tools + for i in `grep -n "Sym" T4201.list |cut -d ':' -f -1`; do head -$$i T4201.list | tail -3 ; done + $(RM) -f T4201.list # This one looped as a result of bogus specialisation T4903: From git at git.haskell.org Sun Aug 10 20:33:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 20:33:36 +0000 (UTC) Subject: [commit: ghc] master: fix T4981-V3 and T9208 tests for no newline at end of file warning (2396940) Message-ID: <20140810203336.A78C4240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/239694084ad21fe926495af520bebd5002f6daea/ghc >--------------------------------------------------------------- commit 239694084ad21fe926495af520bebd5002f6daea Author: Karel Gardas Date: Sun Aug 10 22:28:05 2014 +0200 fix T4981-V3 and T9208 tests for no newline at end of file warning Test Plan: validated on Linux and tested on Solaris Reviewers: ezyang, austin Reviewed By: ezyang, austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D134 >--------------------------------------------------------------- 239694084ad21fe926495af520bebd5002f6daea testsuite/tests/indexed-types/should_compile/T4981-V3.hs | 1 + testsuite/tests/stranal/should_compile/T9208.hs | 0 2 files changed, 1 insertion(+) diff --git a/testsuite/tests/indexed-types/should_compile/T4981-V3.hs b/testsuite/tests/indexed-types/should_compile/T4981-V3.hs index fe810f2..242e752 100644 --- a/testsuite/tests/indexed-types/should_compile/T4981-V3.hs +++ b/testsuite/tests/indexed-types/should_compile/T4981-V3.hs @@ -42,3 +42,4 @@ resolveConflicts :: q -> PrimOf q (w) PrimOf (OnPrim p) ~ PrimOf (OnPrim p) -} + From git at git.haskell.org Sun Aug 10 20:33:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 20:33:39 +0000 (UTC) Subject: [commit: ghc] master: fix T4981-V3 to avoid DOS line endings (ba3650c) Message-ID: <20140810203339.C63B2240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ba3650c8d4980a59c35203ed129a5bbed61e6fa1/ghc >--------------------------------------------------------------- commit ba3650c8d4980a59c35203ed129a5bbed61e6fa1 Author: Karel Gardas Date: Sun Aug 10 22:32:52 2014 +0200 fix T4981-V3 to avoid DOS line endings >--------------------------------------------------------------- ba3650c8d4980a59c35203ed129a5bbed61e6fa1 testsuite/tests/indexed-types/should_compile/T4981-V3.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/testsuite/tests/indexed-types/should_compile/T4981-V3.hs b/testsuite/tests/indexed-types/should_compile/T4981-V3.hs index 242e752..e6bcd47 100644 --- a/testsuite/tests/indexed-types/should_compile/T4981-V3.hs +++ b/testsuite/tests/indexed-types/should_compile/T4981-V3.hs @@ -42,4 +42,3 @@ resolveConflicts :: q -> PrimOf q (w) PrimOf (OnPrim p) ~ PrimOf (OnPrim p) -} - From git at git.haskell.org Sun Aug 10 20:39:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 20:39:47 +0000 (UTC) Subject: [commit: ghc] master: Don't build or test dph by default (bb00308) Message-ID: <20140810203947.BC7D7240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bb003086599c2ac166cfb3aa710480713adb5a2f/ghc >--------------------------------------------------------------- commit bb003086599c2ac166cfb3aa710480713adb5a2f Author: Austin Seipp Date: Sun Aug 10 14:10:22 2014 -0500 Don't build or test dph by default Signed-off-by: Austin Seipp >--------------------------------------------------------------- bb003086599c2ac166cfb3aa710480713adb5a2f mk/build.mk.sample | 4 ++-- mk/config.mk.in | 2 +- validate | 23 ++++++++++------------- 3 files changed, 13 insertions(+), 16 deletions(-) diff --git a/mk/build.mk.sample b/mk/build.mk.sample index a323884..4189882 100644 --- a/mk/build.mk.sample +++ b/mk/build.mk.sample @@ -66,8 +66,8 @@ V = 1 # working on stage 2 and want to freeze stage 1 and the libraries for # a while. -# Uncomment the following line to disable building DPH -#BUILD_DPH=NO +# Uncomment the following line to enable building DPH +#BUILD_DPH=YES GhcLibWays = $(if $(filter $(DYNAMIC_GHC_PROGRAMS),YES),v dyn,v) diff --git a/mk/config.mk.in b/mk/config.mk.in index 7a73d46..d26684e 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -791,7 +791,7 @@ HSCOLOUR_SRCS = YES endif # Build DPH? -BUILD_DPH = YES +BUILD_DPH = NO ################################################################################ # diff --git a/validate b/validate index cabb86c..3e1fde6 100755 --- a/validate +++ b/validate @@ -22,10 +22,7 @@ Flags: --fast Omit dyn way, omit binary distribution --slow Build stage2 with -DDEBUG. 2008-07-01: 14% slower than the default. - --no-dph: Skip building libraries/dph and running associated tests. - In --slow mode, these tests can take a substantial amount - of time, and on some platforms with broken linkers, we - don't want to try compiling it. + --dph: Also build libraries/dph and run associated tests. --help shows this usage help. Set environment variable 'CPUS' to number of cores, to exploit @@ -40,7 +37,7 @@ no_clean=0 testsuite_only=0 hpc=NO speed=NORMAL -skip_dph=0 +use_dph=0 while [ $# -gt 0 ] do @@ -63,8 +60,8 @@ do --normal) speed=NORMAL ;; - --no-dph) - skip_dph=1 + --dph) + use_dph=1 ;; --help) show_help @@ -122,10 +119,10 @@ if [ $no_clean -eq 0 ]; then INSTDIR=`cygpath -m "$INSTDIR"` fi - if [ $skip_dph -eq 1 ]; then - /usr/bin/perl -w boot --validate - else + if [ $use_dph -eq 1 ]; then /usr/bin/perl -w boot --validate --required-tag=dph + else + /usr/bin/perl -w boot --validate fi ./configure --prefix="$INSTDIR" $config_args fi @@ -136,10 +133,10 @@ echo "Validating=YES" > mk/are-validating.mk echo "ValidateSpeed=$speed" >> mk/are-validating.mk echo "ValidateHpc=$hpc" >> mk/are-validating.mk -if [ $skip_dph -eq 1 ]; then - echo "BUILD_DPH=NO" >> mk/are-validating.mk -else +if [ $use_dph -eq 1 ]; then echo "BUILD_DPH=YES" >> mk/are-validating.mk +else + echo "BUILD_DPH=NO" >> mk/are-validating.mk fi $make -j$threads From git at git.haskell.org Sun Aug 10 20:42:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 20:42:37 +0000 (UTC) Subject: [commit: ghc] master: change topHandler02/topHandler03 tests to use signal_exit_code function (238fd05) Message-ID: <20140810204237.291D6240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/238fd05ee514bf3308be17aebb0ab8e805349b3e/ghc >--------------------------------------------------------------- commit 238fd05ee514bf3308be17aebb0ab8e805349b3e Author: Karel Gardas Date: Sun Aug 10 22:40:37 2014 +0200 change topHandler02/topHandler03 tests to use signal_exit_code function Test Plan: validate Reviewers: simonmar, austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D127 >--------------------------------------------------------------- 238fd05ee514bf3308be17aebb0ab8e805349b3e libraries/base/tests/all.T | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index aa752c2..8b18d63 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -146,14 +146,13 @@ test('topHandler02', # ignore the stdout here, we only care about the exit code (which itself # is messed up because of the shell, using 128+sig encoding) ignore_output, - exit_code(130) # actually signal 2 SIGINT + signal_exit_code(2) ], compile_and_run, ['']) test('topHandler03', [when(opsys('mingw32'), skip), # As above, shells, grrr. ignore_output, - when(opsys('solaris2'), exit_code(15)), # Solaris signals 15 correctly - when(not opsys('solaris2'), exit_code(143)) # actually signal 15 SIGTERM + signal_exit_code(15) ], compile_and_run, ['']) From git at git.haskell.org Sun Aug 10 20:51:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 20:51:06 +0000 (UTC) Subject: [commit: ghc] master: rts/Printer.c: drop zcode mangling/demangling support in C code (7a754a9) Message-ID: <20140810205106.A0C7A240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a754a943a4bfd55c889a780cef2198ded1d2e37/ghc >--------------------------------------------------------------- commit 7a754a943a4bfd55c889a780cef2198ded1d2e37 Author: Sergei Trofimovich Date: Sun Aug 10 15:47:51 2014 -0500 rts/Printer.c: drop zcode mangling/demangling support in C code Summary: GHC's RTS contains ancient Zdecode code which changed format a bit. It's easier to drop broken part and show original names. The patch changes output for './hello +RTS -Da' (apply) from such gibberish: stg_ap_v_ret... PAP/1(0x92922a, &i!_-&i!_:<.s_r=Z) stg_ap_0_ret... base:GHC.MVar.MVar(0x7fd3d1f040f8) stg_ap_v_ret... THUNK(&i!_-&i!_i!f.Z) stg_ap_v_ret... PAP/1(0x92c1f3, EO_:<.s_r=Z, EP_:<.s_r=Z) stg_ap_0_ret... ghc-prim:GHC.Tuple.(,)(0x7fd3d1f04209, 0x7fd3d1f041fa) stg_ap_0_ret... ghc-prim:GHC.Types.:(0x7fd3d1f04301, 0x7fd3d1f042ea) stg_ap_0_ret... THUNK(3F0_i!f.Z, 0x9152a1) stg_ap_0_ret... FUN/3(&s=_GHCziIOziFD_z/fB_ff=r=/IOFD14_i!f.Z) stg_ap_ppv_ret... FUN/3(&s=_GHCziIOziFD_z/fB_ff=r=/IOFD14_i!f.Z) stg_ap_0_ret... FUN/2(&s=_GHCziIOziFD_z/fIOD=vi:=FD15_i!f.Z) stg_ap_pv_ret... FUN/2(&s=_GHCziIOziFD_z/fIOD=vi:=FD15_i!f.Z) stg_ap_0_ret... base:GHC.IO.Handle.Types.FileHandle(5'A_:<.s_r=Z, 0x7fd3d1f04ef0) stg_ap_v_ret... THUNK(*>_&+_2__+/_i!f.Z, 0x7fd3d1f0602a, 0x7fd3d1f04f10) stg_ap_v_ret... PAP/1(0x7fd3d1f0602a, 0x7fd3d1f04f10) to something more readable: stg_ap_v_ret... PAP/1(0x92922a, [0x90b710]) stg_ap_0_ret... base:GHC.MVar.MVar(0x7f1e256040f8) stg_ap_v_ret... THUNK([0x4046c8]) stg_ap_v_ret... PAP/1(0x92c1f3, [0x90b6f0], [0x90b6d0]) stg_ap_0_ret... ghc-prim:GHC.Tuple.(,)(0x7f1e25604209, 0x7f1e256041fa) stg_ap_0_ret... ghc-prim:GHC.Types.:(0x7f1e25604301, 0x7f1e256042ea) stg_ap_0_ret... THUNK([0x434f70], 0x9152a1) stg_ap_0_ret... FUN/3([0x5f5198]) stg_ap_ppv_ret... FUN/3([0x5f5198]) stg_ap_0_ret... FUN/2([0x5f7c60]) stg_ap_pv_ret... FUN/2([0x5f7c60]) stg_ap_0_ret... base:GHC.IO.Handle.Types.FileHandle([0x91a920], 0x7f1e25604ef0) stg_ap_v_ret... THUNK([0x6b1c60], 0x7f1e2560602a, 0x7f1e25604f10) stg_ap_v_ret... PAP/1(0x7f1e2560602a, 0x7f1e25604f10) First observed on '+RTS -Di' (interpreter) on unregisterised builds. Signed-off-by: Sergei Trofimovich Test Plan: built 'hello world' with -debug in moth modes and ran under '+RTS -Da' Reviewers: simonmar, austin, ezyang Reviewed By: austin, ezyang Subscribers: phaskell, rwbarton, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D116 >--------------------------------------------------------------- 7a754a943a4bfd55c889a780cef2198ded1d2e37 rts/Printer.c | 149 +--------------------------------------------------------- 1 file changed, 2 insertions(+), 147 deletions(-) diff --git a/rts/Printer.c b/rts/Printer.c index 6f37831..459db42 100644 --- a/rts/Printer.c +++ b/rts/Printer.c @@ -33,10 +33,7 @@ static void insert ( StgWord value, const char *name ); #endif #if 0 /* unused but might be useful sometime */ static rtsBool lookup_name ( char *name, StgWord *result ); -static void enZcode ( char *in, char *out ); #endif -static char unZcode ( char ch ); -static void printZcoded ( const char *raw ); /* -------------------------------------------------------------------------- * Printer @@ -47,7 +44,8 @@ void printPtr( StgPtr p ) const char *raw; raw = lookupGHCName(p); if (raw != NULL) { - printZcoded(raw); + debugBelch("<%s>", raw); + debugBelch("[%p]", p); } else { debugBelch("%p", p); } @@ -646,134 +644,6 @@ static rtsBool lookup_name( char *name, StgWord *result ) } #endif -/* Code from somewhere inside GHC (circa 1994) - * * Z-escapes: - * "std"++xs -> "Zstd"++xs - * char_to_c 'Z' = "ZZ" - * char_to_c '&' = "Za" - * char_to_c '|' = "Zb" - * char_to_c ':' = "Zc" - * char_to_c '/' = "Zd" - * char_to_c '=' = "Ze" - * char_to_c '>' = "Zg" - * char_to_c '#' = "Zh" - * char_to_c '<' = "Zl" - * char_to_c '-' = "Zm" - * char_to_c '!' = "Zn" - * char_to_c '.' = "Zo" - * char_to_c '+' = "Zp" - * char_to_c '\'' = "Zq" - * char_to_c '*' = "Zt" - * char_to_c '_' = "Zu" - * char_to_c c = "Z" ++ show (ord c) - */ -static char unZcode( char ch ) -{ - switch (ch) { - case 'a' : return ('&'); - case 'b' : return ('|'); - case 'c' : return (':'); - case 'd' : return ('/'); - case 'e' : return ('='); - case 'g' : return ('>'); - case 'h' : return ('#'); - case 'l' : return ('<'); - case 'm' : return ('-'); - case 'n' : return ('!'); - case 'o' : return ('.'); - case 'p' : return ('+'); - case 'q' : return ('\''); - case 't' : return ('*'); - case 'u' : return ('_'); - case 'Z' : - case '\0' : return ('Z'); - default : return (ch); - } -} - -#if 0 -/* Precondition: out big enough to handle output (about twice length of in) */ -static void enZcode( char *in, char *out ) -{ - int i, j; - - j = 0; - out[ j++ ] = '_'; - for( i = 0; in[i] != '\0'; ++i ) { - switch (in[i]) { - case 'Z' : - out[j++] = 'Z'; - out[j++] = 'Z'; - break; - case '&' : - out[j++] = 'Z'; - out[j++] = 'a'; - break; - case '|' : - out[j++] = 'Z'; - out[j++] = 'b'; - break; - case ':' : - out[j++] = 'Z'; - out[j++] = 'c'; - break; - case '/' : - out[j++] = 'Z'; - out[j++] = 'd'; - break; - case '=' : - out[j++] = 'Z'; - out[j++] = 'e'; - break; - case '>' : - out[j++] = 'Z'; - out[j++] = 'g'; - break; - case '#' : - out[j++] = 'Z'; - out[j++] = 'h'; - break; - case '<' : - out[j++] = 'Z'; - out[j++] = 'l'; - break; - case '-' : - out[j++] = 'Z'; - out[j++] = 'm'; - break; - case '!' : - out[j++] = 'Z'; - out[j++] = 'n'; - break; - case '.' : - out[j++] = 'Z'; - out[j++] = 'o'; - break; - case '+' : - out[j++] = 'Z'; - out[j++] = 'p'; - break; - case '\'' : - out[j++] = 'Z'; - out[j++] = 'q'; - break; - case '*' : - out[j++] = 'Z'; - out[j++] = 't'; - break; - case '_' : - out[j++] = 'Z'; - out[j++] = 'u'; - break; - default : - out[j++] = in[i]; - break; - } - } - out[j] = '\0'; -} -#endif - const char *lookupGHCName( void *addr ) { nat i; @@ -786,21 +656,6 @@ const char *lookupGHCName( void *addr ) } } -static void printZcoded( const char *raw ) -{ - nat j = 0; - - while ( raw[j] != '\0' ) { - if (raw[j] == 'Z') { - debugBelch("%c", unZcode(raw[j+1])); - j = j + 2; - } else { - debugBelch("%c", unZcode(raw[j+1])); - j = j + 1; - } - } -} - /* -------------------------------------------------------------------------- * Symbol table loading * ------------------------------------------------------------------------*/ From git at git.haskell.org Sun Aug 10 20:51:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 20:51:09 +0000 (UTC) Subject: [commit: ghc] master: rts: Remove trailing whitespace and tabs from Printer.c (b02fa3b) Message-ID: <20140810205114.C6FDD240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b02fa3b94133f35ca83b6abf0cc73733ea8b8786/ghc >--------------------------------------------------------------- commit b02fa3b94133f35ca83b6abf0cc73733ea8b8786 Author: Austin Seipp Date: Sun Aug 10 15:50:42 2014 -0500 rts: Remove trailing whitespace and tabs from Printer.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- b02fa3b94133f35ca83b6abf0cc73733ea8b8786 rts/Printer.c | 298 +++++++++++++++++++++++++++++----------------------------- 1 file changed, 149 insertions(+), 149 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b02fa3b94133f35ca83b6abf0cc73733ea8b8786 From git at git.haskell.org Sun Aug 10 20:53:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 20:53:40 +0000 (UTC) Subject: [commit: ghc] master: fix darwin threaded static linking by removing -lpthread option #9189 (8d90ffa) Message-ID: <20140810205341.3BF37240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8d90ffae3a3c0d7c9ac8800ae91887aeaa9917d3/ghc >--------------------------------------------------------------- commit 8d90ffae3a3c0d7c9ac8800ae91887aeaa9917d3 Author: Bob Ippolito Date: Sun Aug 10 15:53:12 2014 -0500 fix darwin threaded static linking by removing -lpthread option #9189 Summary: Signed-off-by: Bob Ippolito Test Plan: See repro instructions in trac #9189 Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D120 GHC Trac Issues: #9189 >--------------------------------------------------------------- 8d90ffae3a3c0d7c9ac8800ae91887aeaa9917d3 compiler/main/DriverPipeline.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index f7b5eb8..183f435 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1872,7 +1872,7 @@ linkBinary' staticLink dflags o_files dep_packages = do let os = platformOS (targetPlatform dflags) in if os == OSOsf3 then ["-lpthread", "-lexc"] else if os `elem` [OSMinGW32, OSFreeBSD, OSOpenBSD, - OSNetBSD, OSHaiku, OSQNXNTO, OSiOS] + OSNetBSD, OSHaiku, OSQNXNTO, OSiOS, OSDarwin] then [] else ["-lpthread"] | otherwise = [] From git at git.haskell.org Sun Aug 10 20:54:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 20:54:31 +0000 (UTC) Subject: [commit: ghc] master: Improve seq documentation; part of trac issue #9390 (cbfa107) Message-ID: <20140810205432.B6601240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cbfa107604f4cbfaf02bd633c1faa6ecb90c6dd7/ghc >--------------------------------------------------------------- commit cbfa107604f4cbfaf02bd633c1faa6ecb90c6dd7 Author: Michael Snoyman Date: Sun Aug 10 15:54:01 2014 -0500 Improve seq documentation; part of trac issue #9390 Summary: Signed-off-by: Michael Snoyman Test Plan: Review documentation change Reviewers: simonpj, austin Reviewed By: austin Subscribers: phaskell, hvr, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D136 GHC Trac Issues: #9390 >--------------------------------------------------------------- cbfa107604f4cbfaf02bd633c1faa6ecb90c6dd7 libraries/base/Prelude.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/libraries/base/Prelude.hs b/libraries/base/Prelude.hs index 6be7846..9b1119e 100644 --- a/libraries/base/Prelude.hs +++ b/libraries/base/Prelude.hs @@ -163,6 +163,13 @@ f $! x = let !vx = x in f vx -- see #2273 -- | The value of @'seq' a b@ is bottom if @a@ is bottom, and otherwise -- equal to @b at . 'seq' is usually introduced to improve performance by -- avoiding unneeded laziness. +-- +-- A note on evaluation order: the expression @seq a b@ does /not/ guarantee +-- that @a@ will be evaluated before @b at . The only guarantee given by @seq@ is +-- that the both @a@ and @b@ will be evaluated before @seq@ returns a value. In +-- particular, this means that @b@ may be evaluated before @a at . If you need to +-- guarantee a specific order of evaluation, you must use the function @pseq@ +-- from the parallel package. seq :: a -> b -> b seq _ y = y #endif From git at git.haskell.org Sun Aug 10 21:38:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 21:38:31 +0000 (UTC) Subject: [commit: ghc] master: Eliminate some code duplication in x86 backend (genCCall32/64) (c80d238) Message-ID: <20140810213832.01FBF240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c80d238162d97e0cab69510af8602c73bfaf6ef3/ghc >--------------------------------------------------------------- commit c80d238162d97e0cab69510af8602c73bfaf6ef3 Author: Reid Barton Date: Sun Aug 10 17:16:42 2014 -0400 Eliminate some code duplication in x86 backend (genCCall32/64) Summary: No functional changes except in panic messages. These functions were identical except for - x87 operations in genCCall32 - the fallback to genCCall32'/64' - "32" vs "64" in panic messages (one case was wrong!) - minor syntactic or otherwise non-functional differences. Test Plan: Ran "validate --no-dph --slow" before and after the change. Only differences were two tests that failed before the change but not after, further investigation revealed that those tests are in fact erratic. Reviewers: simonmar, austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D139 >--------------------------------------------------------------- c80d238162d97e0cab69510af8602c73bfaf6ef3 compiler/nativeGen/X86/CodeGen.hs | 114 +++++--------------------------------- 1 file changed, 13 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 c80d238162d97e0cab69510af8602c73bfaf6ef3 From git at git.haskell.org Sun Aug 10 22:25:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Aug 2014 22:25:37 +0000 (UTC) Subject: [commit: ghc] master: Make IntAddCOp, IntSubCOp into GenericOps (5f5d662) Message-ID: <20140810222537.0E4FA240EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5f5d66298fbb6e50694d189767e69afa10e0dda0/ghc >--------------------------------------------------------------- commit 5f5d66298fbb6e50694d189767e69afa10e0dda0 Author: Reid Barton Date: Sun Aug 10 17:39:51 2014 -0400 Make IntAddCOp, IntSubCOp into GenericOps ... in preparation for backend-specific implementations. No functional changes in this commit (except in panic messages for ill-formed Cmm). Differential Revision: https://phabricator.haskell.org/D138 >--------------------------------------------------------------- 5f5d66298fbb6e50694d189767e69afa10e0dda0 compiler/codeGen/StgCmmPrim.hs | 122 ++++++++++++++++++++++------------------- 1 file changed, 65 insertions(+), 57 deletions(-) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index e4c682b..0d67cdb 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -250,63 +250,6 @@ emitPrimOp :: DynFlags -- First we handle various awkward cases specially. The remaining -- easy cases are then handled by translateOp, defined below. -emitPrimOp dflags [res_r,res_c] IntAddCOp [aa,bb] -{- - With some bit-twiddling, we can define int{Add,Sub}Czh portably in - C, and without needing any comparisons. This may not be the - fastest way to do it - if you have better code, please send it! --SDM - - Return : r = a + b, c = 0 if no overflow, 1 on overflow. - - We currently don't make use of the r value if c is != 0 (i.e. - overflow), we just convert to big integers and try again. This - could be improved by making r and c the correct values for - plugging into a new J#. - - { r = ((I_)(a)) + ((I_)(b)); \ - c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \ - >> (BITS_IN (I_) - 1); \ - } - Wading through the mass of bracketry, it seems to reduce to: - c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1) - --} - = emit $ catAGraphs [ - mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordAdd dflags) [aa,bb]), - mkAssign (CmmLocal res_c) $ - CmmMachOp (mo_wordUShr dflags) [ - CmmMachOp (mo_wordAnd dflags) [ - CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]], - CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)] - ], - mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1) - ] - ] - - -emitPrimOp dflags [res_r,res_c] IntSubCOp [aa,bb] -{- Similarly: - #define subIntCzh(r,c,a,b) \ - { r = ((I_)(a)) - ((I_)(b)); \ - c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \ - >> (BITS_IN (I_) - 1); \ - } - - c = ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1) --} - = emit $ catAGraphs [ - mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordSub dflags) [aa,bb]), - mkAssign (CmmLocal res_c) $ - CmmMachOp (mo_wordUShr dflags) [ - CmmMachOp (mo_wordAnd dflags) [ - CmmMachOp (mo_wordXor dflags) [aa,bb], - CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)] - ], - mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1) - ] - ] - - emitPrimOp _ [res] ParOp [arg] = -- for now, just implement this in a C function @@ -828,6 +771,10 @@ callishPrimOpSupported dflags op WordAdd2Op | ncg && x86ish -> Left (MO_Add2 (wordWidth dflags)) | otherwise -> Right genericWordAdd2Op + IntAddCOp -> Right genericIntAddCOp + + IntSubCOp -> Right genericIntSubCOp + WordMul2Op | ncg && x86ish -> Left (MO_U_Mul2 (wordWidth dflags)) | otherwise -> Right genericWordMul2Op @@ -933,6 +880,67 @@ genericWordAdd2Op [res_h, res_l] [arg_x, arg_y] (bottomHalf (CmmReg (CmmLocal r1))))] genericWordAdd2Op _ _ = panic "genericWordAdd2Op" +genericIntAddCOp :: GenericOp +genericIntAddCOp [res_r, res_c] [aa, bb] +{- + With some bit-twiddling, we can define int{Add,Sub}Czh portably in + C, and without needing any comparisons. This may not be the + fastest way to do it - if you have better code, please send it! --SDM + + Return : r = a + b, c = 0 if no overflow, 1 on overflow. + + We currently don't make use of the r value if c is != 0 (i.e. + overflow), we just convert to big integers and try again. This + could be improved by making r and c the correct values for + plugging into a new J#. + + { r = ((I_)(a)) + ((I_)(b)); \ + c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \ + >> (BITS_IN (I_) - 1); \ + } + Wading through the mass of bracketry, it seems to reduce to: + c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1) + +-} + = do dflags <- getDynFlags + emit $ catAGraphs [ + mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordAdd dflags) [aa,bb]), + mkAssign (CmmLocal res_c) $ + CmmMachOp (mo_wordUShr dflags) [ + CmmMachOp (mo_wordAnd dflags) [ + CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]], + CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)] + ], + mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1) + ] + ] +genericIntAddCOp _ _ = panic "genericIntAddCOp" + +genericIntSubCOp :: GenericOp +genericIntSubCOp [res_r, res_c] [aa, bb] +{- Similarly: + #define subIntCzh(r,c,a,b) \ + { r = ((I_)(a)) - ((I_)(b)); \ + c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \ + >> (BITS_IN (I_) - 1); \ + } + + c = ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1) +-} + = do dflags <- getDynFlags + emit $ catAGraphs [ + mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordSub dflags) [aa,bb]), + mkAssign (CmmLocal res_c) $ + CmmMachOp (mo_wordUShr dflags) [ + CmmMachOp (mo_wordAnd dflags) [ + CmmMachOp (mo_wordXor dflags) [aa,bb], + CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)] + ], + mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1) + ] + ] +genericIntSubCOp _ _ = panic "genericIntSubCOp" + genericWordMul2Op :: GenericOp genericWordMul2Op [res_h, res_l] [arg_x, arg_y] = do dflags <- getDynFlags From git at git.haskell.org Mon Aug 11 13:57:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Aug 2014 13:57:49 +0000 (UTC) Subject: [commit: ghc] master: x86: Always generate add instruction in MO_Add2 (#9013) (71bd4e3) Message-ID: <20140811135749.D58D124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/71bd4e310793b9225767b66f3aa758156816632e/ghc >--------------------------------------------------------------- commit 71bd4e310793b9225767b66f3aa758156816632e Author: Reid Barton Date: Mon Aug 11 09:33:13 2014 -0400 x86: Always generate add instruction in MO_Add2 (#9013) Test Plan: - ran validate - ran T9013 test with all ways - ran CarryOverflow test with all ways, for good measure Reviewers: austin, simonmar Reviewed By: simonmar Differential Revision: https://phabricator.haskell.org/D137 >--------------------------------------------------------------- 71bd4e310793b9225767b66f3aa758156816632e compiler/nativeGen/X86/CodeGen.hs | 5 +++-- compiler/nativeGen/X86/Instr.hs | 8 ++++++++ compiler/nativeGen/X86/Ppr.hs | 3 +++ testsuite/tests/codeGen/should_run/all.T | 5 +---- 4 files changed, 15 insertions(+), 6 deletions(-) diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index 04a1820..d6fdee1 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -1912,9 +1912,10 @@ genCCall _ is32Bit target dest_regs args = do case args of [arg_x, arg_y] -> do hCode <- getAnyReg (CmmLit (CmmInt 0 width)) - lCode <- getAnyReg (CmmMachOp (MO_Add width) [arg_x, arg_y]) let size = intSize width - reg_l = getRegisterReg platform True (CmmLocal res_l) + lCode <- anyReg =<< trivialCode width (ADD_CC size) + (Just (ADD_CC size)) arg_x arg_y + let reg_l = getRegisterReg platform True (CmmLocal res_l) reg_h = getRegisterReg platform True (CmmLocal res_h) code = hCode reg_h `appOL` lCode reg_l `snocOL` diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index 172ce93..b8b81ae 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -204,6 +204,12 @@ data Instr | DIV Size Operand -- eax := eax:edx/op, edx := eax:edx%op | IDIV Size Operand -- ditto, but signed + -- Int Arithmetic, where the effects on the condition register + -- are important. Used in specialized sequences such as MO_Add2. + -- Do not rewrite these instructions to "equivalent" ones that + -- have different effect on the condition register! (See #9013.) + | ADD_CC Size Operand Operand + -- Simple bit-twiddling. | AND Size Operand Operand | OR Size Operand Operand @@ -360,6 +366,7 @@ x86_regUsageOfInstr platform instr MUL2 _ src -> mkRU (eax:use_R src []) [eax,edx] DIV _ op -> mkRU (eax:edx:use_R op []) [eax,edx] IDIV _ op -> mkRU (eax:edx:use_R op []) [eax,edx] + ADD_CC _ src dst -> usageRM src dst AND _ src dst -> usageRM src dst OR _ src dst -> usageRM src dst @@ -533,6 +540,7 @@ x86_patchRegsOfInstr instr env MUL2 sz src -> patch1 (MUL2 sz) src IDIV sz op -> patch1 (IDIV sz) op DIV sz op -> patch1 (DIV sz) op + ADD_CC sz src dst -> patch2 (ADD_CC sz) src dst AND sz src dst -> patch2 (AND sz) src dst OR sz src dst -> patch2 (OR sz) src dst XOR sz src dst -> patch2 (XOR sz) src dst diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 15d2967..6e2da18 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -563,6 +563,9 @@ pprInstr (ADC size src dst) pprInstr (SUB size src dst) = pprSizeOpOp (sLit "sub") size src dst pprInstr (IMUL size op1 op2) = pprSizeOpOp (sLit "imul") size op1 op2 +pprInstr (ADD_CC size src dst) + = pprSizeOpOp (sLit "add") size src dst + {- A hack. The Intel documentation says that "The two and three operand forms [of IMUL] may also be used with unsigned operands because the lower half of the product is the same regardless if diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index a5983a5..9ae7707 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -120,8 +120,5 @@ test('CopySmallArray', normal, compile_and_run, ['']) test('CopySmallArrayStressTest', reqlib('random'), compile_and_run, ['']) test('SizeOfSmallArray', normal, compile_and_run, ['']) test('T9001', normal, compile_and_run, ['']) -test('T9013', - [ omit_ways(['ghci']), # ghci doesn't support unboxed tuples - when(arch('x86') or arch('x86_64'), - expect_broken_for(9013, list(set(opt_ways) - set(llvm_ways)))) ], +test('T9013', omit_ways(['ghci']), # ghci doesn't support unboxed tuples compile_and_run, ['']) From git at git.haskell.org Mon Aug 11 18:18:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Aug 2014 18:18:53 +0000 (UTC) Subject: [commit: ghc] master: stg/Prim.h: drop redundant #ifdef (8e64151) Message-ID: <20140811181853.EA2F124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8e64151bc43075f910205a14f1c06966ad37ba0c/ghc >--------------------------------------------------------------- commit 8e64151bc43075f910205a14f1c06966ad37ba0c Author: Sergei Trofimovich Date: Mon Aug 11 21:18:36 2014 +0300 stg/Prim.h: drop redundant #ifdef Summary: Noticed by Herbert Valerio Riedel Signed-off-by: Sergei Trofimovich Test Plan: build test Reviewers: simonmar, austin, hvr Reviewed By: hvr Subscribers: rwbarton, phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D143 >--------------------------------------------------------------- 8e64151bc43075f910205a14f1c06966ad37ba0c includes/stg/Prim.h | 4 ---- 1 file changed, 4 deletions(-) diff --git a/includes/stg/Prim.h b/includes/stg/Prim.h index 7d94d18..9fdfd3c 100644 --- a/includes/stg/Prim.h +++ b/includes/stg/Prim.h @@ -26,11 +26,7 @@ StgWord hs_popcnt8(StgWord x); StgWord hs_popcnt16(StgWord x); StgWord hs_popcnt32(StgWord x); StgWord hs_popcnt64(StgWord64 x); -#ifdef i386_HOST_ARCH StgWord hs_popcnt(StgWord x); -#else -StgWord hs_popcnt(StgWord x); -#endif /* libraries/ghc-prim/cbits/word2float.c */ StgFloat hs_word2float32(StgWord x); From git at git.haskell.org Mon Aug 11 21:35:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Aug 2014 21:35:38 +0000 (UTC) Subject: [commit: ghc] master: Unbreak travis by not passing --no-dph (6e3c44e) Message-ID: <20140811213538.D974224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6e3c44e037dc5eb5e09f1e7c56ca8d9ab21f5353/ghc >--------------------------------------------------------------- commit 6e3c44e037dc5eb5e09f1e7c56ca8d9ab21f5353 Author: Joachim Breitner Date: Mon Aug 11 23:39:11 2014 +0200 Unbreak travis by not passing --no-dph >--------------------------------------------------------------- 6e3c44e037dc5eb5e09f1e7c56ca8d9ab21f5353 .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 57153b6..aaf7dd7 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,4 +33,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - CPUS=2 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast --no-dph + - CPUS=2 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast From git at git.haskell.org Mon Aug 11 21:59:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Aug 2014 21:59:15 +0000 (UTC) Subject: [commit: ghc] master: testsuite/base: update .gitignore (0a3944c) Message-ID: <20140811215916.0C5EB24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0a3944c34b836ada567990bbd12e9932203e1d89/ghc >--------------------------------------------------------------- commit 0a3944c34b836ada567990bbd12e9932203e1d89 Author: Austin Seipp Date: Mon Aug 11 15:39:10 2014 -0500 testsuite/base: update .gitignore Signed-off-by: Austin Seipp >--------------------------------------------------------------- 0a3944c34b836ada567990bbd12e9932203e1d89 libraries/base/tests/.gitignore | 1 + testsuite/.gitignore | 2 ++ 2 files changed, 3 insertions(+) diff --git a/libraries/base/tests/.gitignore b/libraries/base/tests/.gitignore index b7b2dc8..3115fd7 100644 --- a/libraries/base/tests/.gitignore +++ b/libraries/base/tests/.gitignore @@ -269,3 +269,4 @@ /unicode001 /unicode002 /weak001 +/T9395 diff --git a/testsuite/.gitignore b/testsuite/.gitignore index e6e6bb2..d4abe83 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1508,6 +1508,8 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/typecheck/should_run/tcrun051 /tests/typecheck/should_run/testeq2 /tests/typecheck/testeq1/typecheck.testeq1 +/tests/concurrent/should_run/T9379 +/tests/simplCore/should_run/T9390 /timeout/calibrate.out /timeout/dist/ /timeout/install-inplace/ From git at git.haskell.org Tue Aug 12 12:37:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 12:37:15 +0000 (UTC) Subject: [commit: ghc] master: Re-add `--no-dph` option to ./validate (3694d87) Message-ID: <20140812123715.E2D6D24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3694d8771168690c72be2a5b60add8e1024dc426/ghc >--------------------------------------------------------------- commit 3694d8771168690c72be2a5b60add8e1024dc426 Author: Herbert Valerio Riedel Date: Tue Aug 12 14:35:57 2014 +0200 Re-add `--no-dph` option to ./validate This was removed in bb003086599c2ac166cfb3aa710480713adb5a2f and caused some buildbots to stop working. So this commit just re-adds it as a no-op (wrt the current default). >--------------------------------------------------------------- 3694d8771168690c72be2a5b60add8e1024dc426 validate | 3 +++ 1 file changed, 3 insertions(+) diff --git a/validate b/validate index 3e1fde6..7a7b125 100755 --- a/validate +++ b/validate @@ -60,6 +60,9 @@ do --normal) speed=NORMAL ;; + --no-dph) # for backward compat + use_dph=0 + ;; --dph) use_dph=1 ;; From git at git.haskell.org Tue Aug 12 13:58:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 13:58:43 +0000 (UTC) Subject: [commit: ghc] master: Add bit scan {forward, reverse} insns to x86 NCG (3669b60) Message-ID: <20140812135848.3EEB724123@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3669b60cb0b24e22563bfe624aab4aba369cbfca/ghc >--------------------------------------------------------------- commit 3669b60cb0b24e22563bfe624aab4aba369cbfca Author: Herbert Valerio Riedel Date: Mon Aug 11 09:54:36 2014 +0200 Add bit scan {forward,reverse} insns to x86 NCG This is a pre-requisite for implementing count-{leading,trailing}-zero prim-ops (re #9340) Reviewers: ezyang, rwbarton, simonmar, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D141 >--------------------------------------------------------------- 3669b60cb0b24e22563bfe624aab4aba369cbfca compiler/nativeGen/X86/Instr.hs | 10 ++++++++-- compiler/nativeGen/X86/Ppr.hs | 2 ++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index b8b81ae..9c67266 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -326,8 +326,10 @@ data Instr -- call 1f -- 1: popl %reg - -- SSE4.2 - | POPCNT Size Operand Reg -- src, dst + -- bit counting instructions + | POPCNT Size Operand Reg -- [SSE4.2] count number of bits set to 1 + | BSF Size Operand Reg -- bit scan forward + | BSR Size Operand Reg -- bit scan reverse -- prefetch | PREFETCH PrefetchVariant Size Operand -- prefetch Variant, addr size, address to prefetch @@ -439,6 +441,8 @@ x86_regUsageOfInstr platform instr DELTA _ -> noUsage POPCNT _ src dst -> mkRU (use_R src []) [dst] + BSF _ src dst -> mkRU (use_R src []) [dst] + BSR _ src dst -> mkRU (use_R src []) [dst] -- note: might be a better way to do this PREFETCH _ _ src -> mkRU (use_R src []) [] @@ -610,6 +614,8 @@ x86_patchRegsOfInstr instr env CLTD _ -> instr POPCNT sz src dst -> POPCNT sz (patchOp src) (env dst) + BSF sz src dst -> BSF sz (patchOp src) (env dst) + BSR sz src dst -> BSR sz (patchOp src) (env dst) PREFETCH lvl size src -> PREFETCH lvl size (patchOp src) diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 6e2da18..0aa7b9e 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -581,6 +581,8 @@ pprInstr (XOR FF64 src dst) = pprOpOp (sLit "xorpd") FF64 src dst pprInstr (XOR size src dst) = pprSizeOpOp (sLit "xor") size src dst pprInstr (POPCNT size src dst) = pprOpOp (sLit "popcnt") size src (OpReg dst) +pprInstr (BSF size src dst) = pprOpOp (sLit "bsf") size src (OpReg dst) +pprInstr (BSR size src dst) = pprOpOp (sLit "bsr") size src (OpReg dst) pprInstr (PREFETCH NTA size src ) = pprSizeOp_ (sLit "prefetchnta") size src pprInstr (PREFETCH Lvl0 size src) = pprSizeOp_ (sLit "prefetcht0") size src From git at git.haskell.org Tue Aug 12 13:58:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 13:58:46 +0000 (UTC) Subject: [commit: ghc] master: Add CMOVcc insns to x86 NCG (9f285fa) Message-ID: <20140812135848.470632406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9f285fa40f6fb0c8495dbec771d798ac6dfaabee/ghc >--------------------------------------------------------------- commit 9f285fa40f6fb0c8495dbec771d798ac6dfaabee Author: Herbert Valerio Riedel Date: Mon Aug 11 12:38:09 2014 +0200 Add CMOVcc insns to x86 NCG This is a pre-requisite for implementing count-{leading,trailing}-zero prim-ops (re #9340) and may be useful to NCG to help turn some code into branch-less code sequences. Test Plan: Compiles and validates in combination with clz/ctz primop impl Reviewers: ezyang, rwbarton, simonmar, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D141 >--------------------------------------------------------------- 9f285fa40f6fb0c8495dbec771d798ac6dfaabee compiler/nativeGen/X86/Instr.hs | 3 +++ compiler/nativeGen/X86/Ppr.hs | 15 +++++++++++++++ 2 files changed, 18 insertions(+) diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index 9c67266..ef0ceea 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -182,6 +182,7 @@ data Instr -- Moves. | MOV Size Operand Operand + | CMOV Cond Size Operand Reg | MOVZxL Size Operand Operand -- size is the size of operand 1 | MOVSxL Size Operand Operand -- size is the size of operand 1 -- x86_64 note: plain mov into a 32-bit register always zero-extends @@ -356,6 +357,7 @@ x86_regUsageOfInstr :: Platform -> Instr -> RegUsage x86_regUsageOfInstr platform instr = case instr of MOV _ src dst -> usageRW src dst + CMOV _ _ src dst -> mkRU (use_R src [dst]) [dst] MOVZxL _ src dst -> usageRW src dst MOVSxL _ src dst -> usageRW src dst LEA _ src dst -> usageRW src dst @@ -532,6 +534,7 @@ x86_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr x86_patchRegsOfInstr instr env = case instr of MOV sz src dst -> patch2 (MOV sz) src dst + CMOV cc sz src dst -> CMOV cc sz (patchOp src) (env dst) MOVZxL sz src dst -> patch2 (MOVZxL sz) src dst MOVSxL sz src dst -> patch2 (MOVSxL sz) src dst LEA sz src dst -> patch2 (LEA sz) src dst diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 0aa7b9e..89bb0b0 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -521,6 +521,9 @@ pprInstr (RELOAD slot reg) pprInstr (MOV size src dst) = pprSizeOpOp (sLit "mov") size src dst +pprInstr (CMOV cc size src dst) + = pprCondOpReg (sLit "cmov") size cc src dst + pprInstr (MOVZxL II32 src dst) = pprSizeOpOp (sLit "mov") II32 src dst -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple -- movl. But we represent it as a MOVZxL instruction, because @@ -1121,6 +1124,18 @@ pprSizeOpReg name size op1 reg2 pprReg (archWordSize (target32Bit platform)) reg2 ] +pprCondOpReg :: LitString -> Size -> Cond -> Operand -> Reg -> SDoc +pprCondOpReg name size cond op1 reg2 + = hcat [ + char '\t', + ptext name, + pprCond cond, + space, + pprOperand size op1, + comma, + pprReg size reg2 + ] + pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> SDoc pprCondRegReg name size cond reg1 reg2 = hcat [ From git at git.haskell.org Tue Aug 12 15:34:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 15:34:08 +0000 (UTC) Subject: [commit: ghc] master: x86: zero extend the result of 16-bit popcnt instructions (#9435) (6415191) Message-ID: <20140812153408.7400A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/64151913f1ed32ecfe17fcc40f7adc6cbfbb0bc1/ghc >--------------------------------------------------------------- commit 64151913f1ed32ecfe17fcc40f7adc6cbfbb0bc1 Author: Reid Barton Date: Tue Aug 12 11:11:46 2014 -0400 x86: zero extend the result of 16-bit popcnt instructions (#9435) Summary: The 'popcnt r16, r/m16' instruction only writes the low 16 bits of the destination register, so we have to zero-extend the result to a full word as popCnt16# is supposed to return a Word#. For popCnt8# we could instead zero-extend the input to 32 bits and then do a 32-bit popcnt, and not have to zero-extend the result. LLVM produces the 16-bit popcnt sequence with two zero extensions, though, and who am I to argue? Test Plan: - ran "make TEST=cgrun071 EXTRA_HC_OPTS=-msse42" - then ran again adding "WAY=optasm", and verified that the popcnt sequences we generate match the ones produced by LLVM for its @llvm.ctpop.* intrinsics Reviewers: austin, hvr, tibbe Reviewed By: austin, hvr, tibbe Subscribers: phaskell, hvr, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D147 GHC Trac Issues: #9435 >--------------------------------------------------------------- 64151913f1ed32ecfe17fcc40f7adc6cbfbb0bc1 compiler/nativeGen/X86/CodeGen.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index d6fdee1..ce7120e 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -1743,15 +1743,19 @@ genCCall dflags is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst] if sse4_2 then do code_src <- getAnyReg src src_r <- getNewRegNat size + let dst_r = getRegisterReg platform False (CmmLocal dst) return $ code_src src_r `appOL` (if width == W8 then -- The POPCNT instruction doesn't take a r/m8 unitOL (MOVZxL II8 (OpReg src_r) (OpReg src_r)) `appOL` - unitOL (POPCNT II16 (OpReg src_r) - (getRegisterReg platform False (CmmLocal dst))) + unitOL (POPCNT II16 (OpReg src_r) dst_r) else - unitOL (POPCNT size (OpReg src_r) - (getRegisterReg platform False (CmmLocal dst)))) + unitOL (POPCNT size (OpReg src_r) dst_r)) `appOL` + (if width == W8 || width == W16 then + -- We used a 16-bit destination register above, + -- so zero-extend + unitOL (MOVZxL II16 (OpReg dst_r) (OpReg dst_r)) + else nilOL) else do targetExpr <- cmmMakeDynamicReference dflags CallReference lbl From git at git.haskell.org Tue Aug 12 15:46:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 15:46:10 +0000 (UTC) Subject: [commit: ghc] master: Test #9371 (indexed-types/should_fail/T9371) (a09508b) Message-ID: <20140812154610.B1CFB24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a09508b792eed24fc4d8a363df2635026bfa2de6/ghc >--------------------------------------------------------------- commit a09508b792eed24fc4d8a363df2635026bfa2de6 Author: Richard Eisenberg Date: Sun Aug 3 17:54:54 2014 -0400 Test #9371 (indexed-types/should_fail/T9371) >--------------------------------------------------------------- a09508b792eed24fc4d8a363df2635026bfa2de6 testsuite/tests/indexed-types/should_fail/T9371.hs | 25 ++++++++++++++++++++++ .../tests/indexed-types/should_fail/T9371.stderr | 5 +++++ testsuite/tests/indexed-types/should_fail/all.T | 1 + 3 files changed, 31 insertions(+) diff --git a/testsuite/tests/indexed-types/should_fail/T9371.hs b/testsuite/tests/indexed-types/should_fail/T9371.hs new file mode 100644 index 0000000..cfec4c0 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9371.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} + +module T9371 where + +import Data.Monoid + +class C x where + data D x :: * + makeD :: D x + +instance {-# OVERLAPPABLE #-} Monoid x => C x where + data D x = D1 (Either x ()) + makeD = D1 (Left mempty) + +instance (Monoid x, Monoid y) => C (x, y) where + data D (x,y) = D2 (x,y) + makeD = D2 (mempty, mempty) + +instance Show x => Show (D x) where + show (D1 x) = show x + + +main = print (makeD :: D (String, String)) diff --git a/testsuite/tests/indexed-types/should_fail/T9371.stderr b/testsuite/tests/indexed-types/should_fail/T9371.stderr new file mode 100644 index 0000000..695a7b4 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9371.stderr @@ -0,0 +1,5 @@ + +T9371.hs:14:10: + Conflicting family instance declarations: + D -- Defined at T9371.hs:14:10 + D (x, y) -- Defined at T9371.hs:18:10 diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 0851c08..6d284cf 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -125,3 +125,4 @@ test('T9171', normal, compile_fail, ['']) test('T9097', normal, compile_fail, ['']) test('T9160', normal, compile_fail, ['']) test('T9357', normal, compile_fail, ['']) +test('T9371', normal, compile_fail, ['']) From git at git.haskell.org Tue Aug 12 15:46:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 15:46:15 +0000 (UTC) Subject: [commit: ghc] master: Test #9415 (typecheck/should_fail/T9415) (1a3e19d) Message-ID: <20140812154615.CC9D624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1a3e19d061c1e5a1db9789572eca3a0ade450954/ghc >--------------------------------------------------------------- commit 1a3e19d061c1e5a1db9789572eca3a0ade450954 Author: Richard Eisenberg Date: Wed Aug 6 09:54:37 2014 -0400 Test #9415 (typecheck/should_fail/T9415) >--------------------------------------------------------------- 1a3e19d061c1e5a1db9789572eca3a0ade450954 testsuite/tests/typecheck/should_fail/T9415.hs | 5 +++++ testsuite/tests/typecheck/should_fail/T9415.stderr | 8 ++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 3 files changed, 14 insertions(+) diff --git a/testsuite/tests/typecheck/should_fail/T9415.hs b/testsuite/tests/typecheck/should_fail/T9415.hs new file mode 100644 index 0000000..db77ff0 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9415.hs @@ -0,0 +1,5 @@ +module T9415 where + +class D a => C a where + meth :: D a => () +class C a => D a diff --git a/testsuite/tests/typecheck/should_fail/T9415.stderr b/testsuite/tests/typecheck/should_fail/T9415.stderr new file mode 100644 index 0000000..516759e --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9415.stderr @@ -0,0 +1,8 @@ + +T9415.hs:3:1: + Cycle in class declaration (via superclasses): C -> D -> C + In the class declaration for ?C? + +T9415.hs:5:1: + Cycle in class declaration (via superclasses): D -> C -> D + In the class declaration for ?D? diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index b528047..4f001f5 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -333,3 +333,4 @@ test('T8883', normal, compile_fail, ['']) test('T9196', normal, compile_fail, ['']) test('T9305', normal, compile_fail, ['']) test('T9323', normal, compile_fail, ['']) +test('T9415', normal, compile_fail, ['']) From git at git.haskell.org Tue Aug 12 15:46:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 15:46:18 +0000 (UTC) Subject: [commit: ghc] master: Fix #9415. (1b13886) Message-ID: <20140812154620.A656F24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1b1388697e687154c2bf1943639e75f3ccf5bc59/ghc >--------------------------------------------------------------- commit 1b1388697e687154c2bf1943639e75f3ccf5bc59 Author: Richard Eisenberg Date: Wed Aug 6 09:51:26 2014 -0400 Fix #9415. Abort typechecking when we detect a superclass cycle error, as ambiguity checking in the presence of superclass cycle errors can cause a loop. >--------------------------------------------------------------- 1b1388697e687154c2bf1943639e75f3ccf5bc59 compiler/typecheck/TcTyClsDecls.lhs | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index f09bef8..2db31e3 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1369,10 +1369,24 @@ since GADTs are not kind indexed. Validity checking is done once the mutually-recursive knot has been tied, so we can look at things freely. +Note [Abort when superclass cycle is detected] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must avoid doing the ambiguity check when there are already errors accumulated. +This is because one of the errors may be a superclass cycle, and superclass cycles +cause canonicalization to loop. Here is a representative example: + + class D a => C a where + meth :: D a => () + class C a => D a + +This fixes Trac #9415. + \begin{code} checkClassCycleErrs :: Class -> TcM () checkClassCycleErrs cls - = unless (null cls_cycles) $ mapM_ recClsErr cls_cycles + = unless (null cls_cycles) $ + do { mapM_ recClsErr cls_cycles + ; failM } -- See Note [Abort when superclass cycle is detected] where cls_cycles = calcClassCycles cls checkValidTyCl :: TyThing -> TcM () @@ -1623,6 +1637,7 @@ checkValidClass cls ; checkValidTheta (ClassSCCtxt (className cls)) theta -- Now check for cyclic superclasses + -- If there are superclass cycles, checkClassCycleErrs bails. ; checkClassCycleErrs cls -- Check the class operations From git at git.haskell.org Tue Aug 12 15:46:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 15:46:21 +0000 (UTC) Subject: [commit: ghc] master: Fix Trac #9371. (f29bdfb) Message-ID: <20140812154621.A5D9524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f29bdfbcedda6cb33ab05d884c151f2b31f4e4e0/ghc >--------------------------------------------------------------- commit f29bdfbcedda6cb33ab05d884c151f2b31f4e4e0 Author: Richard Eisenberg Date: Sun Aug 3 18:40:30 2014 -0400 Fix Trac #9371. This was very simple: lists of different lengths are *maybe* apart, not *surely* apart. >--------------------------------------------------------------- f29bdfbcedda6cb33ab05d884c151f2b31f4e4e0 compiler/types/Unify.lhs | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs index f44e260..1eb1c2b 100644 --- a/compiler/types/Unify.lhs +++ b/compiler/types/Unify.lhs @@ -418,6 +418,26 @@ substituted, we can't properly unify the types. But, that skolem variable may later be instantiated with a unifyable type. So, we return maybeApart in these cases. +Note [Lists of different lengths are MaybeApart] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It is unusual to call tcUnifyTys or tcUnifyTysFG with lists of different +lengths. The place where we know this can happen is from compatibleBranches in +FamInstEnv, when checking data family instances. Data family instances may be +eta-reduced; see Note [Eta reduction for data family axioms] in TcInstDcls. + +We wish to say that + + D :: * -> * -> * + axDF1 :: D Int ~ DFInst1 + axDF2 :: D Int Bool ~ DFInst2 + +overlap. If we conclude that lists of different lengths are SurelyApart, then +it will look like these do *not* overlap, causing disaster. See Trac #9371. + +In usages of tcUnifyTys outside of family instances, we always use tcUnifyTys, +which can't tell the difference between MaybeApart and SurelyApart, so those +usages won't notice this design choice. + \begin{code} tcUnifyTy :: Type -> Type -- All tyvars are bindable -> Maybe TvSubst -- A regular one-shot (idempotent) substitution @@ -593,7 +613,7 @@ unifyList subst orig_xs orig_ys go subst [] [] = return subst go subst (x:xs) (y:ys) = do { subst' <- unify subst x y ; go subst' xs ys } - go _ _ _ = surelyApart + go subst _ _ = maybeApart subst -- See Note [Lists of different lengths are MaybeApart] --------------------------------- uVar :: TvSubstEnv -- An existing substitution to extend From git at git.haskell.org Tue Aug 12 15:46:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 15:46:25 +0000 (UTC) Subject: [commit: ghc] master: Test #9200. (polykinds/T9200) (8d27c76) Message-ID: <20140812154625.8F70724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8d27c764aca6dba9ec150cb7e4d68d03e8a7e338/ghc >--------------------------------------------------------------- commit 8d27c764aca6dba9ec150cb7e4d68d03e8a7e338 Author: Richard Eisenberg Date: Sun Aug 3 21:37:45 2014 -0400 Test #9200. (polykinds/T9200) >--------------------------------------------------------------- 8d27c764aca6dba9ec150cb7e4d68d03e8a7e338 testsuite/tests/polykinds/T9200.hs | 19 +++++++++++++++++++ testsuite/tests/polykinds/all.T | 1 + 2 files changed, 20 insertions(+) diff --git a/testsuite/tests/polykinds/T9200.hs b/testsuite/tests/polykinds/T9200.hs new file mode 100644 index 0000000..b74177a --- /dev/null +++ b/testsuite/tests/polykinds/T9200.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds #-} + +module T9200 where + +------ +-- test CUSK on classes + +class C (f :: k) (a :: k2) where + c_meth :: D a => () + +class C () a => D a + + +--------- +--- test CUSK on type synonyms +data T1 a b c = MkT1 (S True b c) +data T2 p q r = MkT2 (S p 5 r) +data T3 x y q = MkT3 (S x y '()) +type S (f :: k1) (g :: k2) (h :: k3) = ((T1 f g h, T2 f g h, T3 f g h) :: *) diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 22a159d..abb158b 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -106,3 +106,4 @@ test('T9222', normal, compile, ['']) test('T9264', normal, compile, ['']) test('T9263', normal, run_command, ['$MAKE -s --no-print-directory T9263']) test('T9063', normal, compile, ['']) +test('T9200', normal, compile, ['']) From git at git.haskell.org Tue Aug 12 15:46:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 15:46:28 +0000 (UTC) Subject: [commit: ghc] master: Change treatment of CUSKs for synonyms and families (#9200). (b2c6167) Message-ID: <20140812154628.257F624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b2c61670fced7a59d19c0665de23d38984f8d01c/ghc >--------------------------------------------------------------- commit b2c61670fced7a59d19c0665de23d38984f8d01c Author: Richard Eisenberg Date: Thu Aug 7 08:28:32 2014 -0400 Change treatment of CUSKs for synonyms and families (#9200). >--------------------------------------------------------------- b2c61670fced7a59d19c0665de23d38984f8d01c compiler/typecheck/TcHsType.lhs | 27 +++++++++++++++++++++++---- testsuite/tests/polykinds/T9200.hs | 12 +++++++++++- 2 files changed, 34 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index 14a3c17..d075cbc 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -1067,22 +1067,41 @@ kcStrategy :: TyClDecl Name -> KindCheckingStrategy kcStrategy d@(ForeignType {}) = pprPanic "kcStrategy" (ppr d) kcStrategy (FamDecl fam_decl) = kcStrategyFamDecl fam_decl -kcStrategy (SynDecl {}) = ParametricKinds +kcStrategy (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) + | all_tyvars_annotated tyvars + , rhs_annotated rhs + = FullKindSignature + | otherwise + = ParametricKinds + where + rhs_annotated (L _ ty) = case ty of + HsParTy lty -> rhs_annotated lty + HsKindSig {} -> True + _ -> False kcStrategy decl@(DataDecl {}) = kcStrategyAlgDecl decl kcStrategy decl@(ClassDecl {}) = kcStrategyAlgDecl decl kcStrategyAlgDecl :: TyClDecl Name -> KindCheckingStrategy kcStrategyAlgDecl decl - | all (isHsKindedTyVar . unLoc) (hsQTvBndrs $ tcdTyVars decl) + | all_tyvars_annotated $ tcdTyVars decl = FullKindSignature | otherwise = ParametricKinds --- if the ClosedTypeFamily has no equations, do the defaulting to *, etc. kcStrategyFamDecl :: FamilyDecl Name -> KindCheckingStrategy -kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily (_:_) }) = NonParametricKinds +kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily _ + , fdTyVars = tyvars + , fdKindSig = Just _ }) + | all (isHsKindedTyVar . unLoc) (hsQTvBndrs tyvars) + = FullKindSignature +-- if the ClosedTypeFamily has no equations, do the defaulting to *, etc. +kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily (_:_) }) = ParametricKinds kcStrategyFamDecl _ = FullKindSignature +-- | Are all the type variables given with a kind annotation? +all_tyvars_annotated :: LHsTyVarBndrs name -> Bool +all_tyvars_annotated = all (isHsKindedTyVar . unLoc) . hsQTvBndrs + mkKindSigVar :: Name -> TcM KindVar -- Use the specified name; don't clone it mkKindSigVar n diff --git a/testsuite/tests/polykinds/T9200.hs b/testsuite/tests/polykinds/T9200.hs index b74177a..ca05066 100644 --- a/testsuite/tests/polykinds/T9200.hs +++ b/testsuite/tests/polykinds/T9200.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds #-} +{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds, + TypeFamilies #-} module T9200 where @@ -17,3 +18,12 @@ data T1 a b c = MkT1 (S True b c) data T2 p q r = MkT2 (S p 5 r) data T3 x y q = MkT3 (S x y '()) type S (f :: k1) (g :: k2) (h :: k3) = ((T1 f g h, T2 f g h, T3 f g h) :: *) + + +---------- +-- test CUSK on closed type families +type family F (a :: k) :: k where + F True = False + F False = True + F x = x + From git at git.haskell.org Tue Aug 12 15:46:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 15:46:30 +0000 (UTC) Subject: [commit: ghc] master: Added more testing for #9200. (polykinds/T9200b) (3dfd3c3) Message-ID: <20140812154630.CE64124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3dfd3c33a46ae01a45802cb5b97fe7a2c8a8f31a/ghc >--------------------------------------------------------------- commit 3dfd3c33a46ae01a45802cb5b97fe7a2c8a8f31a Author: Richard Eisenberg Date: Thu Aug 7 08:19:22 2014 -0400 Added more testing for #9200. (polykinds/T9200b) >--------------------------------------------------------------- 3dfd3c33a46ae01a45802cb5b97fe7a2c8a8f31a testsuite/tests/polykinds/T9200b.hs | 10 ++++++++++ testsuite/tests/polykinds/T9200b.stderr | 6 ++++++ testsuite/tests/polykinds/all.T | 1 + 3 files changed, 17 insertions(+) diff --git a/testsuite/tests/polykinds/T9200b.hs b/testsuite/tests/polykinds/T9200b.hs new file mode 100644 index 0000000..f780aba --- /dev/null +++ b/testsuite/tests/polykinds/T9200b.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds #-} + +module T9200b where + +--------- +--- test CUSK on closed type families +type family F (a :: k) where + F True = False + F False = True + F x = x diff --git a/testsuite/tests/polykinds/T9200b.stderr b/testsuite/tests/polykinds/T9200b.stderr new file mode 100644 index 0000000..5e8c730 --- /dev/null +++ b/testsuite/tests/polykinds/T9200b.stderr @@ -0,0 +1,6 @@ + +T9200b.hs:8:5: + The first argument of ?F? should have kind ?k?, + but ?True? has kind ?Bool? + In the type ?True? + In the type family declaration for ?F? diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index abb158b..82c1824 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -107,3 +107,4 @@ test('T9264', normal, compile, ['']) test('T9263', normal, run_command, ['$MAKE -s --no-print-directory T9263']) test('T9063', normal, compile, ['']) test('T9200', normal, compile, ['']) +test('T9200b', normal, compile_fail, ['']) From git at git.haskell.org Tue Aug 12 15:46:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 15:46:33 +0000 (UTC) Subject: [commit: ghc] master: Change definition of CUSK for data and class definitions (#9200). (6485930) Message-ID: <20140812154634.241CF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/64859308231551de2aed839003994b29b99409c0/ghc >--------------------------------------------------------------- commit 64859308231551de2aed839003994b29b99409c0 Author: Richard Eisenberg Date: Wed Aug 6 09:56:50 2014 -0400 Change definition of CUSK for data and class definitions (#9200). Now, a CUSK is when (and only when) all type variables are annotated. This allows classes to participate in polymorphic recursion. >--------------------------------------------------------------- 64859308231551de2aed839003994b29b99409c0 compiler/hsSyn/HsTypes.lhs | 7 ++++++- compiler/typecheck/TcHsType.lhs | 19 ++++++++++++++----- 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index 08a0eef..eada762 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -25,7 +25,7 @@ module HsTypes ( ConDeclField(..), pprConDeclFields, - mkHsQTvs, hsQTvBndrs, + mkHsQTvs, hsQTvBndrs, isHsKindedTyVar, mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs, hsTyVarName, mkHsWithBndrs, hsLKiTyVarNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, @@ -188,6 +188,11 @@ data HsTyVarBndr name (LHsKind name) -- The user-supplied kind signature deriving (Data, Typeable) +-- | Does this 'HsTyVarBndr' come with an explicit kind annotation? +isHsKindedTyVar :: HsTyVarBndr name -> Bool +isHsKindedTyVar (UserTyVar {}) = False +isHsKindedTyVar (KindedTyVar {}) = True + data HsType name = HsForAllTy HsExplicitFlag -- Renamer leaves this flag unchanged, to record the way -- the user wrote it originally, so that the printer can diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index cdeb191..14a3c17 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -1068,10 +1068,15 @@ kcStrategy d@(ForeignType {}) = pprPanic "kcStrategy" (ppr d) kcStrategy (FamDecl fam_decl) = kcStrategyFamDecl fam_decl kcStrategy (SynDecl {}) = ParametricKinds -kcStrategy (DataDecl { tcdDataDefn = HsDataDefn { dd_kindSig = m_ksig }}) - | Just _ <- m_ksig = FullKindSignature - | otherwise = ParametricKinds -kcStrategy (ClassDecl {}) = ParametricKinds +kcStrategy decl@(DataDecl {}) = kcStrategyAlgDecl decl +kcStrategy decl@(ClassDecl {}) = kcStrategyAlgDecl decl + +kcStrategyAlgDecl :: TyClDecl Name -> KindCheckingStrategy +kcStrategyAlgDecl decl + | all (isHsKindedTyVar . unLoc) (hsQTvBndrs $ tcdTyVars decl) + = FullKindSignature + | otherwise + = ParametricKinds -- if the ClosedTypeFamily has no equations, do the defaulting to *, etc. kcStrategyFamDecl :: FamilyDecl Name -> KindCheckingStrategy @@ -1259,7 +1264,11 @@ kcTyClTyVars :: Name -> LHsTyVarBndrs Name -> TcM a -> TcM a kcTyClTyVars name (HsQTvs { hsq_kvs = kvs, hsq_tvs = hs_tvs }) thing_inside = kcScopedKindVars kvs $ do { tc_kind <- kcLookupKind name - ; let (arg_ks, _res_k) = splitKindFunTysN (length hs_tvs) tc_kind + ; let (_, mono_kind) = splitForAllTys tc_kind + -- if we have a FullKindSignature, the tc_kind may already + -- be generalized. The kvs get matched up while kind-checking + -- the types in kc_tv, below + (arg_ks, _res_k) = splitKindFunTysN (length hs_tvs) mono_kind -- There should be enough arrows, because -- getInitialKinds used the tcdTyVars ; name_ks <- zipWithM kc_tv hs_tvs arg_ks From git at git.haskell.org Tue Aug 12 15:46:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 15:46:36 +0000 (UTC) Subject: [commit: ghc] master: Remove NonParametricKinds (#9200) (578377c) Message-ID: <20140812154636.AFA8624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/578377cec76d702da3714d4d6fe402b76de5aa7f/ghc >--------------------------------------------------------------- commit 578377cec76d702da3714d4d6fe402b76de5aa7f Author: Richard Eisenberg Date: Thu Aug 7 08:37:05 2014 -0400 Remove NonParametricKinds (#9200) This commit also removes 'KindCheckingStrategy' and related gubbins, instead including the notion of a CUSK into HsDecls. >--------------------------------------------------------------- 578377cec76d702da3714d4d6fe402b76de5aa7f compiler/hsSyn/HsDecls.lhs | 48 ++++++++ compiler/hsSyn/HsTypes.lhs | 6 +- compiler/typecheck/TcHsType.lhs | 229 +++--------------------------------- compiler/typecheck/TcTyClsDecls.lhs | 20 ++-- 4 files changed, 77 insertions(+), 226 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 578377cec76d702da3714d4d6fe402b76de5aa7f From git at git.haskell.org Tue Aug 12 15:46:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 15:46:39 +0000 (UTC) Subject: [commit: ghc] master: Testsuite wibbles around #9200 (91a48c5) Message-ID: <20140812154639.E48F724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/91a48c5460258fdde800429df1e0d305cd2f0078/ghc >--------------------------------------------------------------- commit 91a48c5460258fdde800429df1e0d305cd2f0078 Author: Richard Eisenberg Date: Fri Aug 8 08:14:52 2014 -0400 Testsuite wibbles around #9200 >--------------------------------------------------------------- 91a48c5460258fdde800429df1e0d305cd2f0078 testsuite/tests/ghci/scripts/T7939.hs | 2 +- testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot | 2 +- testsuite/tests/polykinds/T7053.hs | 2 +- testsuite/tests/polykinds/T7053.stderr | 8 -------- testsuite/tests/polykinds/all.T | 2 +- 5 files changed, 4 insertions(+), 12 deletions(-) diff --git a/testsuite/tests/ghci/scripts/T7939.hs b/testsuite/tests/ghci/scripts/T7939.hs index 93b9016..fbdf883 100644 --- a/testsuite/tests/ghci/scripts/T7939.hs +++ b/testsuite/tests/ghci/scripts/T7939.hs @@ -22,6 +22,6 @@ type family K a where K '[] = Nothing K (h ': t) = Just h -type family L (a :: k) b :: k where +type family L (a :: k) (b :: *) :: k where L Int Int = Bool L Maybe Bool = IO diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot b/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot index 0388084..503e1ad 100644 --- a/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot +++ b/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot @@ -9,5 +9,5 @@ type family Bar a where Bar Int = Bool Bar Double = Char -type family Baz (a :: k) where +type family Baz (a :: k) :: * where Baz Int = Bool diff --git a/testsuite/tests/polykinds/T7053.hs b/testsuite/tests/polykinds/T7053.hs index 4db1e0d..d45dbad 100644 --- a/testsuite/tests/polykinds/T7053.hs +++ b/testsuite/tests/polykinds/T7053.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE PolyKinds, GADTs #-} module T7053 where diff --git a/testsuite/tests/polykinds/T7053.stderr b/testsuite/tests/polykinds/T7053.stderr deleted file mode 100644 index c9ebcfe..0000000 --- a/testsuite/tests/polykinds/T7053.stderr +++ /dev/null @@ -1,8 +0,0 @@ - -T7053.hs:6:52: - Kind occurs check - The first argument of ?a? should have kind ?k0?, - but ?b? has kind ?k0 -> k1? - In the type ?TypeRep (a b)? - In the definition of data constructor ?TyApp? - In the data declaration for ?TypeRep? diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 82c1824..5b02dda 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -54,7 +54,7 @@ test('T6137', normal, compile,['']) test('T6093', normal, compile,['']) test('T6049', normal, compile,['']) test('T6129', normal, compile_fail,['']) -test('T7053', normal, compile_fail,['']) +test('T7053', normal, compile,['']) test('T7053a', normal, compile,['']) test('T7020', normal, compile,['']) test('T7022', normal, run_command, ['$MAKE -s --no-print-directory T7022']) From git at git.haskell.org Tue Aug 12 15:46:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 15:46:42 +0000 (UTC) Subject: [commit: ghc] master: Update manual (#9200). (1c66b3d) Message-ID: <20140812154644.EB0A724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1c66b3d5d3d5f5b58e1860c33233a049b11e3d92/ghc >--------------------------------------------------------------- commit 1c66b3d5d3d5f5b58e1860c33233a049b11e3d92 Author: Richard Eisenberg Date: Thu Aug 7 08:53:11 2014 -0400 Update manual (#9200). >--------------------------------------------------------------- 1c66b3d5d3d5f5b58e1860c33233a049b11e3d92 docs/users_guide/glasgow_exts.xml | 105 ++++++++++++++++++++++---------------- 1 file changed, 62 insertions(+), 43 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index de0d494..bfdeea4 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -6527,11 +6527,11 @@ data T m a = MkT (m a) (T Maybe (m a)) The recursive use of T forced the second argument to have kind *. However, just as in type inference, you can achieve polymorphic recursion by giving a -complete kind signature for T. The way to give -a complete kind signature for a data type is to use a GADT-style declaration with an -explicit kind signature thus: +complete kind signature for T. A complete +kind signature is present when all argument kinds and the result kind are known, without +any need for inference. For example: -data T :: (k -> *) -> k -> * where +data T (m :: k -> *) :: k -> * where MkT :: m a -> T Maybe (m a) -> T m a The complete user-supplied kind signature specifies the polymorphic kind for T, @@ -6543,26 +6543,41 @@ In particular, the recursive use of T is at kind * - -A GADT-style data type declaration, with an explicit "::" in the header. -For example: +For a datatype, every type variable must be annotated with a kind. In a +GADT-style declaration, there may also be a kind signature (with a top-level +:: in the header), but the presence or absence of this annotation +does not affect whether or not the declaration has a complete signature. data T1 :: (k -> *) -> k -> * where ... -- Yes T1 :: forall k. (k->*) -> k -> * data T2 (a :: k -> *) :: k -> * where ... -- Yes T2 :: forall k. (k->*) -> k -> * data T3 (a :: k -> *) (b :: k) :: * where ... -- Yes T3 :: forall k. (k->*) -> k -> * -data T4 a (b :: k) :: * where ... -- YES T4 :: forall k. * -> k -> * +data T4 (a :: k -> *) (b :: k) where ... -- Yes T4 :: forall k. (k->*) -> k -> * -data T5 a b where ... -- NO kind is inferred -data T4 (a :: k -> *) (b :: k) where ... -- NO kind is inferred - -It makes no difference where you put the "::" but it must be there. -You cannot give a complete kind signature using a Haskell-98-style data type declaration; -you must use GADT syntax. +data T5 a (b :: k) :: * where ... -- NO kind is inferred +data T6 a b where ... -- NO kind is inferred + + + + +For a class, every type variable must be annotated with a kind. +For a type synonym, every type variable and the result type must all be annotated +with kinds. + +type S1 (a :: k) = (a :: k) -- Yes S1 :: forall k. k -> k +type S2 (a :: k) = a -- No kind is inferred +type S3 (a :: k) = Proxy a -- No kind is inferred + +Note that in S2 and S3, the kind of the +right-hand side is rather apparent, but it is still not considered to have a complete +signature -- no inference can be done before detecting the signature. + + An open type or data family declaration always has a -complete user-specified kind signature; no "::" is required: +complete user-specified kind signature; un-annotated type variables default to +kind *. data family D1 a -- D1 :: * -> * data family D2 (a :: k) -- D2 :: forall k. k -> * @@ -6577,10 +6592,12 @@ variable annotation from the class declaration. It keeps its polymorphic kind in the associated type declaration. The variable b, however, gets defaulted to *. + + +A closed type familey has a complete signature when all of its type variables +are annotated and a return kind (with a top-level ::) is supplied. + -In a complete user-specified kind signature, any un-decorated type variable to the -left of the "::" is considered to have kind "*". -If you want kind polymorphism, specify a kind variable. @@ -6590,31 +6607,33 @@ If you want kind polymorphism, specify a kind variable. Although all open type families are considered to have a complete user-specified kind signature, we can relax this condition for closed type families, where we have equations on which to perform kind inference. GHC will -infer a kind for any type variable in a closed type family when that kind is -never used in pattern-matching. If you want a kind variable to be used in -pattern-matching, you must declare it explicitly. - - - -Here are some examples (assuming -XDataKinds is enabled): - -type family Not a where -- Not :: Bool -> Bool - Not False = True - Not True = False - -type family F a where -- ERROR: requires pattern-matching on a kind variable - F Int = Bool - F Maybe = Char - -type family G (a :: k) where -- G :: k -> * - G Int = Bool - G Maybe = Char - -type family SafeHead where -- SafeHead :: [k] -> Maybe k - SafeHead '[] = Nothing -- note that k is not required for pattern-matching - SafeHead (h ': t) = Just h - - +infer kinds for the arguments and result types of a closed type family. + +GHC supports kind-indexed type families, where the +family matches both on the kind and type. GHC will not infer +this behaviour without a complete user-supplied kind signature, as doing so would +sometimes infer non-principal types. + +For example: + +type family F1 a where + F1 True = False + F1 False = True + F1 x = x +-- F1 fails to compile: kind-indexing is not inferred + +type family F2 (a :: k) where + F2 True = False + F2 False = True + F2 x = x +-- F2 fails to compile: no complete signature + +type family F3 (a :: k) :: k where + F3 True = False + F3 False = True + F3 x = x +-- OK + From git at git.haskell.org Tue Aug 12 20:13:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 20:13:33 +0000 (UTC) Subject: [commit: ghc] master: Add some Haddocks to SMRep (a6fd7b5) Message-ID: <20140812201333.9412624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a6fd7b5c4b8439bfcc56bf6924de64f4f32e7211/ghc >--------------------------------------------------------------- commit a6fd7b5c4b8439bfcc56bf6924de64f4f32e7211 Author: Johan Tibell Date: Tue Aug 12 09:34:27 2014 +0200 Add some Haddocks to SMRep >--------------------------------------------------------------- a6fd7b5c4b8439bfcc56bf6924de64f4f32e7211 compiler/cmm/SMRep.lhs | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs index 9fab530..0713620 100644 --- a/compiler/cmm/SMRep.lhs +++ b/compiler/cmm/SMRep.lhs @@ -71,19 +71,30 @@ import Data.Bits %************************************************************************ \begin{code} -type WordOff = Int -- Word offset, or word count -type ByteOff = Int -- Byte offset, or byte count +-- | Word offset, or word count +type WordOff = Int +-- | Byte offset, or byte count +type ByteOff = Int + +-- | Round up the given byte count to the next byte count that's a +-- multiple of the machine's word size. roundUpToWords :: DynFlags -> ByteOff -> ByteOff roundUpToWords dflags n = (n + (wORD_SIZE dflags - 1)) .&. (complement (wORD_SIZE dflags - 1)) +-- | Convert the given number of words to a number of bytes. +-- +-- This function morally has type @WordOff -> ByteOff@, but uses @Num +-- a@ to allow for overloading. wordsToBytes :: Num a => DynFlags -> a -> a wordsToBytes dflags n = fromIntegral (wORD_SIZE dflags) * n {-# SPECIALIZE wordsToBytes :: DynFlags -> Int -> Int #-} {-# SPECIALIZE wordsToBytes :: DynFlags -> Word -> Word #-} {-# SPECIALIZE wordsToBytes :: DynFlags -> Integer -> Integer #-} +-- | First round the given byte count up to a multiple of the +-- machine's word size and then convert the result to words. bytesToWordsRoundUp :: DynFlags -> ByteOff -> WordOff bytesToWordsRoundUp dflags n = (n + word_size - 1) `quot` word_size where word_size = wORD_SIZE dflags From git at git.haskell.org Tue Aug 12 20:13:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 20:13:37 +0000 (UTC) Subject: [commit: ghc] master: StgCmmPrim: add note to stop using fixed size signed types for sizes (4342049) Message-ID: <20140812201337.85B6D24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/434204975bb6e25a3ec0d32fc225effb8eceb0c3/ghc >--------------------------------------------------------------- commit 434204975bb6e25a3ec0d32fc225effb8eceb0c3 Author: Johan Tibell Date: Tue Aug 12 20:28:14 2014 +0200 StgCmmPrim: add note to stop using fixed size signed types for sizes We use fixed size signed types to e.g. represent array sizes. This means that the size can overflow. >--------------------------------------------------------------- 434204975bb6e25a3ec0d32fc225effb8eceb0c3 compiler/codeGen/StgCmmPrim.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 2fa1b85..77739fe 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -137,6 +137,11 @@ cgOpApp (StgPrimCallOp primcall) args _res_ty asUnsigned :: Width -> Integer -> Integer asUnsigned w n = n .&. (bit (widthInBits w) - 1) +-- TODO: Several primop implementations (e.g. 'doNewByteArrayOp') use +-- ByteOff (or some other fixed width signed type) to represent +-- array sizes or indices. This means that these will overflow for +-- large enough sizes. + -- | Decide whether an out-of-line primop should be replaced by an -- inline implementation. This might happen e.g. if there's enough -- static information, such as statically know arguments, to emit a From git at git.haskell.org Tue Aug 12 20:13:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Aug 2014 20:13:40 +0000 (UTC) Subject: [commit: ghc] master: shouldInlinePrimOp: Fix Int overflow (6f862df) Message-ID: <20140812201341.0B98824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f862dfae20afdcd671133f3534b1bf5c25bbd9b/ghc >--------------------------------------------------------------- commit 6f862dfae20afdcd671133f3534b1bf5c25bbd9b Author: Johan Tibell Date: Thu Aug 7 17:07:00 2014 +0200 shouldInlinePrimOp: Fix Int overflow There were two overflow issues in shouldInlinePrimOp. The first one is due to a negative CmmInt literal being created if the array size was given as larger than 2^63-1 (on a 64-bit platform.) This meant that large array sizes could compare as being smaller than maxInlineAllocSize. The second issue is that we casted the Integer to an Int in the comparison, which again meant that large array sizes could compare as being smaller than maxInlineAllocSize. The attempt to allocate a large array inline then caused a segfault. Fixes #9416. >--------------------------------------------------------------- 6f862dfae20afdcd671133f3534b1bf5c25bbd9b compiler/cmm/SMRep.lhs | 7 +++-- compiler/codeGen/StgCmmPrim.hs | 60 ++++++++++++++++++++++++++---------------- 2 files changed, 43 insertions(+), 24 deletions(-) diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs index b23bcc1..9fab530 100644 --- a/compiler/cmm/SMRep.lhs +++ b/compiler/cmm/SMRep.lhs @@ -78,8 +78,11 @@ roundUpToWords :: DynFlags -> ByteOff -> ByteOff roundUpToWords dflags n = (n + (wORD_SIZE dflags - 1)) .&. (complement (wORD_SIZE dflags - 1)) -wordsToBytes :: DynFlags -> WordOff -> ByteOff -wordsToBytes dflags n = wORD_SIZE dflags * n +wordsToBytes :: Num a => DynFlags -> a -> a +wordsToBytes dflags n = fromIntegral (wORD_SIZE dflags) * n +{-# SPECIALIZE wordsToBytes :: DynFlags -> Int -> Int #-} +{-# SPECIALIZE wordsToBytes :: DynFlags -> Word -> Word #-} +{-# SPECIALIZE wordsToBytes :: DynFlags -> Integer -> Integer #-} bytesToWordsRoundUp :: DynFlags -> ByteOff -> WordOff bytesToWordsRoundUp dflags n = (n + word_size - 1) `quot` word_size diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 0d67cdb..2fa1b85 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -43,6 +43,7 @@ import FastString import Outputable import Util +import Data.Bits ((.&.), bit) import Control.Monad (liftM, when) ------------------------------------------------------------------------ @@ -121,6 +122,21 @@ cgOpApp (StgPrimCallOp primcall) args _res_ty ; let fun = CmmLit (CmmLabel (mkPrimCallLabel primcall)) ; emitCall (NativeNodeCall, NativeReturn) fun cmm_args } +-- | Interpret the argument as an unsigned value, assuming the value +-- is given in two-complement form in the given width. +-- +-- Example: @asUnsigned W64 (-1)@ is 18446744073709551615. +-- +-- This function is used to work around the fact that many array +-- primops take Int# arguments, but we interpret them as unsigned +-- quantities in the code gen. This means that we have to be careful +-- every time we work on e.g. a CmmInt literal that corresponds to the +-- array size, as it might contain a negative Integer value if the +-- user passed a value larger than 2^(wORD_SIZE_IN_BITS-1) as the Int# +-- literal. +asUnsigned :: Width -> Integer -> Integer +asUnsigned w n = n .&. (bit (widthInBits w) - 1) + -- | Decide whether an out-of-line primop should be replaced by an -- inline implementation. This might happen e.g. if there's enough -- static information, such as statically know arguments, to emit a @@ -135,12 +151,12 @@ shouldInlinePrimOp :: DynFlags -> [CmmExpr] -- ^ The primop arguments -> Maybe ([LocalReg] -> FCode ()) -shouldInlinePrimOp dflags NewByteArrayOp_Char [(CmmLit (CmmInt n _))] - | fromInteger n <= maxInlineAllocSize dflags = +shouldInlinePrimOp dflags NewByteArrayOp_Char [(CmmLit (CmmInt n w))] + | asUnsigned w n <= fromIntegral (maxInlineAllocSize dflags) = Just $ \ [res] -> doNewByteArrayOp res (fromInteger n) -shouldInlinePrimOp dflags NewArrayOp [(CmmLit (CmmInt n _)), init] - | wordsToBytes dflags (fromInteger n) <= maxInlineAllocSize dflags = +shouldInlinePrimOp dflags NewArrayOp [(CmmLit (CmmInt n w)), init] + | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) = Just $ \ [res] -> doNewArrayOp res (arrPtrsRep dflags (fromInteger n)) mkMAP_DIRTY_infoLabel [ (mkIntExpr dflags (fromInteger n), @@ -166,24 +182,24 @@ shouldInlinePrimOp _ CopyMutableArrayArrayOp [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] = Just $ \ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n) -shouldInlinePrimOp dflags CloneArrayOp [src, src_off, (CmmLit (CmmInt n _))] - | wordsToBytes dflags (fromInteger n) <= maxInlineAllocSize dflags = +shouldInlinePrimOp dflags CloneArrayOp [src, src_off, (CmmLit (CmmInt n w))] + | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) = Just $ \ [res] -> emitCloneArray mkMAP_FROZEN_infoLabel res src src_off (fromInteger n) -shouldInlinePrimOp dflags CloneMutableArrayOp [src, src_off, (CmmLit (CmmInt n _))] - | wordsToBytes dflags (fromInteger n) <= maxInlineAllocSize dflags = +shouldInlinePrimOp dflags CloneMutableArrayOp [src, src_off, (CmmLit (CmmInt n w))] + | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) = Just $ \ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n) -shouldInlinePrimOp dflags FreezeArrayOp [src, src_off, (CmmLit (CmmInt n _))] - | wordsToBytes dflags (fromInteger n) <= maxInlineAllocSize dflags = +shouldInlinePrimOp dflags FreezeArrayOp [src, src_off, (CmmLit (CmmInt n w))] + | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) = Just $ \ [res] -> emitCloneArray mkMAP_FROZEN_infoLabel res src src_off (fromInteger n) -shouldInlinePrimOp dflags ThawArrayOp [src, src_off, (CmmLit (CmmInt n _))] - | wordsToBytes dflags (fromInteger n) <= maxInlineAllocSize dflags = +shouldInlinePrimOp dflags ThawArrayOp [src, src_off, (CmmLit (CmmInt n w))] + | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) = Just $ \ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n) -shouldInlinePrimOp dflags NewSmallArrayOp [(CmmLit (CmmInt n _)), init] - | wordsToBytes dflags (fromInteger n) <= maxInlineAllocSize dflags = +shouldInlinePrimOp dflags NewSmallArrayOp [(CmmLit (CmmInt n w)), init] + | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) = Just $ \ [res] -> doNewArrayOp res (smallArrPtrsRep (fromInteger n)) mkSMAP_DIRTY_infoLabel [ (mkIntExpr dflags (fromInteger n), @@ -199,20 +215,20 @@ shouldInlinePrimOp _ CopySmallMutableArrayOp [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] = Just $ \ [] -> doCopySmallMutableArrayOp src src_off dst dst_off (fromInteger n) -shouldInlinePrimOp dflags CloneSmallArrayOp [src, src_off, (CmmLit (CmmInt n _))] - | wordsToBytes dflags (fromInteger n) <= maxInlineAllocSize dflags = +shouldInlinePrimOp dflags CloneSmallArrayOp [src, src_off, (CmmLit (CmmInt n w))] + | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) = Just $ \ [res] -> emitCloneSmallArray mkSMAP_FROZEN_infoLabel res src src_off (fromInteger n) -shouldInlinePrimOp dflags CloneSmallMutableArrayOp [src, src_off, (CmmLit (CmmInt n _))] - | wordsToBytes dflags (fromInteger n) <= maxInlineAllocSize dflags = +shouldInlinePrimOp dflags CloneSmallMutableArrayOp [src, src_off, (CmmLit (CmmInt n w))] + | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) = Just $ \ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n) -shouldInlinePrimOp dflags FreezeSmallArrayOp [src, src_off, (CmmLit (CmmInt n _))] - | wordsToBytes dflags (fromInteger n) <= maxInlineAllocSize dflags = +shouldInlinePrimOp dflags FreezeSmallArrayOp [src, src_off, (CmmLit (CmmInt n w))] + | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) = Just $ \ [res] -> emitCloneSmallArray mkSMAP_FROZEN_infoLabel res src src_off (fromInteger n) -shouldInlinePrimOp dflags ThawSmallArrayOp [src, src_off, (CmmLit (CmmInt n _))] - | wordsToBytes dflags (fromInteger n) <= maxInlineAllocSize dflags = +shouldInlinePrimOp dflags ThawSmallArrayOp [src, src_off, (CmmLit (CmmInt n w))] + | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) = Just $ \ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n) shouldInlinePrimOp dflags primop args From git at git.haskell.org Wed Aug 13 14:33:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Aug 2014 14:33:30 +0000 (UTC) Subject: [commit: ghc] master: Have ghc-pkg use an old-style package key when it's not provided. (5e46e1f) Message-ID: <20140813143330.8C1E324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5e46e1f5323a7fc09e9bbd9023d5c63e144e1ad3/ghc >--------------------------------------------------------------- commit 5e46e1f5323a7fc09e9bbd9023d5c63e144e1ad3 Author: Edward Z. Yang Date: Wed Aug 13 14:04:10 2014 +0100 Have ghc-pkg use an old-style package key when it's not provided. Summary: When this occurs, it means that the user is using an old version of Cabal. In that case, don't barf out: just go ahead and install it as an old-style package key. The user won't be able to link multiple versions together, but that should not be a problem because their Cabal can't handle it anyway. What happens if old-style are mixed up with new-style? Well, currently with Cabal, it's indistinguishable. However, if at some later point we add private dependencies, libraries compiled with old style linker names are incompatible with each other. We'll cross that road when we come to it. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: tibbe, hvr, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D154 >--------------------------------------------------------------- 5e46e1f5323a7fc09e9bbd9023d5c63e144e1ad3 utils/ghc-pkg/Main.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 970ab67..c88b814 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -916,7 +916,7 @@ parsePackageInfo -> IO (InstalledPackageInfo, [ValidateWarning]) parsePackageInfo str = case parseInstalledPackageInfo str of - ParseOk warnings ok -> return (ok, ws) + ParseOk warnings ok -> return (mungePackageInfo ok, ws) where ws = [ msg | PWarning msg <- warnings , not ("Unrecognized field pkgroot" `isPrefixOf` msg) ] @@ -924,6 +924,14 @@ parsePackageInfo str = (Nothing, s) -> die s (Just l, s) -> die (show l ++ ": " ++ s) +mungePackageInfo :: InstalledPackageInfo -> InstalledPackageInfo +mungePackageInfo ipi = ipi { packageKey = packageKey' } + where + packageKey' + | OldPackageKey (PackageIdentifier (PackageName "") _) <- packageKey ipi + = OldPackageKey (sourcePackageId ipi) + | otherwise = packageKey ipi + -- | Takes the "reexported-modules" field of an InstalledPackageInfo -- and resolves the references so they point to the original exporter -- of a module (i.e. the module is in exposed-modules, not From git at git.haskell.org Wed Aug 13 14:33:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Aug 2014 14:33:32 +0000 (UTC) Subject: [commit: ghc] master: Explicitly version test for package key support. (2272c50) Message-ID: <20140813143333.29E9124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2272c50a61c3dc43edf35b3eeb7997cc0f47eaf3/ghc >--------------------------------------------------------------- commit 2272c50a61c3dc43edf35b3eeb7997cc0f47eaf3 Author: Edward Z. Yang Date: Wed Aug 13 11:30:26 2014 +0100 Explicitly version test for package key support. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 2272c50a61c3dc43edf35b3eeb7997cc0f47eaf3 configure.ac | 5 +++++ mk/config.mk.in | 2 ++ rules/distdir-way-opts.mk | 8 +++++++- 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 533ea29..378578a 100644 --- a/configure.ac +++ b/configure.ac @@ -162,6 +162,11 @@ FP_COMPARE_VERSIONS([$GhcVersion],[-gt],[7.7], CMM_SINK_BOOTSTRAP_IS_NEEDED=NO) AC_SUBST(CMM_SINK_BOOTSTRAP_IS_NEEDED) +FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[7.9], + SUPPORTS_PACKAGE_KEY=NO, + SUPPORTS_PACKAGE_KEY=YES) +AC_SUBST(SUPPORTS_PACKAGE_KEY) + # GHC is passed to Cabal, so we need a native path if test "${WithGhc}" != "" then diff --git a/mk/config.mk.in b/mk/config.mk.in index d26684e..c210cd3 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -484,6 +484,8 @@ GHC_PACKAGE_DB_FLAG = @GHC_PACKAGE_DB_FLAG@ CMM_SINK_BOOTSTRAP_IS_NEEDED = @CMM_SINK_BOOTSTRAP_IS_NEEDED@ +SUPPORTS_PACKAGE_KEY = @SUPPORTS_PACKAGE_KEY@ + #----------------------------------------------------------------------------- # C compiler # diff --git a/rules/distdir-way-opts.mk b/rules/distdir-way-opts.mk index 898485c..0a6d84e 100644 --- a/rules/distdir-way-opts.mk +++ b/rules/distdir-way-opts.mk @@ -81,9 +81,15 @@ define distdir-way-opts # args: $1 = dir, $2 = distdir, $3 = way, $4 = stage # $1_$2_$3_MOST_HC_OPTS is also passed to C compilations when we use # GHC as the C compiler. +ifeq "$(SUPPORTS_PACKAGE_KEY)" "NO" +ifeq "$4" "0" +$4_USE_PACKAGE_KEY=NO +endif +endif + # ToDo: It would be more accurate to version test this against what version of # GHC we're using to see if it understands package-key -ifeq "$4" "0" +ifeq "$($4_USE_PACKAGE_KEY)" "NO" $1_$2_$4_DEP_OPTS = \ $$(foreach pkg,$$($1_$2_DEPS),-package $$(pkg)) $4_THIS_PACKAGE_KEY = -package-name From git at git.haskell.org Wed Aug 13 16:00:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Aug 2014 16:00:37 +0000 (UTC) Subject: [commit: ghc] master: Remove out of date TODO (6b5ea61) Message-ID: <20140813160037.3A3E424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6b5ea617dcd162e682886d5843df51a2866218d3/ghc >--------------------------------------------------------------- commit 6b5ea617dcd162e682886d5843df51a2866218d3 Author: Edward Z. Yang Date: Wed Aug 13 17:00:20 2014 +0100 Remove out of date TODO Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 6b5ea617dcd162e682886d5843df51a2866218d3 rules/distdir-way-opts.mk | 2 -- 1 file changed, 2 deletions(-) diff --git a/rules/distdir-way-opts.mk b/rules/distdir-way-opts.mk index 0a6d84e..99f7ce9 100644 --- a/rules/distdir-way-opts.mk +++ b/rules/distdir-way-opts.mk @@ -87,8 +87,6 @@ $4_USE_PACKAGE_KEY=NO endif endif -# ToDo: It would be more accurate to version test this against what version of -# GHC we're using to see if it understands package-key ifeq "$($4_USE_PACKAGE_KEY)" "NO" $1_$2_$4_DEP_OPTS = \ $$(foreach pkg,$$($1_$2_DEPS),-package $$(pkg)) From git at git.haskell.org Thu Aug 14 10:29:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Aug 2014 10:29:44 +0000 (UTC) Subject: [commit: ghc] master: Implement new CLZ and CTZ primops (re #9340) (e0c1767) Message-ID: <20140814102944.5EF0E24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e0c1767d0ea8d12e0a4badf43682a08784e379c6/ghc >--------------------------------------------------------------- commit e0c1767d0ea8d12e0a4badf43682a08784e379c6 Author: Herbert Valerio Riedel Date: Mon Aug 11 18:56:57 2014 +0200 Implement new CLZ and CTZ primops (re #9340) This implements the new primops clz#, clz32#, clz64#, ctz#, ctz32#, ctz64# which provide efficient implementations of the popular count-leading-zero and count-trailing-zero respectively (see testcase for a pure Haskell reference implementation). On x86, NCG as well as LLVM generates code based on the BSF/BSR instructions (which need extra logic to make the 0-case well-defined). Test Plan: validate and succesful tests on i686 and amd64 Reviewers: rwbarton, simonmar, ezyang, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D144 GHC Trac Issues: #9340 >--------------------------------------------------------------- e0c1767d0ea8d12e0a4badf43682a08784e379c6 compiler/cmm/CmmMachOp.hs | 3 + compiler/cmm/PprC.hs | 2 + compiler/codeGen/StgCmmPrim.hs | 28 ++++++++ compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 9 ++- compiler/nativeGen/CPrim.hs | 20 ++++++ compiler/nativeGen/PPC/CodeGen.hs | 2 + compiler/nativeGen/SPARC/CodeGen.hs | 2 + compiler/nativeGen/X86/CodeGen.hs | 65 +++++++++++++++++ compiler/prelude/primops.txt.pp | 22 ++++++ includes/stg/Prim.h | 12 ++++ libraries/ghc-prim/cbits/clz.c | 41 +++++++++++ libraries/ghc-prim/cbits/ctz.c | 41 +++++++++++ libraries/ghc-prim/ghc-prim.cabal | 2 + testsuite/.gitignore | 1 + testsuite/tests/codeGen/should_run/T9340.hs | 96 +++++++++++++++++++++++++ testsuite/tests/codeGen/should_run/T9340.stdout | 1 + testsuite/tests/codeGen/should_run/all.T | 1 + 17 files changed, 347 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 e0c1767d0ea8d12e0a4badf43682a08784e379c6 From git at git.haskell.org Thu Aug 14 17:53:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Aug 2014 17:53:59 +0000 (UTC) Subject: [commit: ghc] master: Declare `ghc-head` to be haddock's upstream branch (03a8003) Message-ID: <20140814175359.AA7C024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/03a8003e5d3aec97b3a14b2d3c774aad43e0456e/ghc >--------------------------------------------------------------- commit 03a8003e5d3aec97b3a14b2d3c774aad43e0456e Author: Herbert Valerio Riedel Date: Thu Aug 14 19:51:01 2014 +0200 Declare `ghc-head` to be haddock's upstream branch This will affect commands such as git submodule update --remote utils/haddock to use `ghc-head` instead of the default `master` branch >--------------------------------------------------------------- 03a8003e5d3aec97b3a14b2d3c774aad43e0456e .gitmodules | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitmodules b/.gitmodules index b5e29b9..66f4f37 100644 --- a/.gitmodules +++ b/.gitmodules @@ -118,6 +118,7 @@ path = utils/haddock url = ../haddock.git ignore = none + branch = ghc-head [submodule "nofib"] path = nofib url = ../nofib.git From git at git.haskell.org Fri Aug 15 15:56:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Aug 2014 15:56:14 +0000 (UTC) Subject: [commit: ghc] master: LlvmMangler: Be more selective when mangling object types (5895f2b) Message-ID: <20140815155614.8B13024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5895f2b8ffba72a8393e9f712461e6e5ed7ceced/ghc >--------------------------------------------------------------- commit 5895f2b8ffba72a8393e9f712461e6e5ed7ceced Author: Ben Gamari Date: Fri Aug 15 11:11:17 2014 -0400 LlvmMangler: Be more selective when mangling object types Summary: We previously did a wholesale replace of `%function` to `%object` to mangle object `.type` annotations. This is bad as it can end up replacing appearances of `"%function"` in the user's code. We now look for a proper `.type` keyword before performing the replacement. Thanks to @rwbarton for pointing out the bug. Test Plan: Previously, $ echo 'main = putStrLn "@function"' > test.hs $ ghc -fllvm test.hs $ ./test @object Now, $ echo 'main = putStrLn "@function"' > test.hs $ ghc -fllvm test.hs $ ./test @function Reviewers: rwbarton, austin Reviewed By: rwbarton, austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D150 GHC Trac Issues: #9439 >--------------------------------------------------------------- 5895f2b8ffba72a8393e9f712461e6e5ed7ceced compiler/llvmGen/LlvmMangler.hs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/compiler/llvmGen/LlvmMangler.hs b/compiler/llvmGen/LlvmMangler.hs index 7084a2e..8652a89 100644 --- a/compiler/llvmGen/LlvmMangler.hs +++ b/compiler/llvmGen/LlvmMangler.hs @@ -58,13 +58,23 @@ llvmFixupAsm dflags f1 f2 = {-# SCC "llvm_mangler" #-} do hClose w return () +-- | This rewrites @.type@ annotations of function symbols to @%object at . +-- This is done as the linker can relocate @%functions@ through the +-- Procedure Linking Table (PLT). This is bad since we expect that the +-- info table will appear directly before the symbol's location. In the +-- case that the PLT is used, this will be not an info table but instead +-- some random PLT garbage. rewriteSymType :: B.ByteString -> B.ByteString rewriteSymType s = - foldl (\s' (typeFunc,typeObj)->replace typeFunc typeObj s') s types + B.unlines $ map (rewrite '@' . rewrite '%') $ B.lines s where - types = [ (B.pack "@function", B.pack "@object") - , (B.pack "%function", B.pack "%object") - ] + rewrite :: Char -> B.ByteString -> B.ByteString + rewrite prefix x + | isType x = replace funcType objType x + | otherwise = x + where + funcType = prefix `B.cons` B.pack "function" + objType = prefix `B.cons` B.pack "object" -- | Splits the file contents into its sections readSections :: Handle -> Handle -> IO [Section] From git at git.haskell.org Fri Aug 15 16:20:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Aug 2014 16:20:02 +0000 (UTC) Subject: [commit: ghc] master: Make configure's sed(1) expression for GHC_LDFLAGS more BSD-friendly. (d39c434) Message-ID: <20140815162002.3BA1A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d39c434a9518b7376857be88503055ecb7d0fe1f/ghc >--------------------------------------------------------------- commit d39c434a9518b7376857be88503055ecb7d0fe1f Author: Gabor Pali Date: Fri Aug 15 16:45:18 2014 +0100 Make configure's sed(1) expression for GHC_LDFLAGS more BSD-friendly. >--------------------------------------------------------------- d39c434a9518b7376857be88503055ecb7d0fe1f aclocal.m4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aclocal.m4 b/aclocal.m4 index fbd82d9..d3a32b8 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1832,7 +1832,7 @@ AC_MSG_NOTICE(Building in-tree ghc-pwd) dnl If special linker flags are needed to build things, then allow dnl the user to pass them in via LDFLAGS. changequote(, )dnl - GHC_LDFLAGS=`echo $LDFLAGS | sed 's/\(^\| \)\([^ ]\)/\1-optl\2/g'` + GHC_LDFLAGS=`echo $LDFLAGS | sed -r 's/(^| )([^ ])/\1-optl\2/g'` changequote([, ])dnl if ! "$WithGhc" $GHC_LDFLAGS -v0 -no-user-$GHC_PACKAGE_DB_FLAG -hidir utils/ghc-pwd/dist-boot -odir utils/ghc-pwd/dist-boot -stubdir utils/ghc-pwd/dist-boot --make utils/ghc-pwd/Main.hs -o utils/ghc-pwd/dist-boot/ghc-pwd then From git at git.haskell.org Sat Aug 16 08:28:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Aug 2014 08:28:20 +0000 (UTC) Subject: [commit: ghc] wip/T8584: #TEMP Just stashing everything in case someone wants to look at it (4e885fd) Message-ID: <20140816082821.256292406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/4e885fd828f2c9e91cfc6e3e27649adc4293ae22/ghc >--------------------------------------------------------------- commit 4e885fd828f2c9e91cfc6e3e27649adc4293ae22 Author: Dr. ERDI Gergo Date: Sat Aug 16 16:28:03 2014 +0800 #TEMP Just stashing everything in case someone wants to look at it >--------------------------------------------------------------- 4e885fd828f2c9e91cfc6e3e27649adc4293ae22 compiler/typecheck/TcBinds.lhs | 15 +++++-- compiler/typecheck/TcPatSyn.lhs | 94 ++++++++++++++++++++++++++++++----------- 2 files changed, 80 insertions(+), 29 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4e885fd828f2c9e91cfc6e3e27649adc4293ae22 From git at git.haskell.org Sat Aug 16 08:28:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Aug 2014 08:28:17 +0000 (UTC) Subject: [commit: ghc] wip/T8584: Show foralls (when requested) in pattern synonym types (3453b9c) Message-ID: <20140816082821.159D424123@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/3453b9c2f101eea1154809b180e9637c0df326b6/ghc >--------------------------------------------------------------- commit 3453b9c2f101eea1154809b180e9637c0df326b6 Author: Dr. ERDI Gergo Date: Sun Aug 3 15:26:13 2014 +0200 Show foralls (when requested) in pattern synonym types >--------------------------------------------------------------- 3453b9c2f101eea1154809b180e9637c0df326b6 compiler/hsSyn/HsBinds.lhs | 21 ++++++--------------- compiler/iface/IfaceSyn.lhs | 9 +++++---- 2 files changed, 11 insertions(+), 19 deletions(-) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index 673a269..74b5187 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -710,24 +710,18 @@ ppr_sig (SpecSig var ty inl) = pragBrackets (pprSpec (unLoc var) (ppr ty) i ppr_sig (InlineSig var inl) = pragBrackets (ppr inl <+> pprPrefixOcc (unLoc var)) ppr_sig (SpecInstSig ty) = pragBrackets (ptext (sLit "SPECIALIZE instance") <+> ppr ty) ppr_sig (MinimalSig bf) = pragBrackets (pprMinimalSig bf) -ppr_sig (PatSynSig name arg_tys ty (_, _, prov) (_, _, req)) +ppr_sig (PatSynSig name arg_tys ty prov req) = pprPatSynSig (unLoc name) False args (ppr ty) (pprCtx prov) (pprCtx req) where args = fmap ppr arg_tys - pprCtx lctx = case unLoc lctx of - [] -> Nothing - ctx -> Just (pprHsContextNoArrow ctx) + pprCtx (flag, tvs, lctx) = pprHsForAll flag tvs lctx pprPatSynSig :: (OutputableBndr a) - => a -> Bool -> HsPatSynDetails SDoc -> SDoc -> Maybe SDoc -> Maybe SDoc -> SDoc -pprPatSynSig ident is_bidir args rhs_ty prov_theta req_theta - = sep [ ptext (sLit "pattern") - , ptext (sLit "type") - , thetaOpt prov_theta, name_and_args - , colon - , thetaOpt req_theta, rhs_ty - ] + => a -> Bool -> HsPatSynDetails SDoc -> SDoc -> SDoc -> SDoc -> SDoc +pprPatSynSig ident is_bidir args rhs_ty prov req + = ptext (sLit "pattern type") <+> + prov <+> name_and_args <+> colon <+> req <+> rhs_ty where name_and_args = case args of PrefixPatSyn arg_tys -> @@ -735,9 +729,6 @@ pprPatSynSig ident is_bidir args rhs_ty prov_theta req_theta InfixPatSyn left_ty right_ty -> left_ty <+> pprInfixOcc ident <+> right_ty - -- TODO: support explicit foralls - thetaOpt = maybe empty (<+> darrow) - colon = if is_bidir then dcolon else dcolon -- TODO instance OutputableBndr name => Outputable (FixitySig name) where diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index 935b8ed..e595266 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -771,11 +771,13 @@ pprIfaceDecl ss (IfaceSyn { ifName = tycon, ifTyVars = tyvars pprIfaceDecl _ (IfacePatSyn { ifName = name, ifPatWrapper = wrapper, ifPatIsInfix = is_infix, - ifPatUnivTvs = _univ_tvs, ifPatExTvs = _ex_tvs, + ifPatUnivTvs = univ_tvs, ifPatExTvs = ex_tvs, ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt, ifPatArgs = args, ifPatTy = ty }) - = pprPatSynSig name has_wrap args' ty' (pprCtxt prov_ctxt) (pprCtxt req_ctxt) + = pprPatSynSig name has_wrap args' ty' + (pprCtxt ex_tvs prov_ctxt) + (pprCtxt univ_tvs req_ctxt) where has_wrap = isJust wrapper args' = case (is_infix, args) of @@ -786,8 +788,7 @@ pprIfaceDecl _ (IfacePatSyn { ifName = name, ifPatWrapper = wrapper, ty' = pprParendIfaceType ty - pprCtxt [] = Nothing - pprCtxt ctxt = Just $ pprIfaceContext ctxt + pprCtxt tvs ctxt = pprIfaceForAllPart tvs ctxt empty pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty, ifIdDetails = details, ifIdInfo = info }) From git at git.haskell.org Sat Aug 16 14:04:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Aug 2014 14:04:42 +0000 (UTC) Subject: [commit: ghc] master: Implement {resize, shrink}MutableByteArray# primops (246436f) Message-ID: <20140816140443.15AEF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/246436f13739593d2a211ceb830393338118ca4d/ghc >--------------------------------------------------------------- commit 246436f13739593d2a211ceb830393338118ca4d Author: Herbert Valerio Riedel Date: Sat Aug 16 09:49:30 2014 +0200 Implement {resize,shrink}MutableByteArray# primops The two new primops with the type-signatures resizeMutableByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #) shrinkMutableByteArray# :: MutableByteArray# s -> Int# -> State# s -> State# s allow to resize MutableByteArray#s in-place (when possible), and are useful for algorithms where memory is temporarily over-allocated. The motivating use-case is for implementing integer backends, where the final target size of the result is either N or N+1, and only known after the operation has been performed. A future commit will implement a stateful variant of the `sizeofMutableByteArray#` operation (see #9447 for details), since now the size of a `MutableByteArray#` may change over its lifetime (i.e before it gets frozen or GCed). Test Plan: ./validate --slow Reviewers: ezyang, austin, simonmar Reviewed By: austin, simonmar Differential Revision: https://phabricator.haskell.org/D133 >--------------------------------------------------------------- 246436f13739593d2a211ceb830393338118ca4d compiler/prelude/primops.txt.pp | 24 ++++++++++++++++ includes/Cmm.h | 3 ++ includes/rts/storage/ClosureMacros.h | 33 ++++++++++++++++++++++ includes/stg/MiscClosures.h | 2 ++ rts/Linker.c | 2 ++ rts/PrimOps.cmm | 54 ++++++++++++++++++++++++++++++++++++ 6 files changed, 118 insertions(+) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 6844f42..d5566fe 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -1074,6 +1074,30 @@ primop ByteArrayContents_Char "byteArrayContents#" GenPrimOp primop SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp MutableByteArray# s -> MutableByteArray# s -> Int# +primop ShrinkMutableByteArrayOp_Char "shrinkMutableByteArray#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> State# s + {Shrink mutable byte array to new specified size (in bytes), in + the specified state thread. The new size argument must be less than or + equal to the current size as reported by {\tt sizeofMutableArray\#}.} + with out_of_line = True + has_side_effects = True + +primop ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #) + {Resize (unpinned) mutable byte array to new specified size (in bytes). + The returned {\tt MutableByteArray\#} is either the original + {\tt MutableByteArray\#} resized in-place or, if not possible, a newly + allocated (unpinned) {\tt MutableByteArray\#} (with the original content + copied over). + + To avoid undefined behaviour, the original {\tt MutableByteArray\#} shall + not be accessed anymore after a {\tt resizeMutableByteArray\#} has been + performed. Moreover, no reference to the old one should be kept in order + to allow garbage collection of the original {\tt MutableByteArray\#} in + case a new {\tt MutableByteArray\#} had to be allocated.} + with out_of_line = True + has_side_effects = True + primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp MutableByteArray# s -> State# s -> (# State# s, ByteArray# #) {Make a mutable byte array immutable, without copying.} diff --git a/includes/Cmm.h b/includes/Cmm.h index 24bdda3..e62e96f 100644 --- a/includes/Cmm.h +++ b/includes/Cmm.h @@ -600,8 +600,11 @@ #if defined(PROFILING) || (!defined(THREADED_RTS) && defined(DEBUG)) #define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr") +#define OVERWRITING_CLOSURE_OFS(c,n) \ + foreign "C" overwritingClosureOfs(c "ptr", n) #else #define OVERWRITING_CLOSURE(c) /* nothing */ +#define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */ #endif #ifdef THREADED_RTS diff --git a/includes/rts/storage/ClosureMacros.h b/includes/rts/storage/ClosureMacros.h index 3407b71..2a0f197 100644 --- a/includes/rts/storage/ClosureMacros.h +++ b/includes/rts/storage/ClosureMacros.h @@ -504,8 +504,11 @@ INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n) #if ZERO_SLOP_FOR_LDV_PROF || ZERO_SLOP_FOR_SANITY_CHECK #define OVERWRITING_CLOSURE(c) overwritingClosure(c) +#define OVERWRITING_CLOSURE_OFS(c,n) \ + overwritingClosureOfs(c,n) #else #define OVERWRITING_CLOSURE(c) /* nothing */ +#define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */ #endif #ifdef PROFILING @@ -534,4 +537,34 @@ EXTERN_INLINE void overwritingClosure (StgClosure *p) } } +// Version of 'overwritingClosure' which overwrites only a suffix of a +// closure. The offset is expressed in words relative to 'p' and shall +// be less than or equal to closure_sizeW(p), and usually at least as +// large as the respective thunk header. +// +// Note: As this calls LDV_recordDead() you have to call LDV_RECORD() +// on the final state of the closure at the call-site +EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, nat offset); +EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, nat offset) +{ + nat size, i; + +#if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK + // see Note [zeroing slop], also #8402 + if (era <= 0) return; +#endif + + size = closure_sizeW(p); + + ASSERT(offset <= size); + + // For LDV profiling, we need to record the closure as dead +#if defined(PROFILING) + LDV_recordDead(p, size); +#endif + + for (i = offset; i < size; i++) + ((StgWord *)p)[i] = 0; +} + #endif /* RTS_STORAGE_CLOSUREMACROS_H */ diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index ee5a119..d2b933d 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -347,6 +347,8 @@ RTS_FUN_DECL(stg_casArrayzh); RTS_FUN_DECL(stg_newByteArrayzh); RTS_FUN_DECL(stg_newPinnedByteArrayzh); RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh); +RTS_FUN_DECL(stg_shrinkMutableByteArrayzh); +RTS_FUN_DECL(stg_resizzeMutableByteArrayzh); RTS_FUN_DECL(stg_casIntArrayzh); RTS_FUN_DECL(stg_newArrayzh); RTS_FUN_DECL(stg_newArrayArrayzh); diff --git a/rts/Linker.c b/rts/Linker.c index 480dc2a..a0ad90c 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1194,6 +1194,8 @@ typedef struct _RtsSymbolVal { SymI_HasProto(stg_casMutVarzh) \ SymI_HasProto(stg_newPinnedByteArrayzh) \ SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \ + SymI_HasProto(stg_shrinkMutableByteArrayzh) \ + SymI_HasProto(stg_resizzeMutableByteArrayzh) \ SymI_HasProto(newSpark) \ SymI_HasProto(performGC) \ SymI_HasProto(performMajorGC) \ diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 5f04a6d..ee50f7f 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -137,6 +137,60 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment ) return (p); } +// shrink size of MutableByteArray in-place +stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size ) +// MutableByteArray# s -> Int# -> State# s -> State# s +{ + ASSERT(new_size >= 0); + ASSERT(new_size <= StgArrWords_bytes(mba)); + + OVERWRITING_CLOSURE_OFS(mba, (BYTES_TO_WDS(SIZEOF_StgArrWords) + + ROUNDUP_BYTES_TO_WDS(new_size))); + StgArrWords_bytes(mba) = new_size; + LDV_RECORD_CREATE(mba); + + return (); +} + +// resize MutableByteArray +// +// The returned MutableByteArray is either the original +// MutableByteArray resized in-place or, if not possible, a newly +// allocated (unpinned) MutableByteArray (with the original content +// copied over) +stg_resizzeMutableByteArrayzh ( gcptr mba, W_ new_size ) +// MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #) +{ + W_ new_size_wds; + + ASSERT(new_size >= 0); + + new_size_wds = ROUNDUP_BYTES_TO_WDS(new_size); + + if (new_size_wds <= BYTE_ARR_WDS(mba)) { + OVERWRITING_CLOSURE_OFS(mba, (BYTES_TO_WDS(SIZEOF_StgArrWords) + + new_size_wds)); + StgArrWords_bytes(mba) = new_size; + LDV_RECORD_CREATE(mba); + + return (mba); + } else { + (P_ new_mba) = call stg_newByteArrayzh(new_size); + + // maybe at some point in the future we may be able to grow the + // MBA in-place w/o copying if we know the space after the + // current MBA is still available, as often we want to grow the + // MBA shortly after we allocated the original MBA. So maybe no + // further allocations have occurred by then. + + // copy over old content + prim %memcpy(BYTE_ARR_CTS(new_mba), BYTE_ARR_CTS(mba), + StgArrWords_bytes(mba), WDS(1)); + + return (new_mba); + } +} + // RRN: This one does not use the "ticketing" approach because it // deals in unboxed scalars, not heap pointers. stg_casIntArrayzh( gcptr arr, W_ ind, W_ old, W_ new ) From git at git.haskell.org Sat Aug 16 17:12:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Aug 2014 17:12:57 +0000 (UTC) Subject: [commit: ghc] master: Fix typos 'resizze' (425d517) Message-ID: <20140816171257.5BEF624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/425d5178af55620efa00e6e16426f491c63ad533/ghc >--------------------------------------------------------------- commit 425d5178af55620efa00e6e16426f491c63ad533 Author: Gabor Greif Date: Sat Aug 16 19:10:46 2014 +0200 Fix typos 'resizze' >--------------------------------------------------------------- 425d5178af55620efa00e6e16426f491c63ad533 includes/stg/MiscClosures.h | 2 +- rts/Linker.c | 2 +- rts/PrimOps.cmm | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index d2b933d..e714be3 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -348,7 +348,7 @@ RTS_FUN_DECL(stg_newByteArrayzh); RTS_FUN_DECL(stg_newPinnedByteArrayzh); RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh); RTS_FUN_DECL(stg_shrinkMutableByteArrayzh); -RTS_FUN_DECL(stg_resizzeMutableByteArrayzh); +RTS_FUN_DECL(stg_resizeMutableByteArrayzh); RTS_FUN_DECL(stg_casIntArrayzh); RTS_FUN_DECL(stg_newArrayzh); RTS_FUN_DECL(stg_newArrayArrayzh); diff --git a/rts/Linker.c b/rts/Linker.c index a0ad90c..e3ee085 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1195,7 +1195,7 @@ typedef struct _RtsSymbolVal { SymI_HasProto(stg_newPinnedByteArrayzh) \ SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \ SymI_HasProto(stg_shrinkMutableByteArrayzh) \ - SymI_HasProto(stg_resizzeMutableByteArrayzh) \ + SymI_HasProto(stg_resizeMutableByteArrayzh) \ SymI_HasProto(newSpark) \ SymI_HasProto(performGC) \ SymI_HasProto(performMajorGC) \ diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index ee50f7f..bcd9c93 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -158,7 +158,7 @@ stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size ) // MutableByteArray resized in-place or, if not possible, a newly // allocated (unpinned) MutableByteArray (with the original content // copied over) -stg_resizzeMutableByteArrayzh ( gcptr mba, W_ new_size ) +stg_resizeMutableByteArrayzh ( gcptr mba, W_ new_size ) // MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #) { W_ new_size_wds; From git at git.haskell.org Sat Aug 16 17:23:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Aug 2014 17:23:58 +0000 (UTC) Subject: [commit: ghc] master: Revert "Fix typos 'resizze'" this is z-encoding (as hvr tells me) (53cc943) Message-ID: <20140816172358.DB09824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/53cc943a62d790e5381133f95fd1994cd7a805aa/ghc >--------------------------------------------------------------- commit 53cc943a62d790e5381133f95fd1994cd7a805aa Author: Gabor Greif Date: Sat Aug 16 19:20:18 2014 +0200 Revert "Fix typos 'resizze'" this is z-encoding (as hvr tells me) This reverts commit 425d5178af55620efa00e6e16426f491c63ad533. >--------------------------------------------------------------- 53cc943a62d790e5381133f95fd1994cd7a805aa includes/stg/MiscClosures.h | 2 +- rts/Linker.c | 2 +- rts/PrimOps.cmm | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index e714be3..d2b933d 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -348,7 +348,7 @@ RTS_FUN_DECL(stg_newByteArrayzh); RTS_FUN_DECL(stg_newPinnedByteArrayzh); RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh); RTS_FUN_DECL(stg_shrinkMutableByteArrayzh); -RTS_FUN_DECL(stg_resizeMutableByteArrayzh); +RTS_FUN_DECL(stg_resizzeMutableByteArrayzh); RTS_FUN_DECL(stg_casIntArrayzh); RTS_FUN_DECL(stg_newArrayzh); RTS_FUN_DECL(stg_newArrayArrayzh); diff --git a/rts/Linker.c b/rts/Linker.c index e3ee085..a0ad90c 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1195,7 +1195,7 @@ typedef struct _RtsSymbolVal { SymI_HasProto(stg_newPinnedByteArrayzh) \ SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \ SymI_HasProto(stg_shrinkMutableByteArrayzh) \ - SymI_HasProto(stg_resizeMutableByteArrayzh) \ + SymI_HasProto(stg_resizzeMutableByteArrayzh) \ SymI_HasProto(newSpark) \ SymI_HasProto(performGC) \ SymI_HasProto(performMajorGC) \ diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index bcd9c93..ee50f7f 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -158,7 +158,7 @@ stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size ) // MutableByteArray resized in-place or, if not possible, a newly // allocated (unpinned) MutableByteArray (with the original content // copied over) -stg_resizeMutableByteArrayzh ( gcptr mba, W_ new_size ) +stg_resizzeMutableByteArrayzh ( gcptr mba, W_ new_size ) // MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #) { W_ new_size_wds; From git at git.haskell.org Sat Aug 16 21:19:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Aug 2014 21:19:01 +0000 (UTC) Subject: [commit: ghc] wip/T9281: Implement `decodeDouble_Int64#` primop (72a94c1) Message-ID: <20140816211901.8E65C24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9281 Link : http://ghc.haskell.org/trac/ghc/changeset/72a94c18818eeaa65a995fd526999c4c837ce3c2/ghc >--------------------------------------------------------------- commit 72a94c18818eeaa65a995fd526999c4c837ce3c2 Author: Herbert Valerio Riedel Date: Sat Aug 16 00:46:18 2014 +0200 Implement `decodeDouble_Int64#` primop Summary: The existing `decodeDouble_2Int#` primop is rather inconvenient to use (and in fact is not even used by `integer-gmp`) as the mantissa is split into 3 components which would actually fit in an `Int64#` value. However, `decodeDouble_Int64#` is to be used by the new `integer-gmp2` re-implementation (see #9281). Moreover, `decodeDouble_2Int#` performs direct bit-wise operations on the IEEE representation which can be replaced by a combination of the portable standard C99 `scalbn(3)` and `frexp(3)` functions. Test Plan: tested via `integer-gmp2` Reviewers: simonmar, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D160 GHC Trac Issues: #9281 >--------------------------------------------------------------- 72a94c18818eeaa65a995fd526999c4c837ce3c2 compiler/prelude/primops.txt.pp | 5 +++++ includes/stg/MiscClosures.h | 1 + rts/Linker.c | 1 + rts/PrimOps.cmm | 17 +++++++++++++++++ rts/StgPrimFloat.c | 18 ++++++++++++++++++ rts/StgPrimFloat.h | 1 + 6 files changed, 43 insertions(+) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index d5566fe..8972115 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -606,6 +606,11 @@ primop DoubleDecode_2IntOp "decodeDouble_2Int#" GenPrimOp respectively, and the last is the exponent.} with out_of_line = True +primop DoubleDecode_Int64Op "decodeDouble_Int64#" GenPrimOp + Double# -> (# INT64, Int# #) + {Decode {\tt Double\#} into mantissa and base-2 exponent.} + with out_of_line = True + ------------------------------------------------------------------------ section "Float#" {Operations on single-precision (32-bit) floating-point numbers.} diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index d2b933d..0d323e2 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -341,6 +341,7 @@ RTS_FUN_DECL(StgReturn); RTS_FUN_DECL(stg_decodeFloatzuIntzh); RTS_FUN_DECL(stg_decodeDoublezu2Intzh); +RTS_FUN_DECL(stg_decodeDoublezuInt64zh); RTS_FUN_DECL(stg_unsafeThawArrayzh); RTS_FUN_DECL(stg_casArrayzh); diff --git a/rts/Linker.c b/rts/Linker.c index a0ad90c..07a330e 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1106,6 +1106,7 @@ typedef struct _RtsSymbolVal { SymI_HasProto(cmp_thread) \ SymI_HasProto(createAdjustor) \ SymI_HasProto(stg_decodeDoublezu2Intzh) \ + SymI_HasProto(stg_decodeDoublezuInt64zh) \ SymI_HasProto(stg_decodeFloatzuIntzh) \ SymI_HasProto(defaultsHook) \ SymI_HasProto(stg_delayzh) \ diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index ee50f7f..cb4cd5e 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -22,6 +22,7 @@ * ---------------------------------------------------------------------------*/ #include "Cmm.h" +#include "MachDeps.h" #ifdef __PIC__ import pthread_mutex_lock; @@ -807,6 +808,22 @@ stg_decodeDoublezu2Intzh ( D_ arg ) return (r1, r2, r3, r4); } +/* Double# -> (# Int64#, Int# #) */ +stg_decodeDoublezuInt64zh ( D_ arg ) +{ + CInt exp; + I64 mant; + W_ mant_ptr; + + STK_CHK_GEN_N (SIZEOF_INT64); + reserve BYTES_TO_WDS(SIZEOF_INT64) = mant_ptr { + (exp) = ccall __decodeDouble_Int64(mant_ptr "ptr", arg); + mant = I64[mant_ptr]; + } + + return (mant, TO_W_(exp)); +} + /* ----------------------------------------------------------------------------- * Concurrency primitives * -------------------------------------------------------------------------- */ diff --git a/rts/StgPrimFloat.c b/rts/StgPrimFloat.c index 63fe52e..5f60db7 100644 --- a/rts/StgPrimFloat.c +++ b/rts/StgPrimFloat.c @@ -17,6 +17,10 @@ #define IEEE_FLOATING_POINT 1 +#if FLT_RADIX != 2 +# error FLT_RADIX != 2 not supported +#endif + /* * Encoding and decoding Doubles. Code based on the HBC code * (lib/fltcode.c). @@ -158,6 +162,20 @@ __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble } } +/* This is expected to replace uses of __decodeDouble_2Int() in the long run */ +StgInt +__decodeDouble_Int64 (StgInt64 *const mantissa, const StgDouble dbl) +{ + if (dbl) { + int exp = 0; + *mantissa = (StgInt64)scalbn(frexp(dbl, &exp), DBL_MANT_DIG); + return exp-DBL_MANT_DIG; + } else { + *mantissa = 0; + return 0; + } +} + /* Convenient union types for checking the layout of IEEE 754 types - based on defs in GNU libc */ diff --git a/rts/StgPrimFloat.h b/rts/StgPrimFloat.h index fefe8c9..617888c 100644 --- a/rts/StgPrimFloat.h +++ b/rts/StgPrimFloat.h @@ -12,6 +12,7 @@ #include "BeginPrivate.h" /* grimy low-level support functions defined in StgPrimFloat.c */ +StgInt __decodeDouble_Int64 (StgInt64 *mantissa, StgDouble dbl); void __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble dbl); void __decodeFloat_Int (I_ *man, I_ *exp, StgFloat flt); From git at git.haskell.org Sat Aug 16 21:19:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Aug 2014 21:19:05 +0000 (UTC) Subject: [commit: ghc] wip/T9281: Implement new integer-gmp2 from scratch (re #9281) (91ef3b4) Message-ID: <20140816211905.DF0A324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9281 Link : http://ghc.haskell.org/trac/ghc/changeset/91ef3b4c45eed6faf63bb630b383186eca4abc3f/ghc >--------------------------------------------------------------- commit 91ef3b4c45eed6faf63bb630b383186eca4abc3f Author: Herbert Valerio Riedel Date: Fri Jul 18 15:02:43 2014 +0200 Implement new integer-gmp2 from scratch (re #9281) Summary: (preliminary commit message) This is done as a separate integer-gmp2 backend library because it turned out to become a complete rewrite from scratch. This has been tested only on Linux/x86_64 so far. The code has been written while taking into account Linux/i386 and "64-bit" Windows, but will probably need some tweaking to get right. Also, we don't do any autoconf stuff anymore, and rely on Cabal's "extra-libraries: gmp" to do the right thing (which probably won't work everywhere). We may need to re-introduce the use of autoconf at some point. Test Plan: nofib & testsuite Reviewers: #ghc, austin, simonmar, rwbarton Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D82 >--------------------------------------------------------------- 91ef3b4c45eed6faf63bb630b383186eca4abc3f compiler/coreSyn/CorePrep.lhs | 4 + compiler/ghc.mk | 8 +- compiler/prelude/PrelNames.lhs | 9 +- compiler/prelude/TysWiredIn.lhs | 32 +- ghc.mk | 4 +- libraries/base/GHC/Real.lhs | 6 + libraries/base/base.cabal | 19 +- libraries/{ghc-prim => integer-gmp2}/.gitignore | 0 libraries/integer-gmp2/LICENSE | 30 + libraries/integer-gmp2/cbits/wrappers.c | 281 ++++ libraries/integer-gmp2/integer-gmp2.cabal | 49 + .../src/GHC/Integer.hs} | 49 +- .../integer-gmp2/src/GHC/Integer/GMP2/Internals.hs | 126 ++ .../integer-gmp2/src/GHC/Integer/Logarithms.hs | 73 + .../src/GHC/Integer/Logarithms/Internals.hs | 118 ++ libraries/integer-gmp2/src/GHC/Integer/Type.hs | 1663 ++++++++++++++++++++ rules/foreachLibrary.mk | 2 + testsuite/driver/testlib.py | 2 +- testsuite/tests/safeHaskell/check/pkg01/all.T | 6 +- 19 files changed, 2452 insertions(+), 29 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 91ef3b4c45eed6faf63bb630b383186eca4abc3f From git at git.haskell.org Sat Aug 16 21:19:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Aug 2014 21:19:08 +0000 (UTC) Subject: [commit: ghc] wip/T9281: Remove obsolete `digitsTyConKey :: Unique` (db4f271) Message-ID: <20140816211908.5CCE624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9281 Link : http://ghc.haskell.org/trac/ghc/changeset/db4f27143f86f2c6a71bc70a086073f70a670141/ghc >--------------------------------------------------------------- commit db4f27143f86f2c6a71bc70a086073f70a670141 Author: Herbert Valerio Riedel Date: Sat Aug 16 20:31:21 2014 +0200 Remove obsolete `digitsTyConKey :: Unique` This became dead with 1e87c0a6e485e1dbef8e9ed19191e54f6cdc54e0 and was probably just missed. I plan to re-use the freed up `mkPreludeTyConUnique 23` slot soon for a new `bigNatTyConKey` (as part of the #9281 effort) >--------------------------------------------------------------- db4f27143f86f2c6a71bc70a086073f70a670141 compiler/prelude/PrelNames.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index bd791ff..6a30a3f 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -1328,7 +1328,7 @@ addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey, byteA floatPrimTyConKey, floatTyConKey, funTyConKey, intPrimTyConKey, intTyConKey, int8TyConKey, int16TyConKey, int32PrimTyConKey, int32TyConKey, int64PrimTyConKey, int64TyConKey, - integerTyConKey, digitsTyConKey, + integerTyConKey, listTyConKey, foreignObjPrimTyConKey, weakPrimTyConKey, mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey, mutableByteArrayPrimTyConKey, orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey, @@ -1355,7 +1355,7 @@ int32TyConKey = mkPreludeTyConUnique 19 int64PrimTyConKey = mkPreludeTyConUnique 20 int64TyConKey = mkPreludeTyConUnique 21 integerTyConKey = mkPreludeTyConUnique 22 -digitsTyConKey = mkPreludeTyConUnique 23 + listTyConKey = mkPreludeTyConUnique 24 foreignObjPrimTyConKey = mkPreludeTyConUnique 25 weakPrimTyConKey = mkPreludeTyConUnique 27 From git at git.haskell.org Sat Aug 16 21:19:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Aug 2014 21:19:11 +0000 (UTC) Subject: [commit: ghc] wip/T9281: WIP -- FIXUP wired-in BigNat (bed1a7d3) Message-ID: <20140816211911.62F0524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9281 Link : http://ghc.haskell.org/trac/ghc/changeset/bed1a7d3972ea9e9d206fad1626488c19480f317/ghc >--------------------------------------------------------------- commit bed1a7d3972ea9e9d206fad1626488c19480f317 Author: Herbert Valerio Riedel Date: Sat Aug 16 23:18:17 2014 +0200 WIP -- FIXUP wired-in BigNat >--------------------------------------------------------------- bed1a7d3972ea9e9d206fad1626488c19480f317 compiler/prelude/PrelNames.lhs | 9 +++++---- compiler/prelude/TysWiredIn.lhs | 18 ++++++++++++++++-- 2 files changed, 21 insertions(+), 6 deletions(-) diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 6a30a3f..ddf1c39 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -1328,7 +1328,7 @@ addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey, byteA floatPrimTyConKey, floatTyConKey, funTyConKey, intPrimTyConKey, intTyConKey, int8TyConKey, int16TyConKey, int32PrimTyConKey, int32TyConKey, int64PrimTyConKey, int64TyConKey, - integerTyConKey, + integerTyConKey, bigNatTyConKey, listTyConKey, foreignObjPrimTyConKey, weakPrimTyConKey, mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey, mutableByteArrayPrimTyConKey, orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey, @@ -1355,7 +1355,7 @@ int32TyConKey = mkPreludeTyConUnique 19 int64PrimTyConKey = mkPreludeTyConUnique 20 int64TyConKey = mkPreludeTyConUnique 21 integerTyConKey = mkPreludeTyConUnique 22 - +bigNatTyConKey = mkPreludeTyConUnique 23 listTyConKey = mkPreludeTyConUnique 24 foreignObjPrimTyConKey = mkPreludeTyConUnique 25 weakPrimTyConKey = mkPreludeTyConUnique 27 @@ -1594,12 +1594,13 @@ integerGmpJDataConKey = mkPreludeDataConUnique 31 -- For integer-gmp2 only integerGmp2SIDataConKey, integerGmp2JpDataConKey, - integerGmp2JnDataConKey :: Unique + integerGmp2JnDataConKey, bigNatDataConKey :: Unique integerGmp2SIDataConKey = mkPreludeDataConUnique 32 integerGmp2JpDataConKey = mkPreludeDataConUnique 33 integerGmp2JnDataConKey = mkPreludeDataConUnique 34 +bigNatDataConKey = mkPreludeDataConUnique 35 -coercibleDataConKey = mkPreludeDataConUnique 35 +coercibleDataConKey = mkPreludeDataConUnique 36 \end{code} %************************************************************************ diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs index d09c9dc..64f3f5c 100644 --- a/compiler/prelude/TysWiredIn.lhs +++ b/compiler/prelude/TysWiredIn.lhs @@ -237,6 +237,11 @@ integerGmp2SIDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsL integerGmp2JpDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "Jp#") integerGmp2JpDataConKey integerGmp2JpDataCon integerGmp2JnDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "Jn#") integerGmp2JnDataConKey integerGmp2JnDataCon +-- GHC.Integer.Type.BigNat +bigNatTyConName, bigNatDataConName :: Name +bigNatTyConName = mkWiredInTyConName UserSyntax gHC_INTEGER_TYPE (fsLit "BigNat") bigNatTyConKey bigNatTyCon +bigNatDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "BN#") bigNatDataConKey bigNatDataCon + parrTyConName, parrDataConName :: Name parrTyConName = mkWiredInTyConName BuiltInSyntax gHC_PARR' (fsLit "[::]") parrTyConKey parrTyCon @@ -614,14 +619,23 @@ integerGmpJDataCon = pcDataCon integerGmpJDataConName [] integerGmp2JpDataCon :: DataCon integerGmp2JpDataCon = pcDataCon integerGmp2JpDataConName [] - [byteArrayPrimTy] + [bigNatTy] integerTyCon integerGmp2JnDataCon :: DataCon integerGmp2JnDataCon = pcDataCon integerGmp2JnDataConName [] - [byteArrayPrimTy] + [bigNatTy] integerTyCon +bigNatTy :: Type +bigNatTy = mkTyConTy bigNatTyCon + +bigNatTyCon :: TyCon +bigNatTyCon = pcNonRecDataTyCon bigNatTyConName Nothing [] [bigNatDataCon] + +bigNatDataCon :: DataCon +bigNatDataCon = pcDataCon bigNatDataConName [] [byteArrayPrimTy] bigNatTyCon + \end{code} \begin{code} From git at git.haskell.org Sat Aug 16 21:19:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Aug 2014 21:19:14 +0000 (UTC) Subject: [commit: ghc] wip/T9281's head updated: WIP -- FIXUP wired-in BigNat (bed1a7d3) Message-ID: <20140816211914.C065B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T9281' now includes: 350ed08 Reduce volume of typechecker trace information 3214ec5 Comments only 4b3df0b Further improvements to floating equalities af28e61 Update Cabal submodule to HEAD (1.21) b34fa11 Set i686 as the minimum architecture on 32-bit mingw c41b716 travis: Install process via cabal 99c2823 Document OVERLAP pragmas. 23cd98f Documentation typo 8249b50 Comments only f23b212 Revert "Update Cabal submodule to HEAD (1.21)" 1486fc8 ghci: detabify/dewhitespace RtClosureInspect d2464b5 parser: detabify/dewhitespace Ctype 20986a6 parser: detabify/dewhitespace cutils.c fcfa8ce profiling: detabify/unwhitespace CostCentre fe6381b cmm: detabify/unwhitespace CmmInfo ffcb14d cmm: detabify/unwhitespace CmmLex bd4e855 ghci: detabify/unwhitespace ByteCodeGen 23aee51 ghci: detabify/unwhitespace ByteCodeInstr 3ccc80c main: detabify/unwhitespace PprTyThing b5b1a2d prelude: detabify/unwhitespace PrelInfo 4173ae8 nativeGen: detabify/dewhitespace Size a881813 nativeGen: detabify/dewhitespace Reg 960f4e1 nativeGen: detabify/dewhitespace X86/RegInfo 7bf273c nativeGen: detabify/dewhitespace PPC/Cond e6a32cc nativeGen: detabify/dewhitespace PPC/RegInfo e193380 nativeGen: detabify/dewhitespace RegClass c754599 nativeGen: detabify/dewhitespace TargetReg 2f7495d nativeGen: detabify/dewhitespace SPARC/Stack b80249d nativeGen: detabify/dewhitespace SPARC/Imm 234afe2 nativeGen: detabify/dewhitespace SPARC/ShortcutJump ef07ff7 nativeGen: detabify/dewhitespace SPARC/Instr 25c4629 nativeGen: detabify/dewhitespace SPARC/Regs 8707e45 nativeGen: detabify/dewhitespace SPARC/Cond 9924de2 nativeGen: detabify/dewhitespace SPARC/CodeGen/CondCode 6babdc8 nativeGen: detabify/dewhitespace SPARC/CodeGen/Amode 085713f nativeGen: detabify/dewhitespace SPARC/CodeGen/Expand 5ef0050 nativeGen: detabify/dewhitespace SPARC/CodeGen/Sanity 2ff9b90 nativeGen: detabify/dewhitespace SPARC/CodeGen/Gen32 8a8bc420 nativeGen: detabify/dewhitespace SPARC/CodeGen/Base 3c5fc8e utils: detabify/dewhitespace Digraph 893a4bf types: detabify/dewhitespace Kind 18b2c46 Add PolyKinds extension to Data.Monoid 00dd05e Adding more parser exports and some documentation. d996a1b fix inconsistency in exported functions from TcSplice.lhs/lhs-boot files when GHCI is not defined fb936e0 Make GHCi permissions checks ignore root user. 80868ec rts: drop unused 'SpinLockCount' typedef e0d4386 Data.List: Unterse/Obvious comment regarding CPP 021b797 driver: use absolute paths in ld scripts (#7452) 2b860ef utils: delete obsolete heap-view program ad785f6 utils: remove old pvm scripts 828e641 vagrant: move files around d3277f4 Revert "travis: Install process via cabal" 4dd7ae6 Typos in note bb06e2a Make 'ghc' a wired in package. d7c807f [ghc-pkg] Fix #5442 by using the flag db stack to modify packages. 2ad04d0 Update upstream Git repo url for `time` package a9445f8 arclint: update linting configuration 2c12d9e docs: Remove obsolete Visual Haskell document c26bba8 docs: Delete old docbook cheat sheet 4bebab2 Rename PackageId to PackageKey, distinguishing it from Cabal's PackageId. 0acd70a Documentation for substringCheck. 80ab62d Update Cabal submodule to HEAD (1.21) 9960afe Always qualify on hi interface mismatch. 7aabfa6 Unbreak the build on FreeBSD/i386, where the default target arch is i486. b709f0a Make last a good consumer 1db9983 Rewrite package/module identity section 6e9e855 Add a summary section. 505358c Definite compilation is a go e408678 Write up rename on entry d1f17f5 Ignore tix files. eb795ec Duplicate word 23773b2 X86 codegen: make LOCK a real instruction prefix c11b35f Fix test for fetchNandIntArray# fc53ed5 Add missing memory fence to atomicWriteIntArray# d294218 Fixed issue with detection of duplicate record fields 6ce708c Use the right kinds on the LHS in 'deriving' clauses a997f2d Check for boxed tau types in the LHS of type family instances 2070a8f [backpack] Rewrite compilation to be cleaner. 92587bf Refactor FFI error messages dae46da Update test suite output 7f5c1086 Module reexports, fixing #8407. 9487305 Fix build on OS X due to macro-like string in comment 97f499b Implement OVERLAPPING and OVERLAPPABLE pragmas (see #9242) 5dc0cea Comments only 57ed410 Increase precision of timings reported by RTS ba00258 Support ghc-pkg --ipid to query package ID. 546029e Add reexported modules to the list of IPID fields. a62c345 Don't call installed package IDs 'package IDs'; they're different. 34d7d25 rts: delint/detab/dewhitespace EventLog.c 426f2ac rts: delint/detab/dewhitespace GetEnv.c cebd37f rts: delint/detab/dewhitespace GetTime.c d72f3ad rts: delint/detab/dewhitespace Itimer.c b1fb531 rts: delint/detab/dewhitespace OSMem.c 3e0e489 rts: delint/detab/dewhitespace OSThreads.c 875f4c8 rts: delint/detab/dewhitespace TTY.c 22308d7 rts: delint/detab/dewhitespace Signals.h 386ec24 rts: delint/detab/dewhitespace Signals.c ded5ea8 rts: delint/detab/dewhitespace Select.c 3021fb7 rts: delint/detab/dewhitespace win32/AsyncIO.c fdcc699 rts: delint/detab/dewhitespace win32/AsyncIO.h b64958b rts: delint/detab/dewhitespace win32/AwaitEvent.c ab24d0b rts: delint/detab/dewhitespace win32/ConsoleHandler.c 20b506d rts: delint/detab/dewhitespace win32/GetEnv.c 59b6ea8 rts: delint/detab/dewhitespace win32/GetTime.c 94fba59 rts: delint/detab/dewhitespace win32/IOManager.h 36bbec0 rts: delint/detab/dewhitespace win32/IOManager.c 976c55c rts: delint/detab/dewhitespace win32/OSMem.c 43345dd rts: delint/detab/dewhitespace win32/OSThreads.c 9aa9d17 rts: delint/detab/dewhitespace win32/ThrIOManager.c 316c0d5 rts: delint/detab/dewhitespace win32/WorkQueue.h 9e8d258 rts: delint/detab/dewhitespace win32/WorkQueue.c 4f5966b rts: delint/detab/dewhitespace Arena.c a4aa6be rts: detab/dewhitespace FileLock.c 2e1a0ba rts: delint FileLock.c 4a09baa rts: delint/detab/dewhitespace Globals.h 7ee0b63 rts: delint/detab/dewhitespace Hash.c f2a3f53 rts: detab/dewhitespace Messages.c 1c89c96 rts: delint Messages.c 48cae79 rts: delint/detab/dewhitespace OldARMAtomic.c 42f3bdf rts: delint/detab/dewhitespace Papi.c ad36b1a rts: delint Papi.c a0fa13b rts: delint/detab/dewhitespace Papi.h 7113370 rts: delint/detab/dewhitespace PosixSource.h de5a4db rts: delint/detab/dewhitespace RetainerSet.h ee0fd62 rts: delint/detab/dewhitespace RetainerSet.c f81154f rts: delint/detab/dewhitespace RtsDllMain.c 60c6bd4 rts: delint/detab/dewhitespace RtsDllMain.h d765359 rts: delint/detab/dewhitespace StgRun.h a6fc4bd rts: delint/detab/dewhitespace ThreadLabels.c 95378c2 rts: detab/dewhitespace ThreadPaused.c cf2980c rts: detab/dewhitespace WSDeque.h 952f622 rts: detab/dewhitespace WSDeque.c 39b5c1c rts: add Emacs 'Local Variables' to every .c file cc37175 do not link with -lrt on Solaris for threaded way 524f15d add Solaris' linker warning messages filtering into link phase b9be82d Avoid to pass a socket to setmode/isatty in Windows 4ee8c27 use GHC-7.8.3's values for thread block reason (fixes #9333) 9a7440c Add Functor, Applicative, Monad instances for First, Last 003bcf2 Do not check permissions when running find on Windows. 8240312 driver: Fix usage of '$0' in ghcii.sh (#8873) b126ad3 Don't clean away inplace/mingw and inplace/perl. f510c7c base: make System.IO.openTempFile generate less predictable names b1f4356 Fix validate fallout c1336f7 rts: Detab OSThreads.c b6d5229 getCoerbileInsts: Move the two NT-unwrapping instances together 12644c3 New parser for pattern synonym declarations: 40e7774 Add parser support for explicitly bidirectional pattern synonyms 0279a7d Typechecker support for explicitly-bidirectional pattern synonyms d84a5cc Add renamer support for explicitly-bidirectional pattern synonyms 25c2eeb tcLookupPatSyn: look up the PatSyn record for a given Id 6a78503 Typecheck the wrapper definition of a pattern synonym, after everything in the same scope is typechecked 32bf8a5 When computing minimal recursive sets of bindings, don't include references in wrapper definitions for explicitly-bidirectional pattern synonyms f3262fe Add test cases for explicitly-bidirectional pattern synonym 893a261 Refactor PatSynBind so that we can pass around PSBs instead of several arguments 3219ed9 Add note about renaming of pattern synonym wrappers 535b37c Add user documentation for explicitly-bidirectional pattern synonyms 6640635 Fix variable name typo from commit 3021fb b06e83d Make mod73 test insensitive to minor variations (#9325) a2439c7 Add .gitignore line for stage=1 testsuite generated file 1837b2f comment update da70f9e Allow multiple entry points when allocating recursive groups (#9303) ab8f254 Comments and white space 49333bf Comments and minor refactoring 6fa6caa Compiler perf has improved a bit a0ff1eb [backpack] Package selection 0be7c2c Comments and white space dc7d3c2 Test Trac #9380 7381cee Add a fast-path in TcInteract.kickOutRewritable fe2d807 Comments only bfaa179 Add comments about the {-# INCOHERENT #-} for Typeable (f a) 1ae5fa4 Complete work on new OVERLAPPABLE/OVERLAPPING pragmas (Trac #9242) c97f853 Typo in comment fd47e26 Fix up ghci044 bdf0ef0 Minor wordsmithing of comments 58ed1cc Small tweaks to comment 1c1ef82 Typo fixes 52188ad Unbreak build. 3b9fe0c refactor to fix 80column overflow 6483b8a panic message fix 9d9a554 interruptible() was not returning true for BlockedOnSTM (#9379) 028630a Fix reference to note aab5937 update comment 6c06db1 add a comment 2989ffd A panic in CmmBuildInfoTables.bundle shouldn't be a panic (#9329) d4d4bef Improve the desugaring of RULES, esp those from SPECIALISE pragmas 8df7fea Bump haddock.base max_bytes_used 3faff73 [backpack] More revisions to various pieces. 0336588 Two new executables to ignore. 02975c9 Fix-up to d4d4bef2 'Improve the desugaring of RULES' 578fbec Dont allow hand-written Generic instances in Safe Haskell. e69619e Allow warning if could have been infered safe instead of explicit Trustworthy label. 105602f Update Safe Haskell typeable test outputs. fbd0586 Infer safety of modules correctly with new overlapping pragmas. ab90bf2 Add in (disabled for now) test of a Safe Haskell bug. f293931 Add missing *.stderr files 44853a1 Terminate in forkProcess like in real_main df1e775 docs: fix typo: 'OVERLAPPINGP' -> 'OVERLAPPING' 637978f Use 'install' command for 'inplace/' install as we do in 'make install' 65e5dbc fix linker_unload test on Solaris/i386 platform f686682 ghc --make: add nicer names to RTS threads (threaded IO manager, make workers) 7328deb fix openFile003 test on Solaris/i386 (platform output is not needed anymore) 1f24a03 fix topHandler03 execution on Solaris where shell signals SIGTERM correctly edff1ef Disable package auto-hiding if -hide-all-packages is passed 66218d1 Package keys (for linking/type equality) separated from package IDs. 3663791 Disable ghc-pkg accepting multiple package IDs (differing package keys) for now. de3f064 Make PackageState an abstract type. 00b8f8c Refactor package state, also fixing a module reexport bug. 4accf60 Refactor PackageFlags so that ExposePackage is a single constructor. 2078752 Thinning and renaming modules from packages on the command line. 94b2b22 [no-ci] Minor bugfixes in Backpack docs. 7479df6 configure.ac: drop unused VOID_INT_SIGNALS 56ca32c Update Haddock submodule to know about profiling. d360d44 Filter out null bytes from trace, and warn accordingly, fixing #9395. c88559b Temporarily bump Haddock numbers; I'm going to fix it. 8e400d2 Revert "fix linker_unload test on Solaris/i386 platform" f4904fb Mark type-rep not as expect_broken when debugged f42fa9b fix linker_unload test _FILE_OFFSET_BITS redefined warning on Solaris/i386 2b3c621 fix linker_unload test for ghc configurations with --with-gmp-libraries 24a2e49 fix T658b/T5776 to use POSIX grep -c instead of GNU's --count 61baf71 Comments and white space 31399be Move Outputable instance for FloatBind to the data type definition d3fafbb Tiny refactoring, plus comments; no change in behaviour 93b1a43 Add Output instance for OrdList 6b96557 Make Core Lint check the let/app invariant 1736082 Don't float into unlifted function arguments 1fc60ea When desugaring Use the smart mkCoreConApps and friends d174f49 Make buildToArrPReprs obey the let/app invariant db17d58 Document the maintenance of the let/app invariant in the simplifier ab6480b Extensive Notes on can_fail and has_side_effects 8367f06 Refactor the handling of case-elimination 0957a9b Add has_side_effets to the raise# primop 2990e97 Test Trac #9390 18ac546 Fix some typos in recent comments/notes 4855be0 Give the Unique generated by strings a tag '$', fixes #9413. d026e9e Permanently accept the Haddock performance number bump, and add some TODOs c51498b [no-ci] Track Haddock submodule change: ignore TAGS. af1fc53 ghci: tweak option list indentation in ':show packages' 2cca0c0 testsuite: add signal_exit_code function to the driver d0ee4eb Update perf number for T5642 7d52e62 Update Haddock to attoparsec-0.12.1. Adjust perf. dff0623 Implement the final change to INCOHERENT from Trac #9242 ca3fc66 Fix path in cabal file 16776e9 configure.ac: drop unused HAVE_BIN_SH a2ac57b Tweak Haddock markup in GHC.Magic 4e020b3 Tweak Haddock in GHC.Types 44c1e3f testsuite: add list of llvm_ways caa9c8aa Add test case for #9013 8e01ca6 Remove obsolete "-- #hide" Haddock pragmas b7b7633 Add a test for plusWord2#, addIntC#, subIntC# e83e873 Clarify documentation of addIntC#, subIntC# 3260467 systools info: fix warning about C compiler (message said about linker) ba9277c Tweak linting rules. 02be4ff fix T4201 to avoid GNU grep specific -B option by usage of pure POSIX tools 2396940 fix T4981-V3 and T9208 tests for no newline at end of file warning ba3650c fix T4981-V3 to avoid DOS line endings bb00308 Don't build or test dph by default 238fd05 change topHandler02/topHandler03 tests to use signal_exit_code function 7a754a9 rts/Printer.c: drop zcode mangling/demangling support in C code b02fa3b rts: Remove trailing whitespace and tabs from Printer.c 8d90ffa fix darwin threaded static linking by removing -lpthread option #9189 cbfa107 Improve seq documentation; part of trac issue #9390 c80d238 Eliminate some code duplication in x86 backend (genCCall32/64) 5f5d662 Make IntAddCOp, IntSubCOp into GenericOps 71bd4e3 x86: Always generate add instruction in MO_Add2 (#9013) 8e64151 stg/Prim.h: drop redundant #ifdef 6e3c44e Unbreak travis by not passing --no-dph 0a3944c testsuite/base: update .gitignore 3694d87 Re-add `--no-dph` option to ./validate 3669b60 Add bit scan {forward,reverse} insns to x86 NCG 9f285fa Add CMOVcc insns to x86 NCG 6415191 x86: zero extend the result of 16-bit popcnt instructions (#9435) a09508b Test #9371 (indexed-types/should_fail/T9371) f29bdfb Fix Trac #9371. 1b13886 Fix #9415. 1a3e19d Test #9415 (typecheck/should_fail/T9415) 8d27c76 Test #9200. (polykinds/T9200) 6485930 Change definition of CUSK for data and class definitions (#9200). 3dfd3c3 Added more testing for #9200. (polykinds/T9200b) b2c6167 Change treatment of CUSKs for synonyms and families (#9200). 578377c Remove NonParametricKinds (#9200) 1c66b3d Update manual (#9200). 91a48c5 Testsuite wibbles around #9200 6f862df shouldInlinePrimOp: Fix Int overflow a6fd7b5 Add some Haddocks to SMRep 4342049 StgCmmPrim: add note to stop using fixed size signed types for sizes 5e46e1f Have ghc-pkg use an old-style package key when it's not provided. 2272c50 Explicitly version test for package key support. 6b5ea61 Remove out of date TODO e0c1767 Implement new CLZ and CTZ primops (re #9340) 03a8003 Declare `ghc-head` to be haddock's upstream branch 5895f2b LlvmMangler: Be more selective when mangling object types d39c434 Make configure's sed(1) expression for GHC_LDFLAGS more BSD-friendly. 246436f Implement {resize,shrink}MutableByteArray# primops 72a94c1 Implement `decodeDouble_Int64#` primop 91ef3b4 Implement new integer-gmp2 from scratch (re #9281) db4f271 Remove obsolete `digitsTyConKey :: Unique` bed1a7d3 WIP -- FIXUP wired-in BigNat From git at git.haskell.org Sun Aug 17 11:10:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Aug 2014 11:10:45 +0000 (UTC) Subject: [commit: ghc] master: Workaround GCC `__ctzdi2` intrinsic linker errors (6375934) Message-ID: <20140817111045.38E0F24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6375934bfe64ca15eb215327629f9f07a185377a/ghc >--------------------------------------------------------------- commit 6375934bfe64ca15eb215327629f9f07a185377a Author: Herbert Valerio Riedel Date: Sun Aug 17 12:19:45 2014 +0200 Workaround GCC `__ctzdi2` intrinsic linker errors On Linux/i386 the 64bit `__builtin_ctzll()` instrinsic doesn't get inlined by GCC but rather a short `__ctzdi2` runtime function is inserted when needed into compiled object files. This causes failures for the four test-cases TEST="T8639_api T8628 dynCompileExpr T5313" with error messages of the kind dynCompileExpr: .../libraries/ghc-prim/dist-install/build/libHSghcpr_BE58KUgBe9ELCsPXiJ1Q2r.a: unknown symbol `__ctzdi2' dynCompileExpr: dynCompileExpr: unable to load package `ghc-prim' This workaround forces GCC on 32bit x86 to to express `hs_ctz64` in terms of the 32bit `__builtin_ctz()` (this is no loss, as there's no 64bit BSF instruction on i686 anyway) and thus avoid the problematic out-of-line runtime function. Note: `__builtin_ctzll()` is used since e0c1767d0ea8d12e0a4badf43682a08784e379c6 (re #9340) >--------------------------------------------------------------- 6375934bfe64ca15eb215327629f9f07a185377a libraries/ghc-prim/cbits/ctz.c | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/libraries/ghc-prim/cbits/ctz.c b/libraries/ghc-prim/cbits/ctz.c index cc420b9..f68f628 100644 --- a/libraries/ghc-prim/cbits/ctz.c +++ b/libraries/ghc-prim/cbits/ctz.c @@ -31,7 +31,23 @@ hs_ctz32(StgWord x) StgWord hs_ctz64(StgWord64 x) { -#if SIZEOF_UNSIGNED_LONG == 8 +#if defined(__GNUC__) && defined(i386_HOST_ARCH) + /* On Linux/i386, the 64bit `__builtin_ctzll()` instrinsic doesn't + get inlined by GCC but rather a short `__ctzdi2` runtime function + is inserted when needed into compiled object files. + + This workaround forces GCC on 32bit x86 to to express `hs_ctz64` in + terms of the 32bit `__builtin_ctz()` (this is no loss, as there's no + 64bit BSF instruction on i686 anyway) and thus avoid the problematic + out-of-line runtime function. + */ + + if (!x) return 64; + + return ((uint32_t)x ? __builtin_ctz((uint32_t)x) + : (__builtin_ctz(x >> 32) + 32)); + +#elif SIZEOF_UNSIGNED_LONG == 8 return x ? __builtin_ctzl(x) : 64; #elif SIZEOF_UNSIGNED_LONG_LONG == 8 return x ? __builtin_ctzll(x) : 64; From git at git.haskell.org Sun Aug 17 11:24:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Aug 2014 11:24:07 +0000 (UTC) Subject: [commit: ghc] master: Remove obsolete `digitsTyConKey :: Unique` (96d0418) Message-ID: <20140817112407.1C8F324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/96d04186e00fe2202b9953688492bb370d818bf1/ghc >--------------------------------------------------------------- commit 96d04186e00fe2202b9953688492bb370d818bf1 Author: Herbert Valerio Riedel Date: Sat Aug 16 20:31:21 2014 +0200 Remove obsolete `digitsTyConKey :: Unique` This became dead with 1e87c0a6e485e1dbef8e9ed19191e54f6cdc54e0 and was probably just missed. I plan to re-use the freed up `mkPreludeTyConUnique 23` slot soon for a new `bigNatTyConKey` (as part of the #9281 effort) >--------------------------------------------------------------- 96d04186e00fe2202b9953688492bb370d818bf1 compiler/prelude/PrelNames.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index b2dec88..5757ba1 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -1328,7 +1328,7 @@ addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey, byteA floatPrimTyConKey, floatTyConKey, funTyConKey, intPrimTyConKey, intTyConKey, int8TyConKey, int16TyConKey, int32PrimTyConKey, int32TyConKey, int64PrimTyConKey, int64TyConKey, - integerTyConKey, digitsTyConKey, + integerTyConKey, listTyConKey, foreignObjPrimTyConKey, weakPrimTyConKey, mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey, mutableByteArrayPrimTyConKey, orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey, @@ -1355,7 +1355,7 @@ int32TyConKey = mkPreludeTyConUnique 19 int64PrimTyConKey = mkPreludeTyConUnique 20 int64TyConKey = mkPreludeTyConUnique 21 integerTyConKey = mkPreludeTyConUnique 22 -digitsTyConKey = mkPreludeTyConUnique 23 + listTyConKey = mkPreludeTyConUnique 24 foreignObjPrimTyConKey = mkPreludeTyConUnique 25 weakPrimTyConKey = mkPreludeTyConUnique 27 From git at git.haskell.org Sun Aug 17 11:45:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Aug 2014 11:45:30 +0000 (UTC) Subject: [commit: ghc] wip/T9281: [WIP] fixup wired-in BigNat (9c370fe) Message-ID: <20140817114532.E791124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9281 Link : http://ghc.haskell.org/trac/ghc/changeset/9c370fe127a38c8e9bbbd9e3ba7ae066c6a9cdf8/ghc >--------------------------------------------------------------- commit 9c370fe127a38c8e9bbbd9e3ba7ae066c6a9cdf8 Author: Herbert Valerio Riedel Date: Sat Aug 16 23:18:17 2014 +0200 [WIP] fixup wired-in BigNat >--------------------------------------------------------------- 9c370fe127a38c8e9bbbd9e3ba7ae066c6a9cdf8 compiler/prelude/PrelNames.lhs | 9 +++++---- compiler/prelude/TysWiredIn.lhs | 20 +++++++++++++++++--- 2 files changed, 22 insertions(+), 7 deletions(-) diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 6a30a3f..ddf1c39 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -1328,7 +1328,7 @@ addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey, byteA floatPrimTyConKey, floatTyConKey, funTyConKey, intPrimTyConKey, intTyConKey, int8TyConKey, int16TyConKey, int32PrimTyConKey, int32TyConKey, int64PrimTyConKey, int64TyConKey, - integerTyConKey, + integerTyConKey, bigNatTyConKey, listTyConKey, foreignObjPrimTyConKey, weakPrimTyConKey, mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey, mutableByteArrayPrimTyConKey, orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey, @@ -1355,7 +1355,7 @@ int32TyConKey = mkPreludeTyConUnique 19 int64PrimTyConKey = mkPreludeTyConUnique 20 int64TyConKey = mkPreludeTyConUnique 21 integerTyConKey = mkPreludeTyConUnique 22 - +bigNatTyConKey = mkPreludeTyConUnique 23 listTyConKey = mkPreludeTyConUnique 24 foreignObjPrimTyConKey = mkPreludeTyConUnique 25 weakPrimTyConKey = mkPreludeTyConUnique 27 @@ -1594,12 +1594,13 @@ integerGmpJDataConKey = mkPreludeDataConUnique 31 -- For integer-gmp2 only integerGmp2SIDataConKey, integerGmp2JpDataConKey, - integerGmp2JnDataConKey :: Unique + integerGmp2JnDataConKey, bigNatDataConKey :: Unique integerGmp2SIDataConKey = mkPreludeDataConUnique 32 integerGmp2JpDataConKey = mkPreludeDataConUnique 33 integerGmp2JnDataConKey = mkPreludeDataConUnique 34 +bigNatDataConKey = mkPreludeDataConUnique 35 -coercibleDataConKey = mkPreludeDataConUnique 35 +coercibleDataConKey = mkPreludeDataConUnique 36 \end{code} %************************************************************************ diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs index d09c9dc..49c671b 100644 --- a/compiler/prelude/TysWiredIn.lhs +++ b/compiler/prelude/TysWiredIn.lhs @@ -165,7 +165,7 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because ] ++ (case cIntegerLibraryType of IntegerGMP -> [integerTyCon] - IntegerGMP2 -> [integerTyCon] + IntegerGMP2 -> [integerTyCon, bigNatTyCon] _ -> []) \end{code} @@ -237,6 +237,11 @@ integerGmp2SIDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsL integerGmp2JpDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "Jp#") integerGmp2JpDataConKey integerGmp2JpDataCon integerGmp2JnDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "Jn#") integerGmp2JnDataConKey integerGmp2JnDataCon +-- GHC.Integer.Type.BigNat +bigNatTyConName, bigNatDataConName :: Name +bigNatTyConName = mkWiredInTyConName UserSyntax gHC_INTEGER_TYPE (fsLit "BigNat") bigNatTyConKey bigNatTyCon +bigNatDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "BN#") bigNatDataConKey bigNatDataCon + parrTyConName, parrDataConName :: Name parrTyConName = mkWiredInTyConName BuiltInSyntax gHC_PARR' (fsLit "[::]") parrTyConKey parrTyCon @@ -614,14 +619,23 @@ integerGmpJDataCon = pcDataCon integerGmpJDataConName [] integerGmp2JpDataCon :: DataCon integerGmp2JpDataCon = pcDataCon integerGmp2JpDataConName [] - [byteArrayPrimTy] + [bigNatTy] integerTyCon integerGmp2JnDataCon :: DataCon integerGmp2JnDataCon = pcDataCon integerGmp2JnDataConName [] - [byteArrayPrimTy] + [bigNatTy] integerTyCon +bigNatTy :: Type +bigNatTy = mkTyConTy bigNatTyCon + +bigNatTyCon :: TyCon +bigNatTyCon = pcNonRecDataTyCon bigNatTyConName Nothing [] [bigNatDataCon] + +bigNatDataCon :: DataCon +bigNatDataCon = pcDataCon bigNatDataConName [] [byteArrayPrimTy] bigNatTyCon + \end{code} \begin{code} From git at git.haskell.org Sun Aug 17 11:45:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Aug 2014 11:45:33 +0000 (UTC) Subject: [commit: ghc] wip/T9281: Implement `decodeDouble_Int64#` primop (50bf0be) Message-ID: <20140817114534.C6EEC2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9281 Link : http://ghc.haskell.org/trac/ghc/changeset/50bf0bef2b22f6d26a31eebf807a919bf64a3319/ghc >--------------------------------------------------------------- commit 50bf0bef2b22f6d26a31eebf807a919bf64a3319 Author: Herbert Valerio Riedel Date: Sat Aug 16 00:46:18 2014 +0200 Implement `decodeDouble_Int64#` primop Summary: The existing `decodeDouble_2Int#` primop is rather inconvenient to use (and in fact is not even used by `integer-gmp`) as the mantissa is split into 3 components which would actually fit in an `Int64#` value. However, `decodeDouble_Int64#` is to be used by the new `integer-gmp2` re-implementation (see #9281). Moreover, `decodeDouble_2Int#` performs direct bit-wise operations on the IEEE representation which can be replaced by a combination of the portable standard C99 `scalbn(3)` and `frexp(3)` functions. Test Plan: tested via `integer-gmp2` Reviewers: simonmar, austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D160 GHC Trac Issues: #9281 >--------------------------------------------------------------- 50bf0bef2b22f6d26a31eebf807a919bf64a3319 compiler/prelude/primops.txt.pp | 5 +++++ includes/stg/MiscClosures.h | 1 + rts/Linker.c | 1 + rts/PrimOps.cmm | 17 +++++++++++++++++ rts/StgPrimFloat.c | 18 ++++++++++++++++++ rts/StgPrimFloat.h | 1 + 6 files changed, 43 insertions(+) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index d5566fe..8972115 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -606,6 +606,11 @@ primop DoubleDecode_2IntOp "decodeDouble_2Int#" GenPrimOp respectively, and the last is the exponent.} with out_of_line = True +primop DoubleDecode_Int64Op "decodeDouble_Int64#" GenPrimOp + Double# -> (# INT64, Int# #) + {Decode {\tt Double\#} into mantissa and base-2 exponent.} + with out_of_line = True + ------------------------------------------------------------------------ section "Float#" {Operations on single-precision (32-bit) floating-point numbers.} diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index d2b933d..0d323e2 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -341,6 +341,7 @@ RTS_FUN_DECL(StgReturn); RTS_FUN_DECL(stg_decodeFloatzuIntzh); RTS_FUN_DECL(stg_decodeDoublezu2Intzh); +RTS_FUN_DECL(stg_decodeDoublezuInt64zh); RTS_FUN_DECL(stg_unsafeThawArrayzh); RTS_FUN_DECL(stg_casArrayzh); diff --git a/rts/Linker.c b/rts/Linker.c index a0ad90c..07a330e 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1106,6 +1106,7 @@ typedef struct _RtsSymbolVal { SymI_HasProto(cmp_thread) \ SymI_HasProto(createAdjustor) \ SymI_HasProto(stg_decodeDoublezu2Intzh) \ + SymI_HasProto(stg_decodeDoublezuInt64zh) \ SymI_HasProto(stg_decodeFloatzuIntzh) \ SymI_HasProto(defaultsHook) \ SymI_HasProto(stg_delayzh) \ diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index ee50f7f..cb4cd5e 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -22,6 +22,7 @@ * ---------------------------------------------------------------------------*/ #include "Cmm.h" +#include "MachDeps.h" #ifdef __PIC__ import pthread_mutex_lock; @@ -807,6 +808,22 @@ stg_decodeDoublezu2Intzh ( D_ arg ) return (r1, r2, r3, r4); } +/* Double# -> (# Int64#, Int# #) */ +stg_decodeDoublezuInt64zh ( D_ arg ) +{ + CInt exp; + I64 mant; + W_ mant_ptr; + + STK_CHK_GEN_N (SIZEOF_INT64); + reserve BYTES_TO_WDS(SIZEOF_INT64) = mant_ptr { + (exp) = ccall __decodeDouble_Int64(mant_ptr "ptr", arg); + mant = I64[mant_ptr]; + } + + return (mant, TO_W_(exp)); +} + /* ----------------------------------------------------------------------------- * Concurrency primitives * -------------------------------------------------------------------------- */ diff --git a/rts/StgPrimFloat.c b/rts/StgPrimFloat.c index 63fe52e..5f60db7 100644 --- a/rts/StgPrimFloat.c +++ b/rts/StgPrimFloat.c @@ -17,6 +17,10 @@ #define IEEE_FLOATING_POINT 1 +#if FLT_RADIX != 2 +# error FLT_RADIX != 2 not supported +#endif + /* * Encoding and decoding Doubles. Code based on the HBC code * (lib/fltcode.c). @@ -158,6 +162,20 @@ __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble } } +/* This is expected to replace uses of __decodeDouble_2Int() in the long run */ +StgInt +__decodeDouble_Int64 (StgInt64 *const mantissa, const StgDouble dbl) +{ + if (dbl) { + int exp = 0; + *mantissa = (StgInt64)scalbn(frexp(dbl, &exp), DBL_MANT_DIG); + return exp-DBL_MANT_DIG; + } else { + *mantissa = 0; + return 0; + } +} + /* Convenient union types for checking the layout of IEEE 754 types - based on defs in GNU libc */ diff --git a/rts/StgPrimFloat.h b/rts/StgPrimFloat.h index fefe8c9..617888c 100644 --- a/rts/StgPrimFloat.h +++ b/rts/StgPrimFloat.h @@ -12,6 +12,7 @@ #include "BeginPrivate.h" /* grimy low-level support functions defined in StgPrimFloat.c */ +StgInt __decodeDouble_Int64 (StgInt64 *mantissa, StgDouble dbl); void __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble dbl); void __decodeFloat_Int (I_ *man, I_ *exp, StgFloat flt); From git at git.haskell.org Sun Aug 17 11:45:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Aug 2014 11:45:38 +0000 (UTC) Subject: [commit: ghc] wip/T9281: Implement new integer-gmp2 from scratch (re #9281) (b5ed2f2) Message-ID: <20140817114538.8FD9E24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9281 Link : http://ghc.haskell.org/trac/ghc/changeset/b5ed2f277e551dcaade5837568e4cbb7dd811c04/ghc >--------------------------------------------------------------- commit b5ed2f277e551dcaade5837568e4cbb7dd811c04 Author: Herbert Valerio Riedel Date: Fri Jul 18 15:02:43 2014 +0200 Implement new integer-gmp2 from scratch (re #9281) Summary: (preliminary commit message) This is done as a separate integer-gmp2 backend library because it turned out to become a complete rewrite from scratch. This has been tested only on Linux/x86_64 so far. The code has been written while taking into account Linux/i386 and "64-bit" Windows, but will probably need some tweaking to get right. Also, we don't do any autoconf stuff anymore, and rely on Cabal's "extra-libraries: gmp" to do the right thing (which probably won't work everywhere). We may need to re-introduce the use of autoconf at some point. Test Plan: nofib & testsuite Reviewers: #ghc, austin, simonmar, rwbarton Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D82 >--------------------------------------------------------------- b5ed2f277e551dcaade5837568e4cbb7dd811c04 compiler/coreSyn/CorePrep.lhs | 4 + compiler/ghc.mk | 8 +- compiler/prelude/PrelNames.lhs | 9 +- compiler/prelude/TysWiredIn.lhs | 32 +- ghc.mk | 4 +- libraries/base/GHC/Real.lhs | 6 + libraries/base/base.cabal | 19 +- libraries/{ghc-prim => integer-gmp2}/.gitignore | 0 libraries/integer-gmp2/LICENSE | 30 + libraries/integer-gmp2/cbits/wrappers.c | 281 ++++ libraries/integer-gmp2/integer-gmp2.cabal | 49 + .../src/GHC/Integer.hs} | 49 +- .../integer-gmp2/src/GHC/Integer/GMP2/Internals.hs | 126 ++ .../integer-gmp2/src/GHC/Integer/Logarithms.hs | 73 + .../src/GHC/Integer/Logarithms/Internals.hs | 118 ++ libraries/integer-gmp2/src/GHC/Integer/Type.hs | 1663 ++++++++++++++++++++ rules/foreachLibrary.mk | 2 + testsuite/driver/testlib.py | 2 +- testsuite/tests/safeHaskell/check/pkg01/all.T | 6 +- 19 files changed, 2452 insertions(+), 29 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b5ed2f277e551dcaade5837568e4cbb7dd811c04 From git at git.haskell.org Sun Aug 17 11:45:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Aug 2014 11:45:40 +0000 (UTC) Subject: [commit: ghc] wip/T9281's head updated: [WIP] fixup wired-in BigNat (9c370fe) Message-ID: <20140817114540.A209B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T9281' now includes: 425d517 Fix typos 'resizze' 53cc943 Revert "Fix typos 'resizze'" this is z-encoding (as hvr tells me) 6375934 Workaround GCC `__ctzdi2` intrinsic linker errors 96d0418 Remove obsolete `digitsTyConKey :: Unique` 50bf0be Implement `decodeDouble_Int64#` primop b5ed2f2 Implement new integer-gmp2 from scratch (re #9281) 9c370fe [WIP] fixup wired-in BigNat From git at git.haskell.org Sun Aug 17 13:04:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Aug 2014 13:04:45 +0000 (UTC) Subject: [commit: ghc] wip/T9281: [WIP] fixup wired-in BigNat (13cb42b) Message-ID: <20140817130445.DBD8924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9281 Link : http://ghc.haskell.org/trac/ghc/changeset/13cb42bc8b6b26d3893d4ddcc22eeab36d39a0c7/ghc >--------------------------------------------------------------- commit 13cb42bc8b6b26d3893d4ddcc22eeab36d39a0c7 Author: Herbert Valerio Riedel Date: Sat Aug 16 23:18:17 2014 +0200 [WIP] fixup wired-in BigNat Note, this still results in a core lint-error due to unpacking: HC [stage 1] libraries/integer-gmp2/dist-install/build/GHC/Integer/Logarithms.o ghc-stage1: panic! (the 'impossible' happened) (GHC version 7.9.20140817 for x86_64-unknown-linux): Iface Lint failure In interface for GHC.Integer.Type Unfolding of sqrInteger : Warning: In the expression: $wsqrBigNat dt Argument value doesn't match argument type: Fun type: ByteArray# -> BigNat Arg type: BigNat Arg: dt sqrInteger = \ (ds :: Integer) -> case ds of wild { SI# ds1 -> case ds1 of ds2 { __DEFAULT -> let { nsign :: Int# [LclId, Str=DmdType] nsign = uncheckedIShiftRA# ds2 63 } in case tagToEnum# @ Bool (<=# (-# (xorI# ds2 nsign) nsign) 3037000499) of wild1 { False -> timesInt2Integer ds2 ds2; True -> SI# (*# ds2 ds2) }; (-9223372036854775808) -> sqrInteger1 }; Jp# dt -> case $wsqrBigNat dt of dt1 { BN# dt2 -> Jp# dt2 }; Jn# dt -> case $wsqrBigNat dt of dt1 { BN# dt2 -> Jp# dt2 } } Iface expr = \ ds :: Integer -> case ds of wild { SI# ds1 -> case ds1 of ds2 { DEFAULT -> let { nsign :: Int# = uncheckedIShiftRA# ds2 63 } in case tagToEnum# @ Bool (<=# (-# (xorI# ds2 nsign) nsign) 3037000499) of wild1 { False -> timesInt2Integer ds2 ds2 True -> SI# (*# ds2 ds2) } (-9223372036854775808) -> sqrInteger1 } Jp# dt -> case $wsqrBigNat dt of dt1 { BN# dt2 -> Jp# dt2 } Jn# dt -> case $wsqrBigNat dt of dt1 { BN# dt2 -> Jp# dt2 } } Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug >--------------------------------------------------------------- 13cb42bc8b6b26d3893d4ddcc22eeab36d39a0c7 compiler/prelude/PrelNames.lhs | 9 +++++---- compiler/prelude/TysWiredIn.lhs | 45 +++++++++++++++++++++++++++++++---------- 2 files changed, 39 insertions(+), 15 deletions(-) diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 6a30a3f..ddf1c39 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -1328,7 +1328,7 @@ addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey, byteA floatPrimTyConKey, floatTyConKey, funTyConKey, intPrimTyConKey, intTyConKey, int8TyConKey, int16TyConKey, int32PrimTyConKey, int32TyConKey, int64PrimTyConKey, int64TyConKey, - integerTyConKey, + integerTyConKey, bigNatTyConKey, listTyConKey, foreignObjPrimTyConKey, weakPrimTyConKey, mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey, mutableByteArrayPrimTyConKey, orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey, @@ -1355,7 +1355,7 @@ int32TyConKey = mkPreludeTyConUnique 19 int64PrimTyConKey = mkPreludeTyConUnique 20 int64TyConKey = mkPreludeTyConUnique 21 integerTyConKey = mkPreludeTyConUnique 22 - +bigNatTyConKey = mkPreludeTyConUnique 23 listTyConKey = mkPreludeTyConUnique 24 foreignObjPrimTyConKey = mkPreludeTyConUnique 25 weakPrimTyConKey = mkPreludeTyConUnique 27 @@ -1594,12 +1594,13 @@ integerGmpJDataConKey = mkPreludeDataConUnique 31 -- For integer-gmp2 only integerGmp2SIDataConKey, integerGmp2JpDataConKey, - integerGmp2JnDataConKey :: Unique + integerGmp2JnDataConKey, bigNatDataConKey :: Unique integerGmp2SIDataConKey = mkPreludeDataConUnique 32 integerGmp2JpDataConKey = mkPreludeDataConUnique 33 integerGmp2JnDataConKey = mkPreludeDataConUnique 34 +bigNatDataConKey = mkPreludeDataConUnique 35 -coercibleDataConKey = mkPreludeDataConUnique 35 +coercibleDataConKey = mkPreludeDataConUnique 36 \end{code} %************************************************************************ diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs index d09c9dc..9393b46 100644 --- a/compiler/prelude/TysWiredIn.lhs +++ b/compiler/prelude/TysWiredIn.lhs @@ -165,7 +165,7 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because ] ++ (case cIntegerLibraryType of IntegerGMP -> [integerTyCon] - IntegerGMP2 -> [integerTyCon] + IntegerGMP2 -> [integerTyCon, bigNatTyCon] _ -> []) \end{code} @@ -237,6 +237,11 @@ integerGmp2SIDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsL integerGmp2JpDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "Jp#") integerGmp2JpDataConKey integerGmp2JpDataCon integerGmp2JnDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "Jn#") integerGmp2JnDataConKey integerGmp2JnDataCon +-- GHC.Integer.Type.BigNat +bigNatTyConName, bigNatDataConName :: Name +bigNatTyConName = mkWiredInTyConName UserSyntax gHC_INTEGER_TYPE (fsLit "BigNat") bigNatTyConKey bigNatTyCon +bigNatDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "BN#") bigNatDataConKey bigNatDataCon + parrTyConName, parrDataConName :: Name parrTyConName = mkWiredInTyConName BuiltInSyntax gHC_PARR' (fsLit "[::]") parrTyConKey parrTyCon @@ -288,8 +293,11 @@ pcTyCon is_enum is_rec is_prom name cType tyvars cons pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon pcDataCon = pcDataConWithFixity False +pcDataConWithBangs :: [HsBang] -> Name -> [TyVar] -> [Type] -> TyCon -> DataCon +pcDataConWithBangs bangs n = pcDataConWithFixity' False n (incrUnique (nameUnique n)) bangs + pcDataConWithFixity :: Bool -> Name -> [TyVar] -> [Type] -> TyCon -> DataCon -pcDataConWithFixity infx n = pcDataConWithFixity' infx n (incrUnique (nameUnique n)) +pcDataConWithFixity infx n = pcDataConWithFixity' infx n (incrUnique (nameUnique n)) [] -- The Name's unique is the first of two free uniques; -- the first is used for the datacon itself, -- the second is used for the "worker name" @@ -297,15 +305,15 @@ pcDataConWithFixity infx n = pcDataConWithFixity' infx n (incrUnique (nameUnique -- To support this the mkPreludeDataConUnique function "allocates" -- one DataCon unique per pair of Ints. -pcDataConWithFixity' :: Bool -> Name -> Unique -> [TyVar] -> [Type] -> TyCon -> DataCon +pcDataConWithFixity' :: Bool -> Name -> Unique -> [HsBang] -> [TyVar] -> [Type] -> TyCon -> DataCon -- The Name should be in the DataName name space; it's the name -- of the DataCon itself. -pcDataConWithFixity' declared_infix dc_name wrk_key tyvars arg_tys tycon +pcDataConWithFixity' declared_infix dc_name wrk_key arg_bangs tyvars arg_tys tycon = data_con where data_con = mkDataCon dc_name declared_infix - (map (const HsNoBang) arg_tys) + bangs [] -- No labelled fields tyvars [] -- No existential type variables @@ -322,6 +330,8 @@ pcDataConWithFixity' declared_infix dc_name wrk_key tyvars arg_tys tycon wrk_occ = mkDataConWorkerOcc (nameOccName dc_name) wrk_name = mkWiredInName modu wrk_occ wrk_key (AnId (dataConWorkId data_con)) UserSyntax + bangs | null arg_bangs = map (const HsNoBang) arg_tys + | otherwise = arg_bangs \end{code} @@ -613,14 +623,27 @@ integerGmpJDataCon = pcDataCon integerGmpJDataConName [] integerTyCon integerGmp2JpDataCon :: DataCon -integerGmp2JpDataCon = pcDataCon integerGmp2JpDataConName [] - [byteArrayPrimTy] - integerTyCon +integerGmp2JpDataCon = pcDataConWithBangs + [HsUserBang (Just True) True] + integerGmp2JpDataConName [] + [bigNatTy] + integerTyCon integerGmp2JnDataCon :: DataCon -integerGmp2JnDataCon = pcDataCon integerGmp2JnDataConName [] - [byteArrayPrimTy] - integerTyCon +integerGmp2JnDataCon = pcDataConWithBangs + [HsUserBang (Just True) True] + integerGmp2JnDataConName [] + [bigNatTy] + integerTyCon + +bigNatTy :: Type +bigNatTy = mkTyConTy bigNatTyCon + +bigNatTyCon :: TyCon +bigNatTyCon = pcNonRecDataTyCon bigNatTyConName Nothing [] [bigNatDataCon] + +bigNatDataCon :: DataCon +bigNatDataCon = pcDataCon bigNatDataConName [] [byteArrayPrimTy] bigNatTyCon \end{code} From git at git.haskell.org Sun Aug 17 21:27:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Aug 2014 21:27:15 +0000 (UTC) Subject: [commit: ghc] master: workaround Solaris 11 GNU C CPP issue by using GNU C 3.4 as CPP (2d42564) Message-ID: <20140817212716.02E3424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2d42564ac9ffe768f21078e40886fd066f87d1c3/ghc >--------------------------------------------------------------- commit 2d42564ac9ffe768f21078e40886fd066f87d1c3 Author: Karel Gardas Date: Sun Aug 17 23:26:39 2014 +0200 workaround Solaris 11 GNU C CPP issue by using GNU C 3.4 as CPP Summary: Solaris 11 distributed GNU C 4.5.x is configured in a way that its CPP is not working well while invoked from GHC. GHC runs it with -x assembler-with-cpp and in this particular configuration GNU C CPP does not provide any line-markers so GHC's output of errors or warnings is confusing since it points to preprocessed file in /tmp and not to the original Haskell file. Fortunately old GNU C 3.4.x is still provided by the OS and when installed it'll be used automatically as GHC CPP which is whole logic of this patch. So although we use modern GCC as a C compiler and assembler we use old GCC as a C preprocessor. Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D151 >--------------------------------------------------------------- 2d42564ac9ffe768f21078e40886fd066f87d1c3 aclocal.m4 | 98 +++++++++++++++++++++++++++++++++++++++++++++++++ configure.ac | 56 +--------------------------- distrib/configure.ac.in | 60 +----------------------------- 3 files changed, 102 insertions(+), 112 deletions(-) diff --git a/aclocal.m4 b/aclocal.m4 index d3a32b8..7fcf67e 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -2126,5 +2126,103 @@ AC_DEFUN([MAYBE_OVERRIDE_STAGE0],[ ]) +# FP_CPP_CMD_WITH_ARGS() +# ---------------------- +# sets CPP command and its arguments +# +# $1 = the variable to set to CPP command +# $2 = the varibale to set to CPP command arguments + +AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ +dnl ** what cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AC_HELP_STRING([--with-hs-cpp=ARG], + [Use ARG as the path to cpp [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + HS_CPP_CMD=$WhatGccIsCalled + + SOLARIS_GCC_CPP_BROKEN=NO + SOLARIS_FOUND_GOOD_CPP=NO + case $host in + i386-*-solaris2) + GCC_MAJOR_MINOR=`$WhatGccIsCalled --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$GCC_MAJOR_MINOR" != "3.4"; then + # this is not 3.4.x release so with broken CPP + SOLARIS_GCC_CPP_BROKEN=YES + fi + ;; + esac + + if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then + # let's try to find if GNU C 3.4.x is installed + if test -x /usr/sfw/bin/gcc; then + # something executable is in expected path so let's + # see if it's really GNU C + NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then + # this is GNU C 3.4.x which provides non-broken CPP on Solaris + # let's use it as CPP then. + HS_CPP_CMD=/usr/sfw/bin/gcc + SOLARIS_FOUND_GOOD_CPP=YES + fi + fi + if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then + AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) + AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) + fi + fi +] +) + + + +dnl ** what cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AC_HELP_STRING([--with-hs-cpp-flags=ARG], + [Use ARG as the path to hs cpp [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs " + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional " + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) # LocalWords: fi diff --git a/configure.ac b/configure.ac index 378578a..a065b31 100644 --- a/configure.ac +++ b/configure.ac @@ -484,60 +484,8 @@ export CC MAYBE_OVERRIDE_STAGE0([gcc],[CC_STAGE0]) MAYBE_OVERRIDE_STAGE0([ar],[AR_STAGE0]) -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AC_HELP_STRING([--with-hs-cpp=ARG], - [Use ARG as the path to cpp [default=autodetect]])], -[ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HaskellCPPCmd=$withval - fi -], -[ - HaskellCPPCmd=$WhatGccIsCalled -] -) - - - -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AC_HELP_STRING([--with-hs-cpp-flags=ARG], - [Use ARG as the path to hs cpp [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HaskellCPPArgs=$withval - fi - ], -[ - $HaskellCPPCmd -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HaskellCPPArgs="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs " - else - $HaskellCPPCmd -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HaskellCPPArgs="-E -undef -traditional " - else - $HaskellCPPCmd --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HaskellCPPArgs="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HaskellCPPArgs="" - fi - fi - fi - ] -) - +# --with-hs-cpp/--with-hs-cpp-flags +FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) dnl ** Which ld to use? dnl -------------------------------------------------------------- diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in index c7a8ead..2ae0072 100644 --- a/distrib/configure.ac.in +++ b/distrib/configure.ac.in @@ -63,64 +63,8 @@ FIND_GCC([WhatGccIsCalled], [gcc], [gcc]) CC="$WhatGccIsCalled" export CC - -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AC_HELP_STRING([--with-hs-cpp=ARG], - [Use ARG as the path to cpp [default=autodetect]])], -[ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HaskellCPPCmd=$withval - fi -], -[ - if test "$HostOS" != "mingw32" - then - HaskellCPPCmd=$WhatGccIsCalled - fi -] -) - - - -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AC_HELP_STRING([--with-hs-cpp-flags=ARG], - [Use ARG as the path to hs cpp [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HaskellCPPArgs=$withval - fi - ], -[ - $HaskellCPPCmd -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HaskellCPPArgs="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs " - else - $HaskellCPPCmd -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HaskellCPPArgs="-E -undef -traditional " - else - $HaskellCPPCmd --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HaskellCPPArgs="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HaskellCPPArgs="" - fi - fi - fi - ] -) - +# --with-hs-cpp/--with-hs-cpp-flags +FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) dnl ** Which ld to use? dnl -------------------------------------------------------------- From git at git.haskell.org Mon Aug 18 08:21:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Aug 2014 08:21:54 +0000 (UTC) Subject: [commit: ghc] master: Fix quasi-quoter documentation (#9448) (2aabda1) Message-ID: <20140818082154.9A0D524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2aabda1a836a5250c3176e8559a10479214a55f6/ghc >--------------------------------------------------------------- commit 2aabda1a836a5250c3176e8559a10479214a55f6 Author: Sergey Vinokurov Date: Sat Aug 16 22:13:41 2014 +0300 Fix quasi-quoter documentation (#9448) >--------------------------------------------------------------- 2aabda1a836a5250c3176e8559a10479214a55f6 docs/users_guide/glasgow_exts.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index bfdeea4..f515313 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -9003,8 +9003,8 @@ A quasi-quote has the form [quoter| string |]. -The quoter must be the (unqualified) name of an imported -quoter; it cannot be an arbitrary expression. +The quoter must be the name of an imported quoter, +either qualified or unqualified; it cannot be an arbitrary expression. The quoter cannot be "e", From git at git.haskell.org Mon Aug 18 08:21:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Aug 2014 08:21:56 +0000 (UTC) Subject: [commit: ghc] master: Fix broken link in Data.Data to SYB home page (Trac #9455) (daef885) Message-ID: <20140818082156.C995024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/daef885a8a9866af5b486d21a1940d4e3d93d9d0/ghc >--------------------------------------------------------------- commit daef885a8a9866af5b486d21a1940d4e3d93d9d0 Author: Simon Peyton Jones Date: Mon Aug 18 09:21:42 2014 +0100 Fix broken link in Data.Data to SYB home page (Trac #9455) Ralf Laemmel's page has disappeared, so I made it point to the Haskell Wiki page instead. >--------------------------------------------------------------- daef885a8a9866af5b486d21a1940d4e3d93d9d0 libraries/base/Data/Data.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs index 49407fa..095bca1 100644 --- a/libraries/base/Data/Data.hs +++ b/libraries/base/Data/Data.hs @@ -13,14 +13,14 @@ -- Stability : experimental -- Portability : non-portable (local universal quantification) -- --- \"Scrap your boilerplate\" --- Generic programming in Haskell. --- See . This module provides --- the 'Data' class with its primitives for generic programming, along --- with instances for many datatypes. It corresponds to a merge between --- the previous "Data.Generics.Basics" and almost all of --- "Data.Generics.Instances". The instances that are not present --- in this module were moved to the @Data.Generics.Instances@ module --- in the @syb@ package. +-- \"Scrap your boilerplate\" --- Generic programming in Haskell. See +-- . +-- This module provides the 'Data' class with its primitives for +-- generic programming, along with instances for many datatypes. It +-- corresponds to a merge between the previous "Data.Generics.Basics" +-- and almost all of "Data.Generics.Instances". The instances that are +-- not present in this module were moved to the +-- @Data.Generics.Instances@ module in the @syb@ package. -- -- For more information, please visit the new -- SYB wiki: . From git at git.haskell.org Tue Aug 19 00:04:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 00:04:21 +0000 (UTC) Subject: [commit: ghc] master: Update list of flags implied by -XGADTs in User's Guide section on GADTs (b287bc9) Message-ID: <20140819000421.C566424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b287bc9bd0afaa26fcd3fe53a49bf86deeb868d8/ghc >--------------------------------------------------------------- commit b287bc9bd0afaa26fcd3fe53a49bf86deeb868d8 Author: Reid Barton Date: Mon Aug 18 19:39:58 2014 -0400 Update list of flags implied by -XGADTs in User's Guide section on GADTs >--------------------------------------------------------------- b287bc9bd0afaa26fcd3fe53a49bf86deeb868d8 docs/users_guide/glasgow_exts.xml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index f515313..a6c43b8 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -3708,7 +3708,8 @@ may use different notation to that implemented in GHC. The rest of this section outlines the extensions to GHC that support GADTs. The extension is enabled with -. The flag also sets . +. The flag also sets +and . A GADT can only be declared using GADT-style syntax (); From git at git.haskell.org Tue Aug 19 03:15:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 03:15:36 +0000 (UTC) Subject: [commit: ghc] master: Make T8832 operative on 32-bit systems (#8832) (a72614c) Message-ID: <20140819031536.3DF5024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a72614c40186521da7ba090b102436e61a80b7a7/ghc >--------------------------------------------------------------- commit a72614c40186521da7ba090b102436e61a80b7a7 Author: Reid Barton Date: Mon Aug 18 22:27:38 2014 -0400 Make T8832 operative on 32-bit systems (#8832) (Also, the 'extra_clean' was unnecessary.) >--------------------------------------------------------------- a72614c40186521da7ba090b102436e61a80b7a7 testsuite/tests/simplCore/should_compile/Makefile | 2 +- testsuite/tests/simplCore/should_compile/T8832.hs | 4 ++++ .../simplCore/should_compile/{T8832.stdout => T8832.stdout-ws-32} | 2 -- testsuite/tests/simplCore/should_compile/all.T | 5 +++-- 4 files changed, 8 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile index d615a5e..07eedf1 100644 --- a/testsuite/tests/simplCore/should_compile/Makefile +++ b/testsuite/tests/simplCore/should_compile/Makefile @@ -4,7 +4,7 @@ include $(TOP)/mk/test.mk T8832: $(RM) -f T8832.o T8832.hi - '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T8832.hs | grep '#' + '$(TEST_HC)' $(TEST_HC_OPTS) $(T8832_WORDSIZE_OPTS) -O -c -ddump-simpl T8832.hs | grep '#' T7865: $(RM) -f T7865.o T7865.hi diff --git a/testsuite/tests/simplCore/should_compile/T8832.hs b/testsuite/tests/simplCore/should_compile/T8832.hs index 9059a18..d2e4ca0 100644 --- a/testsuite/tests/simplCore/should_compile/T8832.hs +++ b/testsuite/tests/simplCore/should_compile/T8832.hs @@ -17,12 +17,16 @@ T(i,Int) T(i8,Int8) T(i16,Int16) T(i32,Int32) +#ifdef T8832_WORDSIZE_64 T(i64,Int64) +#endif T(w,Word) T(w8,Word8) T(w16,Word16) T(w32,Word32) +#ifdef T8832_WORDSIZE_64 T(w64,Word64) +#endif T(z,Integer) \ No newline at end of file diff --git a/testsuite/tests/simplCore/should_compile/T8832.stdout b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 similarity index 79% copy from testsuite/tests/simplCore/should_compile/T8832.stdout copy to testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 index 2719631..d092937 100644 --- a/testsuite/tests/simplCore/should_compile/T8832.stdout +++ b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 @@ -2,9 +2,7 @@ T8832.i = GHC.Types.I# 0 T8832.i8 = GHC.Int.I8# 0 T8832.i16 = GHC.Int.I16# 0 T8832.i32 = GHC.Int.I32# 0 -T8832.i64 = GHC.Int.I64# 0 T8832.w = GHC.Types.W# (__word 0) T8832.w8 = GHC.Word.W8# (__word 0) T8832.w16 = GHC.Word.W16# (__word 0) T8832.w32 = GHC.Word.W32# (__word 0) -T8832.w64 = GHC.Word.W64# (__word 0) diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index f9a5846..c4c32cc 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -198,9 +198,10 @@ test('T5996', ['$MAKE -s --no-print-directory T5996']) test('T8537', normal, compile, ['']) test('T8832', - [when(wordsize(32), expect_fail), extra_clean(['T8832.hi', 'T8832a.o'])], + normal, run_command, - ['$MAKE -s --no-print-directory T8832']) + ['$MAKE -s --no-print-directory T8832 T8832_WORDSIZE_OPTS=' + + ('-DT8832_WORDSIZE_64' if wordsize(64) else '')]) test('T8848', only_ways(['optasm']), compile, ['-ddump-rule-firings']) test('T8848a', only_ways(['optasm']), compile, ['-ddump-rules']) test('T8331', only_ways(['optasm']), compile, ['-ddump-rules']) From git at git.haskell.org Tue Aug 19 04:34:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 04:34:09 +0000 (UTC) Subject: [commit: ghc] master: concurrent/should_run/throwto002: DoRec -> RecursiveDo (5b11b04) Message-ID: <20140819043409.AF74224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5b11b0401fecc848fe0db1fc060593a6ee8a560c/ghc >--------------------------------------------------------------- commit 5b11b0401fecc848fe0db1fc060593a6ee8a560c Author: Ben Gamari Date: Mon Aug 18 21:38:37 2014 -0500 concurrent/should_run/throwto002: DoRec -> RecursiveDo Summary: Test case used old extension name; update it. Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D161 >--------------------------------------------------------------- 5b11b0401fecc848fe0db1fc060593a6ee8a560c testsuite/tests/concurrent/should_run/throwto002.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/concurrent/should_run/throwto002.hs b/testsuite/tests/concurrent/should_run/throwto002.hs index e7fcc36..7cb5709 100644 --- a/testsuite/tests/concurrent/should_run/throwto002.hs +++ b/testsuite/tests/concurrent/should_run/throwto002.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DoRec, ScopedTypeVariables #-} +{-# LANGUAGE RecursiveDo, ScopedTypeVariables #-} import Control.Concurrent import Control.Exception import Data.Array From git at git.haskell.org Tue Aug 19 04:34:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 04:34:12 +0000 (UTC) Subject: [commit: ghc] master: Fix three problems with occurrence analysis on case alternatives. (5d5655e) Message-ID: <20140819043412.5220D24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5d5655e9911dba10088b66421e98165c6cb8176e/ghc >--------------------------------------------------------------- commit 5d5655e9911dba10088b66421e98165c6cb8176e Author: Andrew Farmer Date: Mon Aug 18 21:40:12 2014 -0500 Fix three problems with occurrence analysis on case alternatives. Summary: 1. Respect condition (a) in Note [Binder swap] 2. Respect condition (b) in Note [Binder swap] 3. Return usage of any coercion variables in binder swap Fixes T9440 Test Plan: See #9440 Reviewers: simonpj, austin Reviewed By: simonpj, austin Subscribers: simonpj, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D156 GHC Trac Issues: #9440 >--------------------------------------------------------------- 5d5655e9911dba10088b66421e98165c6cb8176e compiler/simplCore/OccurAnal.lhs | 53 ++++++++++++++++++++++++---------------- 1 file changed, 32 insertions(+), 21 deletions(-) diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs index c932335..42a6167 100644 --- a/compiler/simplCore/OccurAnal.lhs +++ b/compiler/simplCore/OccurAnal.lhs @@ -1172,10 +1172,10 @@ occAnal env expr@(Var v) = (mkOneOcc env v False, expr) occAnal _ (Coercion co) = (addIdOccs emptyDetails (coVarsOfCo co), Coercion co) - -- See Note [Gather occurrences of coercion veriables] + -- See Note [Gather occurrences of coercion variables] \end{code} -Note [Gather occurrences of coercion veriables] +Note [Gather occurrences of coercion variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We need to gather info about what coercion variables appear, so that we can sort them into the right place when doing dependency analysis. @@ -1269,7 +1269,7 @@ occAnal env (Case scrut bndr ty alts) Just _ -> (usage `delVarEnv` bndr, setIdOccInfo bndr NoOccInfo) alt_env = mkAltEnv env scrut bndr - occ_anal_alt = occAnalAlt alt_env bndr + occ_anal_alt = occAnalAlt alt_env occ_anal_scrut (Var v) (alt1 : other_alts) | not (null other_alts) || not (isDefaultAlt alt1) @@ -1404,30 +1404,41 @@ scrutinised y). \begin{code} occAnalAlt :: (OccEnv, Maybe (Id, CoreExpr)) - -> CoreBndr -> CoreAlt -> (UsageDetails, Alt IdWithOccInfo) -occAnalAlt (env, scrut_bind) case_bndr (con, bndrs, rhs) +occAnalAlt (env, scrut_bind) (con, bndrs, rhs) = case occAnal env rhs of { (rhs_usage1, rhs1) -> let - (rhs_usage2, rhs2) = - wrapProxy (occ_binder_swap env) scrut_bind case_bndr rhs_usage1 rhs1 - (alt_usg, tagged_bndrs) = tagLamBinders rhs_usage2 bndrs - bndrs' = tagged_bndrs -- See Note [Binders in case alternatives] + (alt_usg, tagged_bndrs) = tagLamBinders rhs_usage1 bndrs + -- See Note [Binders in case alternatives] + (alt_usg', rhs2) = + wrapAltRHS env scrut_bind alt_usg tagged_bndrs rhs1 in - (alt_usg, (con, bndrs', rhs2)) } - -wrapProxy :: Bool -> Maybe (Id, CoreExpr) -> Id -> UsageDetails -> CoreExpr -> (UsageDetails, CoreExpr) -wrapProxy enable_binder_swap (Just (scrut_var, rhs)) case_bndr body_usg body - | enable_binder_swap, - scrut_var `usedIn` body_usg - = ( body_usg' +++ unitVarEnv case_bndr NoOccInfo - , Let (NonRec tagged_scrut_var rhs) body ) - where - (body_usg', tagged_scrut_var) = tagBinder body_usg scrut_var + (alt_usg', (con, tagged_bndrs, rhs2)) } -wrapProxy _ _ _ body_usg body - = (body_usg, body) +wrapAltRHS :: OccEnv + -> Maybe (Id, CoreExpr) -- proxy mapping generated by mkAltEnv + -> UsageDetails -- usage for entire alt (p -> rhs) + -> [Var] -- alt binders + -> CoreExpr -- alt RHS + -> (UsageDetails, CoreExpr) +wrapAltRHS env (Just (scrut_var, let_rhs)) alt_usg bndrs alt_rhs + | occ_binder_swap env + , scrut_var `usedIn` alt_usg -- bndrs are not be present in alt_usg so this + -- handles condition (a) in Note [Binder swap] + , not captured -- See condition (b) in Note [Binder swap] + = ( alt_usg' +++ let_rhs_usg + , Let (NonRec tagged_scrut_var let_rhs') alt_rhs ) + where + captured = any (`usedIn` let_rhs_usg) bndrs + -- The rhs of the let may include coercion variables + -- if the scrutinee was a cast, so we must gather their + -- usage. See Note [Gather occurrences of coercion variables] + (let_rhs_usg, let_rhs') = occAnal env let_rhs + (alt_usg', tagged_scrut_var) = tagBinder alt_usg scrut_var + +wrapAltRHS _ _ alt_usg _ alt_rhs + = (alt_usg, alt_rhs) \end{code} From git at git.haskell.org Tue Aug 19 04:34:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 04:34:14 +0000 (UTC) Subject: [commit: ghc] master: ghci/scripts/ghci016: Add implementation for negate (3a67aba) Message-ID: <20140819043414.A8F8E24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3a67aba2be3a7a6681d4349033c064596ce7fcde/ghc >--------------------------------------------------------------- commit 3a67aba2be3a7a6681d4349033c064596ce7fcde Author: Ben Gamari Date: Mon Aug 18 21:37:15 2014 -0500 ghci/scripts/ghci016: Add implementation for negate Summary: This previously produced a warning Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D162 >--------------------------------------------------------------- 3a67aba2be3a7a6681d4349033c064596ce7fcde testsuite/tests/ghci/scripts/ghci016.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/ghci/scripts/ghci016.hs b/testsuite/tests/ghci/scripts/ghci016.hs index 2740a66..0c86f02 100644 --- a/testsuite/tests/ghci/scripts/ghci016.hs +++ b/testsuite/tests/ghci/scripts/ghci016.hs @@ -13,6 +13,7 @@ instance Num T where (*) = error "urk" abs = error "urk" signum = error "urk" + negate = error "urk" -- Typing 3 at the ghci prompt should print T From git at git.haskell.org Tue Aug 19 04:34:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 04:34:16 +0000 (UTC) Subject: [commit: ghc] master: testsuite/T9379: Use GHC.Conc instead of Control.Concurrent.STM (88b1f99) Message-ID: <20140819043417.10AC724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/88b1f99d473e5588378699abeb203c39ea554334/ghc >--------------------------------------------------------------- commit 88b1f99d473e5588378699abeb203c39ea554334 Author: Ben Gamari Date: Mon Aug 18 21:40:21 2014 -0500 testsuite/T9379: Use GHC.Conc instead of Control.Concurrent.STM Summary: `GHC.Conc` provides almost everything we need. Signed-off-by: Ben Gamari Test Plan: make test TEST=T9379 Reviewers: austin, simonmar Reviewed By: austin, simonmar Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D152 >--------------------------------------------------------------- 88b1f99d473e5588378699abeb203c39ea554334 testsuite/tests/concurrent/should_run/T9379.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/concurrent/should_run/T9379.hs b/testsuite/tests/concurrent/should_run/T9379.hs index 49e6d1e..235b2aa 100644 --- a/testsuite/tests/concurrent/should_run/T9379.hs +++ b/testsuite/tests/concurrent/should_run/T9379.hs @@ -1,6 +1,6 @@ import Control.Exception import Control.Concurrent -import Control.Concurrent.STM +import GHC.Conc import Foreign.StablePtr main :: IO () @@ -10,6 +10,8 @@ main = do t <- mask_ $ forkIO (blockSTM tv) killThread t +check b = if b then return () else retry + blockSTM :: TVar Bool -> IO () blockSTM tv = do atomically $ do From git at git.haskell.org Tue Aug 19 04:34:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 04:34:19 +0000 (UTC) Subject: [commit: ghc] master: Make Prelude.signum handle -0.0 correctly (#7858) (d9a2057) Message-ID: <20140819043421.B36EE24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d9a20573f473cc7389004470999b8a318aa6b3f2/ghc >--------------------------------------------------------------- commit d9a20573f473cc7389004470999b8a318aa6b3f2 Author: Alexander Berntsen Date: Mon Aug 18 21:43:33 2014 -0500 Make Prelude.signum handle -0.0 correctly (#7858) Summary: Make the `Float` and `Double` implementations of `signum` handle -0.0 correctly per IEEE-754. This, together with "Make Prelude.abs handle -0.0 correctly (#7858)", fixes Trac #7858. Depends on D145 Signed-off-by: Alexander Berntsen Test Plan: signum of (-0.0) should be (-0.0) not 0.0. Test program: main = putStrLn $ p ++ " " ++ n where f = show . signum p = f (-0.0 :: Double) n = f (0.0 :: Double) Reviewers: ekmett, hvr, rwbarton, austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D148 GHC Trac Issues: #7858 >--------------------------------------------------------------- d9a20573f473cc7389004470999b8a318aa6b3f2 libraries/base/GHC/Float.lhs | 13 +++++++------ libraries/base/changelog.md | 2 +- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/libraries/base/GHC/Float.lhs b/libraries/base/GHC/Float.lhs index 52fc9a9..fcb9c16 100644 --- a/libraries/base/GHC/Float.lhs +++ b/libraries/base/GHC/Float.lhs @@ -208,9 +208,9 @@ instance Num Float where abs x | x == 0 = 0 -- handles (-0.0) | x > 0 = x | otherwise = negateFloat x - signum x | x == 0.0 = 0 - | x > 0.0 = 1 - | otherwise = negate 1 + signum x | x > 0 = 1 + | x < 0 = negateFloat 1 + | otherwise = x -- handles 0.0, (-0.0), and NaN {-# INLINE fromInteger #-} fromInteger i = F# (floatFromInteger i) @@ -374,9 +374,10 @@ instance Num Double where abs x | x == 0 = 0 -- handles (-0.0) | x > 0 = x | otherwise = negateDouble x - signum x | x == 0.0 = 0 - | x > 0.0 = 1 - | otherwise = negate 1 + signum x | x > 0 = 1 + | x < 0 = negateDouble 1 + | otherwise = x -- handles 0.0, (-0.0), and NaN + {-# INLINE fromInteger #-} fromInteger i = D# (doubleFromInteger i) diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 251ca88..28005f8 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -18,7 +18,7 @@ enabled, so that the `Monoid` instance for `Proxy` are polykinded like `Proxy` itself is. - * Make `abs` handle (-0.0) correctly per IEEE-754. + * Make `abs` and `signum` handle (-0.0) correctly per IEEE-754. ## 4.7.0.1 *Jul 2014* From git at git.haskell.org Tue Aug 19 04:34:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 04:34:21 +0000 (UTC) Subject: [commit: ghc] master: Make Prelude.abs handle -0.0 correctly (#7858) (6f6ee6e) Message-ID: <20140819043421.E633224123@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f6ee6eaa348b1a4815190c4d526d5c81c264fa7/ghc >--------------------------------------------------------------- commit 6f6ee6eaa348b1a4815190c4d526d5c81c264fa7 Author: Alexander Berntsen Date: Mon Aug 18 21:42:12 2014 -0500 Make Prelude.abs handle -0.0 correctly (#7858) Summary: Make the `Float` and `Double` implementations of `abs` handle -0.0 correctly per IEEE-754. abs (-0.0::Float) and abs (-0.0::Double) previously returned -0.0, when they should return 0.0. This patch fixes this. Signed-off-by: Alexander Berntsen Test Plan: abs (-0.0::Double) should = 0.0 instead of (-0.0) Reviewers: ekmett, hvr, austin, rwbarton Reviewed By: austin, rwbarton Subscribers: phaskell, trofi, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D145 GHC Trac Issues: #7858 >--------------------------------------------------------------- 6f6ee6eaa348b1a4815190c4d526d5c81c264fa7 libraries/base/GHC/Float.lhs | 10 ++++++---- libraries/base/changelog.md | 2 ++ 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/libraries/base/GHC/Float.lhs b/libraries/base/GHC/Float.lhs index e0c4f4a..52fc9a9 100644 --- a/libraries/base/GHC/Float.lhs +++ b/libraries/base/GHC/Float.lhs @@ -205,8 +205,9 @@ instance Num Float where (-) x y = minusFloat x y negate x = negateFloat x (*) x y = timesFloat x y - abs x | x >= 0.0 = x - | otherwise = negateFloat x + abs x | x == 0 = 0 -- handles (-0.0) + | x > 0 = x + | otherwise = negateFloat x signum x | x == 0.0 = 0 | x > 0.0 = 1 | otherwise = negate 1 @@ -370,8 +371,9 @@ instance Num Double where (-) x y = minusDouble x y negate x = negateDouble x (*) x y = timesDouble x y - abs x | x >= 0.0 = x - | otherwise = negateDouble x + abs x | x == 0 = 0 -- handles (-0.0) + | x > 0 = x + | otherwise = negateDouble x signum x | x == 0.0 = 0 | x > 0.0 = 1 | otherwise = negate 1 diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 06c9fa5..251ca88 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -18,6 +18,8 @@ enabled, so that the `Monoid` instance for `Proxy` are polykinded like `Proxy` itself is. + * Make `abs` handle (-0.0) correctly per IEEE-754. + ## 4.7.0.1 *Jul 2014* * Bundled with GHC 7.8.3 From git at git.haskell.org Tue Aug 19 04:34:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 04:34:24 +0000 (UTC) Subject: [commit: ghc] master: Implement -rdynamic in Linux and Windows/MinGW32. (0138110) Message-ID: <20140819043429.5761F24123@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0138110125400581dc9872dedfcb21bd50b372f1/ghc >--------------------------------------------------------------- commit 0138110125400581dc9872dedfcb21bd50b372f1 Author: Facundo Dom?nguez Date: Mon Aug 18 21:50:15 2014 -0500 Implement -rdynamic in Linux and Windows/MinGW32. Summary: In Linux, it is a synonym for -optl -rdynamic. In Windows, it is a synonym for -optl -export-all-symbols. Test Plan: validate Reviewers: simonmar, austin Reviewed By: simonmar, austin Subscribers: mboes, phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D102 GHC Trac Issues: #9381 >--------------------------------------------------------------- 0138110125400581dc9872dedfcb21bd50b372f1 compiler/main/DynFlags.hs | 9 +++++++- docs/users_guide/flags.xml | 9 ++++++++ docs/users_guide/phases.xml | 15 ++++++++++++++ testsuite/tests/rts/all.T | 5 +++++ testsuite/tests/rts/rdynamic.hs | 41 +++++++++++++++++++++++++++++++++++++ testsuite/tests/rts/rdynamic.stdout | 1 + 6 files changed, 79 insertions(+), 1 deletion(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 74bd139..f00ee46 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2175,8 +2175,15 @@ dynamic_flags = [ ----- Linker -------------------------------------------------------- , Flag "static" (NoArg removeWayDyn) , Flag "dynamic" (NoArg (addWay WayDyn)) + , Flag "rdynamic" $ noArg $ +#ifdef linux_HOST_OS + addOptl "-rdynamic" +#elif defined (mingw32_HOST_OS) + addOptl "-export-all-symbols" +#else -- ignored for compat w/ gcc: - , Flag "rdynamic" (NoArg (return ())) + id +#endif , Flag "relative-dynlib-paths" (NoArg (setGeneralFlag Opt_RelativeDynlibPaths)) ------- Specific phases -------------------------------------------- diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index 8381ca1..dbad118 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -2429,6 +2429,15 @@ dynamic - + + + This instructs the linker to add all symbols, not only used ones, to the + dynamic symbol table. Currently Linux and Windows/MinGW32 only. + This is equivalent to using -optl -rdynamic in linux, + and -optl -export-all-symbols in Windows. + dynamic + - + diff --git a/docs/users_guide/phases.xml b/docs/users_guide/phases.xml index 8a5589a..fb92fd3 100644 --- a/docs/users_guide/phases.xml +++ b/docs/users_guide/phases.xml @@ -1230,6 +1230,21 @@ $ cat foo.hspp platforms. + + + + + + + + + + This instructs the linker to add all symbols, not only used ones, to the + dynamic symbol table. Currently Linux and Windows/MinGW32 only. + This is equivalent to using -optl -rdynamic in linux, + and -optl -export-all-symbols in Windows. + + diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index d7c74c5..e9d3ff9 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -231,6 +231,11 @@ test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], c # with the non-threaded one. test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug']) +# -rdynamic is implemented in windows, but the RTS linker does +# not pickup yet the symbols exported in executables. +test('rdynamic', unless(opsys('linux'), skip), + compile_and_run, ['-rdynamic -package ghc']) + # 251 = RTS exit code for "out of memory" test('overflow1', [ exit_code(251) ], compile_and_run, ['']) test('overflow2', [ exit_code(251) ], compile_and_run, ['']) diff --git a/testsuite/tests/rts/rdynamic.hs b/testsuite/tests/rts/rdynamic.hs new file mode 100644 index 0000000..5fb4651 --- /dev/null +++ b/testsuite/tests/rts/rdynamic.hs @@ -0,0 +1,41 @@ +-- | A test to load symbols exposed with @-rdynamic at . +-- +-- Exporting 'f' from Main is important, otherwise, the corresponding symbol +-- wouldn't appear in symbol tables. +-- +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +module Main(main, f) where + +import Foreign.C.String ( withCString, CString ) +import GHC.Exts ( addrToAny# ) +import GHC.Ptr ( Ptr(..), nullPtr ) +import System.Info ( os ) +import Encoding + +main = (loadFunction Nothing "Main" "f" :: IO (Maybe String)) >>= print + +f :: String +f = "works" + +-- loadFunction__ taken from +-- @plugins-1.5.4.0:System.Plugins.Load.loadFunction__@ +loadFunction :: Maybe String + -> String + -> String + -> IO (Maybe a) +loadFunction mpkg m valsym = do + let symbol = prefixUnderscore + ++ maybe "" (\p -> zEncodeString p ++ "_") mpkg + ++ zEncodeString m ++ "_" ++ zEncodeString valsym + ++ "_closure" + ptr@(Ptr addr) <- withCString symbol c_lookupSymbol + if (ptr == nullPtr) + then return Nothing + else case addrToAny# addr of + (# hval #) -> return ( Just hval ) + where + prefixUnderscore = if elem os ["darwin","mingw32","cygwin"] then "_" else "" + +foreign import ccall safe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) diff --git a/testsuite/tests/rts/rdynamic.stdout b/testsuite/tests/rts/rdynamic.stdout new file mode 100644 index 0000000..fe9b7b1 --- /dev/null +++ b/testsuite/tests/rts/rdynamic.stdout @@ -0,0 +1 @@ +Just "works" From git at git.haskell.org Tue Aug 19 04:34:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 04:34:30 +0000 (UTC) Subject: [commit: ghc] master: Bug #9439: Ensure that stage 0 compiler isn't affected (bbd0311) Message-ID: <20140819043432.3B94B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bbd031134a571c1020945b2548e3fc4795b5047a/ghc >--------------------------------------------------------------- commit bbd031134a571c1020945b2548e3fc4795b5047a Author: Ben Gamari Date: Mon Aug 18 21:44:25 2014 -0500 Bug #9439: Ensure that stage 0 compiler isn't affected Summary: Bug #9439 will cause miscompilation of GHC's LLVM backend. Here we ensure that an affected compiler isn't used to bootstrap. Test Plan: Attempt to bootstrap GHC with an affected stage 0 compiler. Reviewers: rwbarton, austin Reviewed By: austin Subscribers: simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D159 >--------------------------------------------------------------- bbd031134a571c1020945b2548e3fc4795b5047a Makefile | 7 +++++++ configure.ac | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ mk/project.mk.in | 3 +++ 3 files changed, 60 insertions(+) diff --git a/Makefile b/Makefile index c4cce6d..2cc62b5 100644 --- a/Makefile +++ b/Makefile @@ -44,6 +44,13 @@ endif include mk/custom-settings.mk +# Verify that stage 0 LLVM backend isn't affected by Bug #9439 if needed +ifeq "$(GHC_LLVM_AFFECTED_BY_9439)" "1" +ifneq "$(findstring -fllvm,$(GhcHcOpts) $(GhcStage1HcOpts))" "" +$(error Stage 0 compiler is affected by Bug #9439. Refusing to bootstrap with -fllvm) +endif +endif + # No need to update makefiles for these targets: REALGOALS=$(filter-out binary-dist binary-dist-prep bootstrapping-files framework-pkg clean clean_% distclean maintainer-clean show echo help test fulltest,$(MAKECMDGOALS)) diff --git a/configure.ac b/configure.ac index a065b31..1c72cfa 100644 --- a/configure.ac +++ b/configure.ac @@ -189,6 +189,56 @@ AC_SUBST([WithGhc]) dnl ** Without optimization some INLINE trickery fails for GHCi SRC_CC_OPTS="-O" +dnl ** Bug 9439: Some GHC 7.8 releases had broken LLVM code generator. +dnl Unfortunately we don't know whether the user is going to request a +dnl build with the LLVM backend as this is only given in build.mk. +dnl +dnl Instead, we try to do as much work as possible here, checking +dnl whether -fllvm is the stage 0 compiler's default. If so we +dnl fail. If not, we check whether -fllvm is affected explicitly and +dnl if so set a flag. The build system will later check this flag +dnl after the desired build flags are known. +AC_MSG_CHECKING(whether bootstrap compiler is affected by bug 9439) +echo "main = putStrLn \"%function\"" > conftestghc.hs + +# Check whether LLVM backend is default for this platform +${WithGhc} conftestghc.hs 2>&1 >/dev/null +res=`./conftestghc` +if test "x$res" == "x%object" +then + AC_MSG_RESULT(yes) + echo "Buggy bootstrap compiler" + echo "" + echo "The stage 0 compiler $WithGhc is affected by GHC Bug \#9439" + echo "and therefore will miscompile the LLVM backend if -fllvm is" + echo "used." + echo + echo "Please use another bootstrap compiler" + exit 1 +fi + +# -fllvm is not the default, but set a flag so the Makefile can check +# -for it in the build flags later on +${WithGhc} -fforce-recomp -fllvm conftestghc.hs 2>&1 >/dev/null +if test $? == 0 +then + res=`./conftestghc` + if test "x$res" == "x%object" + then + AC_MSG_RESULT(yes) + GHC_LLVM_AFFECTED_BY_9439=1 + elif test "x$res" == "x%function" + then + AC_MSG_RESULT(no) + GHC_LLVM_AFFECTED_BY_9439=0 + else + AC_MSG_WARN(unexpected output $res) + fi +else + AC_MSG_RESULT(failed to compile, assuming no) +fi +AC_SUBST([GHC_LLVM_AFFECTED_BY_9439]) + dnl-------------------------------------------------------------------- dnl * Choose host(/target/build) platform dnl-------------------------------------------------------------------- diff --git a/mk/project.mk.in b/mk/project.mk.in index 28692d4..69ed885 100644 --- a/mk/project.mk.in +++ b/mk/project.mk.in @@ -157,3 +157,6 @@ SOLARIS_BROKEN_SHLD=@SOLARIS_BROKEN_SHLD@ # Do we have a C compiler using an LLVM back end? CC_LLVM_BACKEND = @CC_LLVM_BACKEND@ CC_CLANG_BACKEND = @CC_CLANG_BACKEND@ + +# Is the stage0 compiler affected by Bug #9439? +GHC_LLVM_AFFECTED_BY_9439 = @GHC_LLVM_AFFECTED_BY_9439@ From git at git.haskell.org Tue Aug 19 04:34:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 04:34:27 +0000 (UTC) Subject: [commit: ghc] master: Have the RTS linker search symbols in the originating windows binary. (d2f0100) Message-ID: <20140819043430.4FAD12406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d2f01000ac07678b971743ebf1650837aad19b9f/ghc >--------------------------------------------------------------- commit d2f01000ac07678b971743ebf1650837aad19b9f Author: Facundo Dom?nguez Date: Mon Aug 18 21:50:33 2014 -0500 Have the RTS linker search symbols in the originating windows binary. Summary: In initLinker, this patch adds the handle of the module corresponding to the program binary to the list of DLL handles that lookupSymbol uses to search for symbols. Test Plan: validate Reviewers: simonmar, austin Reviewed By: simonmar, austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D103 GHC Trac Issues: #9382 >--------------------------------------------------------------- d2f01000ac07678b971743ebf1650837aad19b9f rts/Linker.c | 20 ++++++++++++++------ testsuite/tests/rts/all.T | 4 +--- 2 files changed, 15 insertions(+), 9 deletions(-) diff --git a/rts/Linker.c b/rts/Linker.c index a0ad90c..0a81b83 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1592,6 +1592,8 @@ static regex_t re_realso; #ifdef THREADED_RTS static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section #endif +#elif defined(OBJFORMAT_PEi386) +void addDLLHandle(pathchar* dll_name, HINSTANCE instance); #endif void initLinker (void) @@ -1689,6 +1691,7 @@ initLinker_ (int retain_cafs) */ addDLL(WSTR("msvcrt")); addDLL(WSTR("kernel32")); + addDLLHandle(WSTR("*.exe"), GetModuleHandle(NULL)); #endif IF_DEBUG(linker, debugBelch("initLinker: done\n")); @@ -1753,6 +1756,16 @@ typedef /* A list thereof. */ static IndirectAddr* indirects = NULL; +/* Adds a DLL instance to the list of DLLs in which to search for symbols. */ +void addDLLHandle(pathchar* dll_name, HINSTANCE instance) { + OpenedDLL* o_dll; + o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLLHandle" ); + o_dll->name = dll_name ? pathdup(dll_name) : NULL; + o_dll->instance = instance; + o_dll->next = opened_dlls; + opened_dlls = o_dll; +} + #endif # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) @@ -1960,12 +1973,7 @@ addDLL( pathchar *dll_name ) } stgFree(buf); - /* Add this DLL to the list of DLLs in which to search for symbols. */ - o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" ); - o_dll->name = pathdup(dll_name); - o_dll->instance = instance; - o_dll->next = opened_dlls; - opened_dlls = o_dll; + addDLLHandle(dll_name, instance); return NULL; diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index e9d3ff9..59114bd 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -231,9 +231,7 @@ test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], c # with the non-threaded one. test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug']) -# -rdynamic is implemented in windows, but the RTS linker does -# not pickup yet the symbols exported in executables. -test('rdynamic', unless(opsys('linux'), skip), +test('rdynamic', unless(opsys('linux') or opsys('mingw32'), skip), compile_and_run, ['-rdynamic -package ghc']) # 251 = RTS exit code for "out of memory" From git at git.haskell.org Tue Aug 19 04:34:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 04:34:33 +0000 (UTC) Subject: [commit: ghc] master: UNREG: fix PackageKey emission into .hc files (9a708d3) Message-ID: <20140819043433.BD6D024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9a708d38c4491dfdf7f97c03e3ff6d482cbdd66e/ghc >--------------------------------------------------------------- commit 9a708d38c4491dfdf7f97c03e3ff6d482cbdd66e Author: Sergei Trofimovich Date: Mon Aug 18 21:45:11 2014 -0500 UNREG: fix PackageKey emission into .hc files Summary: Fixes ./configure --unable-unregisterised build failure: HC [stage 1] (one of the first calls) ... : unknown package: transformers-0.4.1.0 The reason of bug is how UNREG build stores package information in .hc files: compiler/main/CodeOutput.lhs generates first line as /* GHC_PACKAGES pkg-name-ver1 pkg-name-ver2 ... while DriverPipeline.hs (getHCFilePackages) expects /* GHC_PACKAGES pkg-key1 pkg-key2 ... Fix it by emitting ghc's PackageKey in CodeOutput Signed-off-by: Sergei Trofimovich Test Plan: build-tested on ./configure --enable-unregistersied Reviewers: simonmar, ezyang, austin Reviewed By: ezyang, austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D164 >--------------------------------------------------------------- 9a708d38c4491dfdf7f97c03e3ff6d482cbdd66e compiler/main/CodeOutput.lhs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index 7a554f4..72803c0 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -124,8 +124,7 @@ outputC dflags filenm cmm_stream packages '<':_ -> "#include "++h_file _ -> "#include \""++h_file++"\"" - pkg_configs <- getPreloadPackagesAnd dflags packages - let pkg_names = map (display.sourcePackageId) pkg_configs + let pkg_names = map packageKeyString packages doOutput filenm $ \ h -> do hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") From git at git.haskell.org Tue Aug 19 06:39:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 06:39:18 +0000 (UTC) Subject: [commit: ghc] master: This note's name has been fixed (955dfcb) Message-ID: <20140819063918.B99D324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/955dfcba4d48e9b5795bc80e79c5c7c2bade432b/ghc >--------------------------------------------------------------- commit 955dfcba4d48e9b5795bc80e79c5c7c2bade432b Author: Gabor Greif Date: Tue Aug 19 08:35:06 2014 +0200 This note's name has been fixed >--------------------------------------------------------------- 955dfcba4d48e9b5795bc80e79c5c7c2bade432b compiler/simplCore/OccurAnal.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs index 42a6167..2ce32a1 100644 --- a/compiler/simplCore/OccurAnal.lhs +++ b/compiler/simplCore/OccurAnal.lhs @@ -1199,7 +1199,7 @@ occAnal env (Cast expr co) = case occAnal env expr of { (usage, expr') -> let usage1 = markManyIf (isRhsEnv env) usage usage2 = addIdOccs usage1 (coVarsOfCo co) - -- See Note [Gather occurrences of coercion veriables] + -- See Note [Gather occurrences of coercion variables] in (usage2, Cast expr' co) -- If we see let x = y `cast` co -- then mark y as 'Many' so that we don't From git at git.haskell.org Tue Aug 19 07:09:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 07:09:25 +0000 (UTC) Subject: [commit: ghc] master: includes/stg/Prim.h: add matching 'hs_atomic_*' prototypes (4333a91) Message-ID: <20140819070925.B76F324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4333a91eee6d14a974632101d1bc41ee7573ddf7/ghc >--------------------------------------------------------------- commit 4333a91eee6d14a974632101d1bc41ee7573ddf7 Author: Sergei Trofimovich Date: Tue Aug 19 10:05:43 2014 +0300 includes/stg/Prim.h: add matching 'hs_atomic_*' prototypes Fixes implicit function declarations in C codegen. Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 4333a91eee6d14a974632101d1bc41ee7573ddf7 includes/stg/Prim.h | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/includes/stg/Prim.h b/includes/stg/Prim.h index 48bbddb..80f4f8e 100644 --- a/includes/stg/Prim.h +++ b/includes/stg/Prim.h @@ -14,6 +14,44 @@ #ifndef PRIM_H #define PRIM_H +/* libraries/ghc-prim/cbits/atomic.c */ +StgWord hs_atomic_add8(volatile StgWord8 *x, StgWord val); +StgWord hs_atomic_add16(volatile StgWord16 *x, StgWord val); +StgWord hs_atomic_add32(volatile StgWord32 *x, StgWord val); +StgWord64 hs_atomic_add64(volatile StgWord64 *x, StgWord64 val); +StgWord hs_atomic_sub8(volatile StgWord8 *x, StgWord val); +StgWord hs_atomic_sub16(volatile StgWord16 *x, StgWord val); +StgWord hs_atomic_sub32(volatile StgWord32 *x, StgWord val); +StgWord64 hs_atomic_sub64(volatile StgWord64 *x, StgWord64 val); +StgWord hs_atomic_and8(volatile StgWord8 *x, StgWord val); +StgWord hs_atomic_and16(volatile StgWord16 *x, StgWord val); +StgWord hs_atomic_and32(volatile StgWord32 *x, StgWord val); +StgWord64 hs_atomic_and64(volatile StgWord64 *x, StgWord64 val); +StgWord hs_atomic_nand8(volatile StgWord8 *x, StgWord val); +StgWord hs_atomic_nand16(volatile StgWord16 *x, StgWord val); +StgWord hs_atomic_nand32(volatile StgWord32 *x, StgWord val); +StgWord64 hs_atomic_nand64(volatile StgWord64 *x, StgWord64 val); +StgWord hs_atomic_or8(volatile StgWord8 *x, StgWord val); +StgWord hs_atomic_or16(volatile StgWord16 *x, StgWord val); +StgWord hs_atomic_or32(volatile StgWord32 *x, StgWord val); +StgWord64 hs_atomic_or64(volatile StgWord64 *x, StgWord64 val); +StgWord hs_atomic_xor8(volatile StgWord8 *x, StgWord val); +StgWord hs_atomic_xor16(volatile StgWord16 *x, StgWord val); +StgWord hs_atomic_xor32(volatile StgWord32 *x, StgWord val); +StgWord64 hs_atomic_xor64(volatile StgWord64 *x, StgWord64 val); +StgWord hs_cmpxchg8(volatile StgWord8 *x, StgWord old, StgWord new); +StgWord hs_cmpxchg16(volatile StgWord16 *x, StgWord old, StgWord new); +StgWord hs_cmpxchg32(volatile StgWord32 *x, StgWord old, StgWord new); +StgWord hs_cmpxchg64(volatile StgWord64 *x, StgWord64 old, StgWord64 new); +StgWord hs_atomicread8(volatile StgWord8 *x); +StgWord hs_atomicread16(volatile StgWord16 *x); +StgWord hs_atomicread32(volatile StgWord32 *x); +StgWord64 hs_atomicread64(volatile StgWord64 *x); +void hs_atomicwrite8(volatile StgWord8 *x, StgWord val); +void hs_atomicwrite16(volatile StgWord16 *x, StgWord val); +void hs_atomicwrite32(volatile StgWord32 *x, StgWord val); +void hs_atomicwrite64(volatile StgWord64 *x, StgWord64 val); + /* libraries/ghc-prim/cbits/bswap.c */ StgWord16 hs_bswap16(StgWord16 x); StgWord32 hs_bswap32(StgWord32 x); From git at git.haskell.org Tue Aug 19 10:49:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 10:49:04 +0000 (UTC) Subject: [commit: ghc] master: Use absolute links to Cabal docs from the GHC users guide (#9154) (e3c3586) Message-ID: <20140819104904.DAA3424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e3c3586d717e6f1eb0e80f25b29a16de6c0f6d5c/ghc >--------------------------------------------------------------- commit e3c3586d717e6f1eb0e80f25b29a16de6c0f6d5c Author: Bob Ippolito Date: Fri May 30 09:31:34 2014 -0700 Use absolute links to Cabal docs from the GHC users guide (#9154) Signed-off-by: Austin Seipp >--------------------------------------------------------------- e3c3586d717e6f1eb0e80f25b29a16de6c0f6d5c docs/users_guide/packages.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/packages.xml b/docs/users_guide/packages.xml index ee29cb1..7a4734d 100644 --- a/docs/users_guide/packages.xml +++ b/docs/users_guide/packages.xml @@ -23,7 +23,7 @@ Packages automates the process of configuring, building, installing and distributing a package. All you need to do is write a simple configuration file, put a few files in the right places, and you have a package. See the - Cabal documentation + Cabal documentation for details, and also the Cabal libraries (Distribution.Simple, for example). @@ -1126,7 +1126,7 @@ ghc-pkg dot | tred | dot -Tpdf >pkgs.pdf building We don't recommend building packages the hard way. Instead, use the - Cabal infrastructure + Cabal infrastructure if possible. If your package is particularly complicated or requires a lot of configuration, then you might have to fall back to the low-level mechanisms, so a few hints for those brave souls follow. From git at git.haskell.org Tue Aug 19 10:55:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 10:55:17 +0000 (UTC) Subject: [commit: ghc] master: Explain how to clone GitHub forks. Ticket #8379. (89f5f31) Message-ID: <20140819105517.BC9FD24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/89f5f314e32c3e80c71f4b3dcc8835ae74d7d57f/ghc >--------------------------------------------------------------- commit 89f5f314e32c3e80c71f4b3dcc8835ae74d7d57f Author: Thomas Miedema Date: Sat Jun 21 01:07:59 2014 +0200 Explain how to clone GitHub forks. Ticket #8379. This information is mirrored at: http://ghc.haskell.org/trac/ghc/wiki/Building/GettingTheSources#GettingaGHCrepositoryfromGitHub Signed-off-by: Austin Seipp >--------------------------------------------------------------- 89f5f314e32c3e80c71f4b3dcc8835ae74d7d57f README.md | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index f35df72..32234c0 100644 --- a/README.md +++ b/README.md @@ -26,16 +26,18 @@ There are two ways to get a source tree: 2. *Check out the source code from git* - First clone the GHC github read-only repository: + The official mirror for GHC on GitHub is located at https://github.com/ghc/ghc. $ git clone git://github.com/ghc/ghc.git - - Then run the `sync-all` script in that repository to get the other repositories: - $ cd ghc $ ./sync-all get - This checks out the "boot" packages. + If you want to clone your own fork instead, add an argument to `sync-all` to + tell it where it can find the other repositories it needs. + + $ git clone ghc + $ cd ghc + $ ./sync-all -r git://github.com/ghc get **DO NOT submit pull request directly to the github repo.** *See the GHC developer team's working conventions re [contributing patches](http://ghc.haskell.org/trac/ghc/wiki/WorkingConventions/Git#Contributingpatches "ghc.haskell.org/trac/ghc/wiki/WorkingConventions/Git#Contributingpatches").* @@ -132,5 +134,5 @@ you to join! "http://ghc.haskell.org/trac/ghc/" [11]: http://www.haskell.org/pipermail/glasgow-haskell-users/ "http://www.haskell.org/pipermail/glasgow-haskell-users/" - [12]: http://ghc.haskell.org/trac/ghc/wiki/Contributors - "http://ghc.haskell.org/trac/ghc/wiki/Contributors" + [12]: http://ghc.haskell.org/trac/ghc/wiki/TeamGHC + "http://ghc.haskell.org/trac/ghc/wiki/TeamGHC" From git at git.haskell.org Tue Aug 19 11:11:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 11:11:41 +0000 (UTC) Subject: [commit: ghc] master: Mention that `Data.Ix` uses row-major indexing (2fc2294) Message-ID: <20140819111143.CB5C824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2fc22949e30eab9f751be90e788ebb2b56f1b132/ghc >--------------------------------------------------------------- commit 2fc22949e30eab9f751be90e788ebb2b56f1b132 Author: Alexander Berntsen Date: Fri May 16 17:32:04 2014 +0200 Mention that `Data.Ix` uses row-major indexing This addresses Trac #8712 by simply mentioning row-major indexing, thereby removing any ambiguity. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2fc22949e30eab9f751be90e788ebb2b56f1b132 libraries/base/Data/Ix.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Data/Ix.hs b/libraries/base/Data/Ix.hs index bdfea60..d3be1c4 100644 --- a/libraries/base/Data/Ix.hs +++ b/libraries/base/Data/Ix.hs @@ -12,7 +12,7 @@ -- -- The 'Ix' class is used to map a contiguous subrange of values in -- type onto integers. It is used primarily for array indexing --- (see the array package). +-- (see the array package). 'Ix' uses row-major order. -- ----------------------------------------------------------------------------- From git at git.haskell.org Tue Aug 19 11:36:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 11:36:39 +0000 (UTC) Subject: [commit: ghc] master: build: require GHC 7.6 for bootstrapping (527bcc4) Message-ID: <20140819113639.C110424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/527bcc41630918977c73584d99125ff164400695/ghc >--------------------------------------------------------------- commit 527bcc41630918977c73584d99125ff164400695 Author: Austin Seipp Date: Tue Aug 19 06:36:02 2014 -0500 build: require GHC 7.6 for bootstrapping Summary: Per the usual standards, a build of GHC is only compileable by the last two releases (e.g. 7.8 only by 7.4 and 7.6). To make sure we don't get suckered into supporting older compilers, let's remove this support now. Signed-off-by: Austin Seipp Test Plan: Try to bootstrap with GHC 7.4, watch it fail. Bootstrap with 7.6 or better, and everything works. Reviewers: hvr Reviewed By: hvr Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D167 >--------------------------------------------------------------- 527bcc41630918977c73584d99125ff164400695 compiler/cmm/SMRep.lhs | 6 +----- compiler/ghci/Linker.lhs | 4 ---- compiler/utils/Panic.lhs | 20 -------------------- compiler/utils/Util.lhs | 10 ---------- configure.ac | 8 +++----- 5 files changed, 4 insertions(+), 44 deletions(-) diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs index 0713620..53c9d0a 100644 --- a/compiler/cmm/SMRep.lhs +++ b/compiler/cmm/SMRep.lhs @@ -105,11 +105,7 @@ StgWord is a type representing an StgWord on the target platform. \begin{code} -- A Word64 is large enough to hold a Word for either a 32bit or 64bit platform newtype StgWord = StgWord Word64 - deriving (Eq, -#if __GLASGOW_HASKELL__ < 706 - Num, -#endif - Bits) + deriving (Eq, Bits) fromStgWord :: StgWord -> Integer fromStgWord (StgWord i) = toInteger i diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 40b83bb..86d7b26 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -63,11 +63,7 @@ import Control.Concurrent.MVar import System.FilePath import System.IO -#if __GLASGOW_HASKELL__ > 704 import System.Directory hiding (findFile) -#else -import System.Directory -#endif import Distribution.Package hiding (depends, mkPackageKey, PackageKey) diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs index 583174b..23bf01c 100644 --- a/compiler/utils/Panic.lhs +++ b/compiler/utils/Panic.lhs @@ -35,9 +35,6 @@ import Exception import Control.Concurrent import Data.Dynamic -#if __GLASGOW_HASKELL__ < 705 -import Data.Maybe -#endif import Debug.Trace ( trace ) import System.IO.Unsafe import System.Exit @@ -52,10 +49,7 @@ import GHC.ConsoleHandler #endif import GHC.Stack - -#if __GLASGOW_HASKELL__ >= 705 import System.Mem.Weak ( Weak, deRefWeak ) -#endif -- | GHC's own exception type -- error messages all take the form: @@ -286,7 +280,6 @@ installSignalHandlers = do return () #endif -#if __GLASGOW_HASKELL__ >= 705 {-# NOINLINE interruptTargetThread #-} interruptTargetThread :: MVar [Weak ThreadId] interruptTargetThread = unsafePerformIO (newMVar []) @@ -306,19 +299,6 @@ peekInterruptTargetThread = case r of Nothing -> loop ts Just t -> return (Just t) -#else -{-# NOINLINE interruptTargetThread #-} -interruptTargetThread :: MVar [ThreadId] -interruptTargetThread = unsafePerformIO (newMVar []) - -pushInterruptTargetThread :: ThreadId -> IO () -pushInterruptTargetThread tid = do - modifyMVar_ interruptTargetThread $ return . (tid :) - -peekInterruptTargetThread :: IO (Maybe ThreadId) -peekInterruptTargetThread = - withMVar interruptTargetThread $ return . listToMaybe -#endif popInterruptTargetThread :: IO () popInterruptTargetThread = diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 2dcc73f..dfac0ae 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -129,10 +129,6 @@ import qualified Data.IntMap as IM import qualified Data.Set as Set import Data.Time -#if __GLASGOW_HASKELL__ < 705 -import Data.Time.Clock.POSIX -import System.Time -#endif infixr 9 `thenCmp` \end{code} @@ -954,13 +950,7 @@ doesDirNameExist fpath = case takeDirectory fpath of -- Backwards compatibility definition of getModificationTime getModificationUTCTime :: FilePath -> IO UTCTime -#if __GLASGOW_HASKELL__ < 705 -getModificationUTCTime f = do - TOD secs _ <- getModificationTime f - return $ posixSecondsToUTCTime (realToFrac secs) -#else getModificationUTCTime = getModificationTime -#endif -- -------------------------------------------------------------- -- check existence & modification time at the same time diff --git a/configure.ac b/configure.ac index 1c72cfa..9e31c52 100644 --- a/configure.ac +++ b/configure.ac @@ -136,8 +136,8 @@ if test "$WithGhc" = "" then AC_MSG_ERROR([GHC is required.]) fi -FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[7.4], - [AC_MSG_ERROR([GHC version 7.4 or later is required to compile GHC.])])dnl +FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[7.6], + [AC_MSG_ERROR([GHC version 7.6 or later is required to compile GHC.])]) if test `expr $GhcMinVersion % 2` = "1" then @@ -151,9 +151,7 @@ then fi fi -FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[7.5], - GHC_PACKAGE_DB_FLAG=package-conf, - GHC_PACKAGE_DB_FLAG=package-db) +GHC_PACKAGE_DB_FLAG=package-db AC_SUBST(GHC_PACKAGE_DB_FLAG) # GHC 7.7+ needs -fcmm-sink when compiling Parser.hs. See #8182 From git at git.haskell.org Tue Aug 19 11:47:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 11:47:27 +0000 (UTC) Subject: [commit: ghc] master: Add test case for #9046 (defc42e) Message-ID: <20140819114727.687C924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/defc42e7dfdcc0685077ef3dc8bea6b80e2a66dc/ghc >--------------------------------------------------------------- commit defc42e7dfdcc0685077ef3dc8bea6b80e2a66dc Author: Vitaly Bragilevsky Date: Tue Jul 8 21:05:05 2014 +0400 Add test case for #9046 Signed-off-by: Austin Seipp >--------------------------------------------------------------- defc42e7dfdcc0685077ef3dc8bea6b80e2a66dc testsuite/tests/ghci.debugger/scripts/all.T | 1 + testsuite/tests/ghci.debugger/scripts/print036.script | 2 ++ .../cholewo-eval.stdout => ghci.debugger/scripts/print036.stdout} | 3 ++- 3 files changed, 5 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T index 09fa391..f8a0541 100644 --- a/testsuite/tests/ghci.debugger/scripts/all.T +++ b/testsuite/tests/ghci.debugger/scripts/all.T @@ -38,6 +38,7 @@ test('print034', normal, ghci_script, ['print034.script']) test('print035', [extra_clean(['../Unboxed.hi', '../Unboxed.o'])], ghci_script, ['print035.script']) +test('print036', when(compiler_ge('ghc','7.8'), expect_broken(9046)), ghci_script, ['print036.script']) test('break001', normal, ghci_script, ['break001.script']) test('break002', normal, ghci_script, ['break002.script']) diff --git a/testsuite/tests/ghci.debugger/scripts/print036.script b/testsuite/tests/ghci.debugger/scripts/print036.script new file mode 100644 index 0000000..9c51a2b --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/print036.script @@ -0,0 +1,2 @@ +:print read +:t _t1 diff --git a/testsuite/tests/programs/cholewo-eval/cholewo-eval.stdout b/testsuite/tests/ghci.debugger/scripts/print036.stdout similarity index 55% copy from testsuite/tests/programs/cholewo-eval/cholewo-eval.stdout copy to testsuite/tests/ghci.debugger/scripts/print036.stdout index 3ea84b7..d932b46 100644 --- a/testsuite/tests/programs/cholewo-eval/cholewo-eval.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print036.stdout @@ -1 +1,2 @@ -(-0.5105811455265337,-0.7565080326002654) +read = (_t1::Read a => String -> a) +_t1 :: Read a => String -> a From git at git.haskell.org Tue Aug 19 12:03:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 12:03:31 +0000 (UTC) Subject: [commit: ghc] wip/travis: travis: Use hvr’s multi-ghc-PPA (5f24c29) Message-ID: <20140819120331.9360824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/5f24c293e8d8e4c91fce709486a62e0813d1db3f/ghc >--------------------------------------------------------------- commit 5f24c293e8d8e4c91fce709486a62e0813d1db3f Author: Joachim Breitner Date: Tue Aug 19 14:03:05 2014 +0200 travis: Use hvr?s multi-ghc-PPA >--------------------------------------------------------------- 5f24c293e8d8e4c91fce709486a62e0813d1db3f .travis.yml | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/.travis.yml b/.travis.yml index aaf7dd7..22addd2 100644 --- a/.travis.yml +++ b/.travis.yml @@ -11,6 +11,10 @@ env: - DEBUG_STAGE2=NO before_install: + - travis_retry sudo add-apt-repository -y ppa:hvr/ghc + - travis_retry sudo apt-get update + - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 + - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin/alex:/opt/happy/1.19.4/bin/happy:$PATH - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ - git config --global url."http://github.com/ghc/packages-".insteadOf http://github.com/ghc/packages/ - git config --global url."https://github.com/ghc/packages-".insteadOf https://github.com/ghc/packages/ @@ -18,10 +22,9 @@ before_install: - git config --global url."git at github.com:/ghc/packages-".insteadOf git at github.com:/ghc/packages/ - git submodule update --init --recursive install: - - sudo apt-get update - - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils - - cabal update - - cabal install happy alex +# - sudo apt-get update +# - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils +# - cabal update script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. # do not build docs @@ -33,4 +36,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - CPUS=2 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast + - CPUS=2 SKIP_PERF_TESTS=YES ./validate --fast From git at git.haskell.org Tue Aug 19 12:03:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 12:03:34 +0000 (UTC) Subject: [commit: ghc] wip/travis's head updated: travis: Use hvr’s multi-ghc-PPA (5f24c29) Message-ID: <20140819120334.2351924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/travis' now includes: b06e83d Make mod73 test insensitive to minor variations (#9325) a2439c7 Add .gitignore line for stage=1 testsuite generated file 1837b2f comment update da70f9e Allow multiple entry points when allocating recursive groups (#9303) ab8f254 Comments and white space 49333bf Comments and minor refactoring 6fa6caa Compiler perf has improved a bit a0ff1eb [backpack] Package selection 0be7c2c Comments and white space dc7d3c2 Test Trac #9380 7381cee Add a fast-path in TcInteract.kickOutRewritable fe2d807 Comments only bfaa179 Add comments about the {-# INCOHERENT #-} for Typeable (f a) 1ae5fa4 Complete work on new OVERLAPPABLE/OVERLAPPING pragmas (Trac #9242) c97f853 Typo in comment fd47e26 Fix up ghci044 bdf0ef0 Minor wordsmithing of comments 58ed1cc Small tweaks to comment 1c1ef82 Typo fixes 52188ad Unbreak build. 3b9fe0c refactor to fix 80column overflow 6483b8a panic message fix 9d9a554 interruptible() was not returning true for BlockedOnSTM (#9379) 028630a Fix reference to note aab5937 update comment 6c06db1 add a comment 2989ffd A panic in CmmBuildInfoTables.bundle shouldn't be a panic (#9329) d4d4bef Improve the desugaring of RULES, esp those from SPECIALISE pragmas 8df7fea Bump haddock.base max_bytes_used 3faff73 [backpack] More revisions to various pieces. 0336588 Two new executables to ignore. 02975c9 Fix-up to d4d4bef2 'Improve the desugaring of RULES' 578fbec Dont allow hand-written Generic instances in Safe Haskell. e69619e Allow warning if could have been infered safe instead of explicit Trustworthy label. 105602f Update Safe Haskell typeable test outputs. fbd0586 Infer safety of modules correctly with new overlapping pragmas. ab90bf2 Add in (disabled for now) test of a Safe Haskell bug. f293931 Add missing *.stderr files 44853a1 Terminate in forkProcess like in real_main df1e775 docs: fix typo: 'OVERLAPPINGP' -> 'OVERLAPPING' 637978f Use 'install' command for 'inplace/' install as we do in 'make install' 65e5dbc fix linker_unload test on Solaris/i386 platform f686682 ghc --make: add nicer names to RTS threads (threaded IO manager, make workers) 7328deb fix openFile003 test on Solaris/i386 (platform output is not needed anymore) 1f24a03 fix topHandler03 execution on Solaris where shell signals SIGTERM correctly edff1ef Disable package auto-hiding if -hide-all-packages is passed 66218d1 Package keys (for linking/type equality) separated from package IDs. 3663791 Disable ghc-pkg accepting multiple package IDs (differing package keys) for now. de3f064 Make PackageState an abstract type. 00b8f8c Refactor package state, also fixing a module reexport bug. 4accf60 Refactor PackageFlags so that ExposePackage is a single constructor. 2078752 Thinning and renaming modules from packages on the command line. 94b2b22 [no-ci] Minor bugfixes in Backpack docs. 7479df6 configure.ac: drop unused VOID_INT_SIGNALS 56ca32c Update Haddock submodule to know about profiling. d360d44 Filter out null bytes from trace, and warn accordingly, fixing #9395. c88559b Temporarily bump Haddock numbers; I'm going to fix it. 8e400d2 Revert "fix linker_unload test on Solaris/i386 platform" f4904fb Mark type-rep not as expect_broken when debugged f42fa9b fix linker_unload test _FILE_OFFSET_BITS redefined warning on Solaris/i386 2b3c621 fix linker_unload test for ghc configurations with --with-gmp-libraries 24a2e49 fix T658b/T5776 to use POSIX grep -c instead of GNU's --count 61baf71 Comments and white space 31399be Move Outputable instance for FloatBind to the data type definition d3fafbb Tiny refactoring, plus comments; no change in behaviour 93b1a43 Add Output instance for OrdList 6b96557 Make Core Lint check the let/app invariant 1736082 Don't float into unlifted function arguments 1fc60ea When desugaring Use the smart mkCoreConApps and friends d174f49 Make buildToArrPReprs obey the let/app invariant db17d58 Document the maintenance of the let/app invariant in the simplifier ab6480b Extensive Notes on can_fail and has_side_effects 8367f06 Refactor the handling of case-elimination 0957a9b Add has_side_effets to the raise# primop 2990e97 Test Trac #9390 18ac546 Fix some typos in recent comments/notes 4855be0 Give the Unique generated by strings a tag '$', fixes #9413. d026e9e Permanently accept the Haddock performance number bump, and add some TODOs c51498b [no-ci] Track Haddock submodule change: ignore TAGS. af1fc53 ghci: tweak option list indentation in ':show packages' 2cca0c0 testsuite: add signal_exit_code function to the driver d0ee4eb Update perf number for T5642 7d52e62 Update Haddock to attoparsec-0.12.1. Adjust perf. dff0623 Implement the final change to INCOHERENT from Trac #9242 ca3fc66 Fix path in cabal file 16776e9 configure.ac: drop unused HAVE_BIN_SH a2ac57b Tweak Haddock markup in GHC.Magic 4e020b3 Tweak Haddock in GHC.Types 44c1e3f testsuite: add list of llvm_ways caa9c8aa Add test case for #9013 8e01ca6 Remove obsolete "-- #hide" Haddock pragmas b7b7633 Add a test for plusWord2#, addIntC#, subIntC# e83e873 Clarify documentation of addIntC#, subIntC# 3260467 systools info: fix warning about C compiler (message said about linker) ba9277c Tweak linting rules. 02be4ff fix T4201 to avoid GNU grep specific -B option by usage of pure POSIX tools 2396940 fix T4981-V3 and T9208 tests for no newline at end of file warning ba3650c fix T4981-V3 to avoid DOS line endings bb00308 Don't build or test dph by default 238fd05 change topHandler02/topHandler03 tests to use signal_exit_code function 7a754a9 rts/Printer.c: drop zcode mangling/demangling support in C code b02fa3b rts: Remove trailing whitespace and tabs from Printer.c 8d90ffa fix darwin threaded static linking by removing -lpthread option #9189 cbfa107 Improve seq documentation; part of trac issue #9390 c80d238 Eliminate some code duplication in x86 backend (genCCall32/64) 5f5d662 Make IntAddCOp, IntSubCOp into GenericOps 71bd4e3 x86: Always generate add instruction in MO_Add2 (#9013) 8e64151 stg/Prim.h: drop redundant #ifdef 6e3c44e Unbreak travis by not passing --no-dph 0a3944c testsuite/base: update .gitignore 3694d87 Re-add `--no-dph` option to ./validate 3669b60 Add bit scan {forward,reverse} insns to x86 NCG 9f285fa Add CMOVcc insns to x86 NCG 6415191 x86: zero extend the result of 16-bit popcnt instructions (#9435) a09508b Test #9371 (indexed-types/should_fail/T9371) f29bdfb Fix Trac #9371. 1b13886 Fix #9415. 1a3e19d Test #9415 (typecheck/should_fail/T9415) 8d27c76 Test #9200. (polykinds/T9200) 6485930 Change definition of CUSK for data and class definitions (#9200). 3dfd3c3 Added more testing for #9200. (polykinds/T9200b) b2c6167 Change treatment of CUSKs for synonyms and families (#9200). 578377c Remove NonParametricKinds (#9200) 1c66b3d Update manual (#9200). 91a48c5 Testsuite wibbles around #9200 6f862df shouldInlinePrimOp: Fix Int overflow a6fd7b5 Add some Haddocks to SMRep 4342049 StgCmmPrim: add note to stop using fixed size signed types for sizes 5e46e1f Have ghc-pkg use an old-style package key when it's not provided. 2272c50 Explicitly version test for package key support. 6b5ea61 Remove out of date TODO e0c1767 Implement new CLZ and CTZ primops (re #9340) 03a8003 Declare `ghc-head` to be haddock's upstream branch 5895f2b LlvmMangler: Be more selective when mangling object types d39c434 Make configure's sed(1) expression for GHC_LDFLAGS more BSD-friendly. 246436f Implement {resize,shrink}MutableByteArray# primops 425d517 Fix typos 'resizze' 53cc943 Revert "Fix typos 'resizze'" this is z-encoding (as hvr tells me) 6375934 Workaround GCC `__ctzdi2` intrinsic linker errors 96d0418 Remove obsolete `digitsTyConKey :: Unique` 2d42564 workaround Solaris 11 GNU C CPP issue by using GNU C 3.4 as CPP 2aabda1 Fix quasi-quoter documentation (#9448) daef885 Fix broken link in Data.Data to SYB home page (Trac #9455) b287bc9 Update list of flags implied by -XGADTs in User's Guide section on GADTs a72614c Make T8832 operative on 32-bit systems (#8832) 3a67aba ghci/scripts/ghci016: Add implementation for negate 5b11b04 concurrent/should_run/throwto002: DoRec -> RecursiveDo 5d5655e Fix three problems with occurrence analysis on case alternatives. 88b1f99 testsuite/T9379: Use GHC.Conc instead of Control.Concurrent.STM 6f6ee6e Make Prelude.abs handle -0.0 correctly (#7858) d9a2057 Make Prelude.signum handle -0.0 correctly (#7858) bbd0311 Bug #9439: Ensure that stage 0 compiler isn't affected 9a708d3 UNREG: fix PackageKey emission into .hc files 0138110 Implement -rdynamic in Linux and Windows/MinGW32. d2f0100 Have the RTS linker search symbols in the originating windows binary. 955dfcb This note's name has been fixed 4333a91 includes/stg/Prim.h: add matching 'hs_atomic_*' prototypes e3c3586 Use absolute links to Cabal docs from the GHC users guide (#9154) 89f5f31 Explain how to clone GitHub forks. Ticket #8379. 2fc2294 Mention that `Data.Ix` uses row-major indexing 527bcc4 build: require GHC 7.6 for bootstrapping defc42e Add test case for #9046 5f24c29 travis: Use hvr?s multi-ghc-PPA From git at git.haskell.org Tue Aug 19 12:09:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 12:09:39 +0000 (UTC) Subject: [commit: ghc] master: Correct checkStrictBinds for generalised type (806d823) Message-ID: <20140819120939.9BE7724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/806d823e757c73f77f03fdf2d1eba6a83b1e32e6/ghc >--------------------------------------------------------------- commit 806d823e757c73f77f03fdf2d1eba6a83b1e32e6 Author: archblob Date: Tue Aug 19 06:51:38 2014 -0500 Correct checkStrictBinds for generalised type See Trac #9140. Auditors: simonpj Signed-off-by: Austin Seipp >--------------------------------------------------------------- 806d823e757c73f77f03fdf2d1eba6a83b1e32e6 compiler/typecheck/TcBinds.lhs | 4 ++-- testsuite/tests/ghci/scripts/T9140.script | 5 +++++ testsuite/tests/ghci/scripts/T9140.stdout | 14 ++++++++++++++ testsuite/tests/ghci/scripts/all.T | 1 + 4 files changed, 22 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 34db200..14a5704 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -1454,8 +1454,8 @@ checkStrictBinds top_lvl rec_group orig_binds tc_binds poly_ids any_strict_pat = any (isStrictHsBind . unLoc) orig_binds any_pat_looks_lazy = any (looksLazyPatBind . unLoc) orig_binds - is_unlifted id = case tcSplitForAllTys (idType id) of - (_, rho) -> isUnLiftedType rho + is_unlifted id = case tcSplitSigmaTy (idType id) of + (_, _, rho) -> isUnLiftedType rho is_monomorphic (L _ (AbsBinds { abs_tvs = tvs, abs_ev_vars = evs })) = null tvs && null evs diff --git a/testsuite/tests/ghci/scripts/T9140.script b/testsuite/tests/ghci/scripts/T9140.script new file mode 100644 index 0000000..833ea87 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T9140.script @@ -0,0 +1,5 @@ +:set -XUnboxedTuples -XBangPatterns +let a = (# 1 #) +let a = (# 1, 3 #) +:set -XBangPatterns +let !a = (# 1, 3 #) diff --git a/testsuite/tests/ghci/scripts/T9140.stdout b/testsuite/tests/ghci/scripts/T9140.stdout new file mode 100644 index 0000000..a5cb42f --- /dev/null +++ b/testsuite/tests/ghci/scripts/T9140.stdout @@ -0,0 +1,14 @@ + +:3:5: + You can't mix polymorphic and unlifted bindings + a = (# 1 #) + Probable fix: use a bang pattern + +:4:5: + You can't mix polymorphic and unlifted bindings + a = (# 1, 3 #) + Probable fix: use a bang pattern + +Top level: + GHCi can't bind a variable of unlifted type: + a :: (# Integer, Integer #) diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index d5a313a..f02a3c0 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -177,3 +177,4 @@ test('T8959', normal, ghci_script, ['T8959.script']) test('T8959b', expect_broken(8959), ghci_script, ['T8959b.script']) test('T9181', normal, ghci_script, ['T9181.script']) test('T9086b', normal, ghci_script, ['T9086b.script']) +test('T9140', combined_output, ghci_script, ['T9140.script']) From git at git.haskell.org Tue Aug 19 12:09:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 12:09:42 +0000 (UTC) Subject: [commit: ghc] wip/travis: travis: Use hvr’s multi-ghc-PPA (0ab2f75) Message-ID: <20140819120944.60D3524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis Link : http://ghc.haskell.org/trac/ghc/changeset/0ab2f75cf4d1e432c13dd01a1a53a6370591dce4/ghc >--------------------------------------------------------------- commit 0ab2f75cf4d1e432c13dd01a1a53a6370591dce4 Author: Joachim Breitner Date: Tue Aug 19 14:03:05 2014 +0200 travis: Use hvr?s multi-ghc-PPA >--------------------------------------------------------------- 0ab2f75cf4d1e432c13dd01a1a53a6370591dce4 .travis.yml | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/.travis.yml b/.travis.yml index aaf7dd7..cc9ac3f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -11,6 +11,10 @@ env: - DEBUG_STAGE2=NO before_install: + - travis_retry sudo add-apt-repository -y ppa:hvr/ghc + - travis_retry sudo apt-get update + - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 + - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:$PATH - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ - git config --global url."http://github.com/ghc/packages-".insteadOf http://github.com/ghc/packages/ - git config --global url."https://github.com/ghc/packages-".insteadOf https://github.com/ghc/packages/ @@ -18,10 +22,9 @@ before_install: - git config --global url."git at github.com:/ghc/packages-".insteadOf git at github.com:/ghc/packages/ - git submodule update --init --recursive install: - - sudo apt-get update - - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils - - cabal update - - cabal install happy alex +# - sudo apt-get update +# - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils +# - cabal update script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. # do not build docs @@ -33,4 +36,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - CPUS=2 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast + - CPUS=2 SKIP_PERF_TESTS=YES ./validate --fast From git at git.haskell.org Tue Aug 19 12:10:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 12:10:05 +0000 (UTC) Subject: [commit: ghc] master: Check if file is present instead of directory (7012ed8) Message-ID: <20140819121005.A7B2D24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7012ed8515100b4947383e93b82dbff7a0aa835c/ghc >--------------------------------------------------------------- commit 7012ed8515100b4947383e93b82dbff7a0aa835c Author: Thomas Miedema Date: Sat Jun 21 01:57:53 2014 +0200 Check if file is present instead of directory Fixes #8886. Problem: any `sync-all` command that is run before the first succesfull `sync-all get` would trigger a false warning about an old `time` package being present. Cause: after cloning the ghc repository, the (empty) `libraries/time` directory is already present. Solution: check if the directory actually contains any of the `time` files. I picked the `LICENSE` file, since `boot` does so as well. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 7012ed8515100b4947383e93b82dbff7a0aa835c sync-all | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sync-all b/sync-all index 355e16a..651a4f0 100755 --- a/sync-all +++ b/sync-all @@ -964,7 +964,7 @@ EOF } } message "== Checking for old time from tarball"; - if (-d "libraries/time" and ! -e "libraries/time/.git") { + if (-f "libraries/time/LICENSE" and ! -e "libraries/time/.git") { print < Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/51a0b60038fb1dddbb9793c0c069de6125f84bf1/ghc >--------------------------------------------------------------- commit 51a0b60038fb1dddbb9793c0c069de6125f84bf1 Author: Joachim Breitner Date: Tue Aug 19 14:03:05 2014 +0200 travis: Use hvr?s multi-ghc-PPA >--------------------------------------------------------------- 51a0b60038fb1dddbb9793c0c069de6125f84bf1 .travis.yml | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/.travis.yml b/.travis.yml index aaf7dd7..cc9ac3f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -11,6 +11,10 @@ env: - DEBUG_STAGE2=NO before_install: + - travis_retry sudo add-apt-repository -y ppa:hvr/ghc + - travis_retry sudo apt-get update + - travis_retry sudo apt-get install cabal-install-1.18 ghc-7.6.3 alex-3.1.3 happy-1.19.4 + - export PATH=/opt/ghc/7.6.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:$PATH - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ - git config --global url."http://github.com/ghc/packages-".insteadOf http://github.com/ghc/packages/ - git config --global url."https://github.com/ghc/packages-".insteadOf https://github.com/ghc/packages/ @@ -18,10 +22,9 @@ before_install: - git config --global url."git at github.com:/ghc/packages-".insteadOf git at github.com:/ghc/packages/ - git submodule update --init --recursive install: - - sudo apt-get update - - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils - - cabal update - - cabal install happy alex +# - sudo apt-get update +# - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils +# - cabal update script: - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis. # do not build docs @@ -33,4 +36,4 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - CPUS=2 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast + - CPUS=2 SKIP_PERF_TESTS=YES ./validate --fast From git at git.haskell.org Tue Aug 19 12:13:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 12:13:56 +0000 (UTC) Subject: [commit: ghc] branch 'wip/travis' deleted Message-ID: <20140819121356.8996124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/travis From git at git.haskell.org Tue Aug 19 13:03:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 13:03:57 +0000 (UTC) Subject: [commit: ghc] master: rts/base: Fix #9423 (f9f89b7) Message-ID: <20140819130357.5BE3524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f9f89b7884ccc8ee5047cf4fffdf2b36df6832df/ghc >--------------------------------------------------------------- commit f9f89b7884ccc8ee5047cf4fffdf2b36df6832df Author: Andreas Voellmy Date: Tue Aug 19 08:02:18 2014 -0500 rts/base: Fix #9423 Summary: Fix #9423. The problem in #9423 is caused when code invoked by `hs_exit()` waits on all foreign calls to return, but some IO managers are in `safe` foreign calls and do not return. The previous design signaled to the timer manager (via its control pipe) that it should "die" and when the timer manager returned to Haskell-land, the Haskell code in timer manager then signalled to the IO manager threads that they should return from foreign calls and `die`. Unfortunately, in the shutdown sequence the timer manager is unable to return to Haskell-land fast enough and so the code that signals to the IO manager threads (via their control pipes) is never executed and the IO manager threads remain out in the foreign calls. This patch solves this problem by having the RTS signal to all the IO manager threads (via their control pipes; and in addition to signalling to the timer manager thread) that they should shutdown (in `ioManagerDie()` in `rts/Signals.c`. To do this, we arrange for each IO manager thread to register its control pipe with the RTS (in `GHC.Thread.startIOManagerThread`). In addition, `GHC.Thread.startTimerManagerThread` registers its control pipe. These are registered via C functions `setTimerManagerControlFd` (in `rts/Signals.c`) and `setIOManagerControlFd` (in `rts/Capability.c`). The IO manager control pipe file descriptors are stored in a new field of the `Capability_ struct`. Test Plan: See the notes on #9423 to recreate the problem and to verify that it no longer occurs with the fix. Auditors: simonmar Reviewers: simonmar, edsko, ezyang, austin Reviewed By: austin Subscribers: phaskell, simonmar, ezyang, carter, relrod Differential Revision: https://phabricator.haskell.org/D129 GHC Trac Issues: #9423, #9284 >--------------------------------------------------------------- f9f89b7884ccc8ee5047cf4fffdf2b36df6832df includes/rts/IOManager.h | 3 +- libraries/base/GHC/Event/Control.hs | 8 +--- libraries/base/GHC/Event/Manager.hs | 1 + libraries/base/GHC/Event/Thread.hs | 35 ++++++++------ libraries/base/GHC/Event/TimerManager.hs | 1 + rts/Capability.c | 11 +++++ rts/Capability.h | 3 ++ rts/Linker.c | 1 + rts/posix/Signals.c | 80 ++++++++++++++++++++------------ 9 files changed, 92 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 f9f89b7884ccc8ee5047cf4fffdf2b36df6832df From git at git.haskell.org Tue Aug 19 13:55:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 13:55:46 +0000 (UTC) Subject: [commit: ghc] master: validate: add simple CPU count autodetection (f328890) Message-ID: <20140819135546.78F8024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f328890021253c426b7450b6c5a1061d25f6219b/ghc >--------------------------------------------------------------- commit f328890021253c426b7450b6c5a1061d25f6219b Author: Sergei Trofimovich Date: Tue Aug 19 16:54:13 2014 +0300 validate: add simple CPU count autodetection Summary: Signed-off-by: Sergei Trofimovich Test Plan: ran ./validate on linux Reviewers: austin Reviewed By: austin Subscribers: phaskell, simonmar, relrod, ezyang, carter Differential Revision: https://phabricator.haskell.org/D146 >--------------------------------------------------------------- f328890021253c426b7450b6c5a1061d25f6219b validate | 32 +++++++++++++++++++++++++++----- 1 file changed, 27 insertions(+), 5 deletions(-) diff --git a/validate b/validate index 7a7b125..8ea9eac 100755 --- a/validate +++ b/validate @@ -88,6 +88,32 @@ check_packages () { echo "== End $1 package check" } +detect_cpu_count () { + if [ "$CPUS" = "" ]; then + # Windows standard environment variable + CPUS="$NUMBER_OF_PROCESSORS" + fi + + if [ "$CPUS" = "" ]; then + # Linux + CPUS=`getconf _NPROCESSORS_ONLN 2>/dev/null` + fi + + if [ "$CPUS" = "" ]; then + # FreeBSD + CPUS=`getconf NPROCESSORS_ONLN 2>/dev/null` + fi + + if [ "$CPUS" = "" ]; then + # nothing helped + CPUS="1" + fi + + echo "using ${CPUS} CPUs" >&2 +} + +detect_cpu_count + if ! [ -d testsuite ] then echo 'Could not find the testsuite for validation' >&2 @@ -95,11 +121,7 @@ then fi if [ "$THREADS" = "" ]; then - if [ "$CPUS" = "" ]; then - threads=2 - else - threads=$(($CPUS + 1)) # `expr $CPUS + 1` - fi + threads=$(($CPUS + 1)) # `expr $CPUS + 1` else threads="$THREADS" fi From git at git.haskell.org Tue Aug 19 22:17:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Aug 2014 22:17:44 +0000 (UTC) Subject: [commit: ghc] master: Fix prepositions in the documentation of -rdynamic. (15faa0e) Message-ID: <20140819221744.EFA1624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/15faa0ec3a5a783f3949dcff6adf412d5f21bdf8/ghc >--------------------------------------------------------------- commit 15faa0ec3a5a783f3949dcff6adf412d5f21bdf8 Author: Facundo Dom?nguez Date: Tue Aug 19 16:10:32 2014 -0300 Fix prepositions in the documentation of -rdynamic. >--------------------------------------------------------------- 15faa0ec3a5a783f3949dcff6adf412d5f21bdf8 docs/users_guide/flags.xml | 4 ++-- docs/users_guide/phases.xml | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index dbad118..f138c18 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -2433,8 +2433,8 @@ This instructs the linker to add all symbols, not only used ones, to the dynamic symbol table. Currently Linux and Windows/MinGW32 only. - This is equivalent to using -optl -rdynamic in linux, - and -optl -export-all-symbols in Windows. + This is equivalent to using -optl -rdynamic on Linux, + and -optl -export-all-symbols on Windows. dynamic - diff --git a/docs/users_guide/phases.xml b/docs/users_guide/phases.xml index fb92fd3..095de32 100644 --- a/docs/users_guide/phases.xml +++ b/docs/users_guide/phases.xml @@ -1241,8 +1241,8 @@ $ cat foo.hspp This instructs the linker to add all symbols, not only used ones, to the dynamic symbol table. Currently Linux and Windows/MinGW32 only. - This is equivalent to using -optl -rdynamic in linux, - and -optl -export-all-symbols in Windows. + This is equivalent to using -optl -rdynamic on Linux, + and -optl -export-all-symbols on Windows. From git at git.haskell.org Wed Aug 20 01:04:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 01:04:59 +0000 (UTC) Subject: [commit: ghc] branch 'wip/llf' created Message-ID: <20140820010459.63C9424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/llf Referencing: f17ceee98221de21f896ac412b7a7ddcfc35a0c6 From git at git.haskell.org Wed Aug 20 01:05:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 01:05:02 +0000 (UTC) Subject: [commit: ghc] wip/llf: Merge branch 'master' into late-lam-lift (b1c7047) Message-ID: <20140820010502.412E424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/llf Link : http://ghc.haskell.org/trac/ghc/changeset/b1c704728cafd2609c4e799240cfd069e0d306bb/ghc >--------------------------------------------------------------- commit b1c704728cafd2609c4e799240cfd069e0d306bb Merge: 8d979a1 1a11e9b Author: Nicolas Frisby Date: Sun Jun 15 20:16:23 2014 -0500 Merge branch 'master' into late-lam-lift It seems to be building, but I haven't tested it yet -- just now commiting before I run validate.sh Conflicts: compiler/basicTypes/VarEnv.lhs compiler/codeGen/StgCmmArgRep.hs compiler/codeGen/StgCmmHeap.hs compiler/coreSyn/CorePrep.lhs compiler/coreSyn/CoreUnfold.lhs compiler/main/DynFlags.hs compiler/main/StaticFlags.hs compiler/simplCore/SetLevels.lhs compiler/simplCore/SimplCore.lhs compiler/specialise/SpecConstr.lhs compiler/stgSyn/CoreToStg.lhs compiler/stranal/WwLib.lhs includes/Cmm.h rts/Linker.c >--------------------------------------------------------------- Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b1c704728cafd2609c4e799240cfd069e0d306bb From git at git.haskell.org Wed Aug 20 01:05:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 01:05:05 +0000 (UTC) Subject: [commit: ghc] wip/llf: fixed merge bug in expandFloatedIds; removed the unused 'pinnee' code; udpated some comments; increased dump-late-float ppr-debug info; slight simplification (6a81cf9) Message-ID: <20140820010505.434EA24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/llf Link : http://ghc.haskell.org/trac/ghc/changeset/6a81cf9a6cb2114c72c9a5b29be99a31a23764f0/ghc >--------------------------------------------------------------- commit 6a81cf9a6cb2114c72c9a5b29be99a31a23764f0 Author: Nicolas Frisby Date: Sun Jul 27 19:36:25 2014 -0500 fixed merge bug in expandFloatedIds; removed the unused 'pinnee' code; udpated some comments; increased dump-late-float ppr-debug info; slight simplification >--------------------------------------------------------------- 6a81cf9a6cb2114c72c9a5b29be99a31a23764f0 compiler/simplCore/SetLevels.lhs | 55 +++++++++++++++------------------------- 1 file changed, 20 insertions(+), 35 deletions(-) diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs index e8d98c7..09d69e4 100644 --- a/compiler/simplCore/SetLevels.lhs +++ b/compiler/simplCore/SetLevels.lhs @@ -833,7 +833,7 @@ decideBindFloat init_env is_bot binding = | all_funs || (fps_floatLNE0 fps && isLNE) -- only lift functions or zero-arity LNEs , not (fps_leaveLNE fps && isLNE) -- see Note [Lifting LNEs] - , Nothing <- decider emptyVarEnv = Just (tOP_LEVEL, abs_vars) + , Nothing <- decider = Just (tOP_LEVEL, abs_vars) | otherwise = Nothing -- do not lift where abs_vars = abstractVars tOP_LEVEL env bindings_fvs @@ -847,6 +847,8 @@ decideBindFloat init_env is_bot binding = -- for -ddump-late-float with -dppr-debug extra_sdoc = text "scope_silt:" <+> ppr scope_silt + $$ text "le_env env:" <+> ppr (le_env env) + $$ text "abs_vars:" <+> ppr abs_vars rhs_silt_s :: [(CoreBndr, FISilt)] ( isRec , ids @@ -898,16 +900,15 @@ decideLateLambdaFloat :: Bool -> Bool -> IdSet -> - IdSet -> (IdSet -> [(Bool, WordOff, WordOff, WordOff)]) -> + IdSet -> [(Bool, WordOff, WordOff, WordOff)] -> [Id] -> SDoc -> FinalPassSwitches -> - VarSet -> -- pinnees to ignore Maybe VarSet -- Nothing <=> float to tOP_LEVEL -- -- Just x <=> do not float, not (null x) <=> forgetting -- fast calls to the ids in x are the only thing -- pinning this binding -decideLateLambdaFloat env isRec isLNE all_one_shot abs_ids_set badTime spaceInfo' ids extra_sdoc fps pinnees +decideLateLambdaFloat env isRec isLNE all_one_shot abs_ids_set badTime spaceInfo ids extra_sdoc fps = (if fps_trace fps then pprTrace ('\n' : msg) msg_sdoc else (\x -> x)) $ if floating then Nothing else Just $ if isBadSpace @@ -923,8 +924,6 @@ decideLateLambdaFloat env isRec isLNE all_one_shot abs_ids_set badTime spaceInfo isBadTime = not (isEmptyVarSet badTime) - spaceInfo = spaceInfo' pinnees - -- this should always be empty, by definition of LNE spoiledLNEs = le_LNEs env `intersectVarSet` abs_ids_set @@ -944,8 +943,6 @@ decideLateLambdaFloat env isRec isLNE all_one_shot abs_ids_set badTime spaceInfo -- these bindings would be allocated at least as many times as -- the closure. - -- TODO | Just limit <- fps_ifInClo fps = - cgilViolation = case fps_cloGrowthInLam fps of Nothing -> const False Just limit -> (> limit * wORDS_PTR) @@ -960,7 +957,6 @@ decideLateLambdaFloat env isRec isLNE all_one_shot abs_ids_set badTime spaceInfo [ ppr v <+> if isLNE then parens (text "LNE") else empty , text "size:" <+> ppr closureSize , text "abs_ids:" <+> ppr (length abs_ids) <+> ppr abs_ids - , text "pinnees:" <+> ppr (varSetElems pinnees) , text "createsPAPs:" <+> ppr badPAP , text "closureGrowth:" <+> ppr cg , text "CG in lam:" <+> ppr cgil @@ -996,16 +992,15 @@ wouldIncreaseRuntime env abs_ids binding_group_fiis = case prjFlags `fmap` final , not (fps_absOversatVar fps) -- -fno-late-abstract-oversat-var ) --- if a free id was floated, then its abs_ids are now free ids (and so --- on) -expandFloatedIds :: LevelEnv -> IdSet -> IdSet -expandFloatedIds env = w . varSetElems where - w = foldl snoc emptyVarSet - - snoc acc id = case lookupVarEnv (le_env env) id of - Nothing -> extendVarSet acc id - Just (_,abs_vars) -> extendVarSetList acc $ filter isId abs_vars - -- TODO unionVarSet acc $ w $ filter isId abs_vars +-- if a free id was floated, then its abs_ids are now free ids +expandFloatedIds :: LevelEnv -> {- In -} IdSet -> {- Out -} IdSet +expandFloatedIds env = foldl snoc emptyVarSet . varSetElems where + snoc acc id = case lookupVarEnv (le_env env) id of + Nothing -> extendVarSet acc id -- TODO is this case possible? + Just (new_id,filter isId -> abs_ids) + | not (null abs_ids) -> -- it's a lambda-lifted function + extendVarSetList acc abs_ids + | otherwise -> extendVarSet acc new_id wouldIncreaseAllocation :: LevelEnv -> @@ -1014,7 +1009,6 @@ wouldIncreaseAllocation :: [(Id, FISilt)] -> -- the bindings in the binding group with each's -- silt FISilt -> -- the entire scope of the binding group - VarSet -> -- pinnees: ignore these as captors [] -- for each binder: ( Bool -- would create PAPs , WordOff -- size of this closure group @@ -1023,24 +1017,13 @@ wouldIncreaseAllocation :: , WordOff -- estimated increase for closures that ARE allocated -- under a lambda ) -wouldIncreaseAllocation env isLNE abs_ids_set pairs (FISilt _ scope_fiis scope_sk) _pinnees +wouldIncreaseAllocation env isLNE abs_ids_set pairs (FISilt _ scope_fiis scope_sk) | isLNE = map (const (False,0,0,0)) pairs - | otherwise = case finalPass env of - Nothing -> [] - Just _fps -> flip map bndrs $ \bndr -> case lookupVarEnv scope_fiis bndr of + | otherwise = flip map bndrs $ \bndr -> case lookupVarEnv scope_fiis bndr of Nothing -> (False, closuresSize, 0, 0) -- it's a dead variable. Huh. Just fii -> (violatesPAPs, closuresSize, closureGrowth, closureGrowthInLambda) where violatesPAPs = let (unapplied,_,_,_) = fii_useInfo fii in unapplied - -- TODO consider incorporating PAP creation into the closure - -- growth calculation (ie identifying each PAP, whether its - -- in a lambda, etc), instead of having it as a separate all - -- or nothing thing. (Maybe just add a "PAP Id" constructor - -- to Skeleton?) - -- - -- TODO also, if we specialized on partial applications (eg - -- "map (f a) xs" becomes "$smap f a xs"), then maybe we - -- could relax this (closureGrowth, closureGrowthInLambda) = costToLift (expandFloatedIds env) sizer bndr abs_ids_set scope_sk @@ -1055,7 +1038,8 @@ wouldIncreaseAllocation env isLNE abs_ids_set pairs (FISilt _ scope_fiis scope_s -- -- So we instead calculate and then add up the size of each -- binding's closure. GHC does not currently share closure - -- environments. + -- environments, and we either lift the entire recursive binding + -- group or none of it. closuresSize = sum $ flip map pairs $ \(_,FISilt _ fiis _) -> let (words, _, _) = StgCmmLayout.mkVirtHeapOffsets dflags isUpdateable $ @@ -1194,7 +1178,8 @@ data LevelEnv -- (since we want to substitute in LevelledExpr -- instead) but we do use the Co/TyVar substs , le_env :: IdEnv (OutVar,[OutVar]) -- Domain is pre-cloned Ids - -- (v,vs) represents the type application "v [vs0] [vs1] [vs2]" ... + -- (v,vs) represents the application "v vs0 vs1 vs2" ... + -- Except in the late float, the vs are all types. -- see Note [The Reason SetLevels Does Substitution] From git at git.haskell.org Wed Aug 20 01:05:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 01:05:07 +0000 (UTC) Subject: [commit: ghc] wip/llf: adopting llf in favor of late-float throughout (d76d6dd) Message-ID: <20140820010507.D2DE924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/llf Link : http://ghc.haskell.org/trac/ghc/changeset/d76d6dde4e59303cd28085c252b4117f7143ef8b/ghc >--------------------------------------------------------------- commit d76d6dde4e59303cd28085c252b4117f7143ef8b Author: Nicolas Frisby Date: Sat Aug 16 18:51:47 2014 -0500 adopting llf in favor of late-float throughout >--------------------------------------------------------------- d76d6dde4e59303cd28085c252b4117f7143ef8b compiler/main/DynFlags.hs | 60 +++++++++++++++++++++++------------------------ 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 8872d28..78fc3ec 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -333,8 +333,8 @@ data GeneralFlag | Opt_LLF_CreatePAPs -- ^ allowed to float function bindings that occur unapplied | Opt_LLF_Simpl -- ^ follow the late lambda lift with a simplification pass? | Opt_LLF_Stabilize - | Opt_LLF_UseStr -- ^ use strictness in the late-float - | Opt_LLF_IgnoreLNEClo -- ^ predict LNEs in the late-float + | Opt_LLF_UseStr -- ^ use strictness in the late lambda float + | Opt_LLF_IgnoreLNEClo -- ^ predict LNEs in the late lambda float | Opt_LLF_FloatLNE0 -- ^ float zero-arity LNEs | Opt_LLF_OneShot | Opt_LLF_LeaveLNE @@ -2397,7 +2397,7 @@ dynamic_flags = [ , Flag "ddump-hpc" (setDumpFlag Opt_D_dump_ticked) -- back compat , Flag "ddump-ticked" (setDumpFlag Opt_D_dump_ticked) , Flag "ddump-mod-cycles" (setDumpFlag Opt_D_dump_mod_cycles) - , Flag "ddump-late-float" (setDumpFlag Opt_D_dump_late_float) + , Flag "ddump-llf" (setDumpFlag Opt_D_dump_late_float) , Flag "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning) , Flag "ddump-to-file" (NoArg (setGeneralFlag Opt_DumpToFile)) , Flag "ddump-hi-diffs" (setDumpFlag Opt_D_dump_hi_diffs) @@ -2465,21 +2465,21 @@ dynamic_flags = [ , Flag "ffloat-lam-args" (intSuffix (\n d -> d{ floatLamArgs = Just n })) , Flag "ffloat-all-lams" (noArg (\d -> d{ floatLamArgs = Nothing })) - , Flag "flate-float-nonrec-lam-limit" (intSuffix (\n d -> d{ lateFloatNonRecLam = Just n })) - , Flag "flate-float-nonrec-lam-any" (noArg (\d -> d{ lateFloatNonRecLam = Nothing })) - , Flag "fno-late-float-nonrec-lam" (noArg (\d -> d{ lateFloatNonRecLam = Just 0 })) - , Flag "flate-float-rec-lam-limit" (intSuffix (\n d -> d{ lateFloatRecLam = Just n })) - , Flag "flate-float-rec-lam-any" (noArg (\d -> d{ lateFloatRecLam = Nothing })) - , Flag "fno-late-float-rec-lam" (noArg (\d -> d{ lateFloatRecLam = Just 0 })) - , Flag "flate-float-clo-growth-limit" (intSuffix (\n d -> d{ lateFloatCloGrowth = Just n })) - , Flag "flate-float-clo-growth-any" (noArg (\d -> d{ lateFloatCloGrowth = Nothing })) - , Flag "fno-late-float-clo-growth" (noArg (\d -> d{ lateFloatCloGrowth = Just 0 })) - , Flag "flate-float-in-clo-limit" (intSuffix (\n d -> d{ lateFloatIfInClo = Just n })) - , Flag "flate-float-in-clo-any" (noArg (\d -> d{ lateFloatIfInClo = Nothing })) - , Flag "fno-late-float-in-clo" (noArg (\d -> d{ lateFloatIfInClo = Just 0 })) - , Flag "flate-float-clo-growth-in-lam-limit" (intSuffix (\n d -> d{ lateFloatCloGrowthInLam = Just n })) - , Flag "flate-float-clo-growth-in-lam-any" (noArg (\d -> d{ lateFloatCloGrowthInLam = Nothing })) - , Flag "fno-late-float-clo-growth-in-lam" (noArg (\d -> d{ lateFloatCloGrowthInLam = Just 0 })) + , Flag "fllf-nonrec-lam-limit" (intSuffix (\n d -> d{ lateFloatNonRecLam = Just n })) + , Flag "fllf-nonrec-lam-any" (noArg (\d -> d{ lateFloatNonRecLam = Nothing })) + , Flag "fno-llf-nonrec-lam" (noArg (\d -> d{ lateFloatNonRecLam = Just 0 })) + , Flag "fllf-rec-lam-limit" (intSuffix (\n d -> d{ lateFloatRecLam = Just n })) + , Flag "fllf-rec-lam-any" (noArg (\d -> d{ lateFloatRecLam = Nothing })) + , Flag "fno-llf-rec-lam" (noArg (\d -> d{ lateFloatRecLam = Just 0 })) + , Flag "fllf-clo-growth-limit" (intSuffix (\n d -> d{ lateFloatCloGrowth = Just n })) + , Flag "fllf-clo-growth-any" (noArg (\d -> d{ lateFloatCloGrowth = Nothing })) + , Flag "fno-llf-clo-growth" (noArg (\d -> d{ lateFloatCloGrowth = Just 0 })) + , Flag "fllf-in-clo-limit" (intSuffix (\n d -> d{ lateFloatIfInClo = Just n })) + , Flag "fllf-in-clo-any" (noArg (\d -> d{ lateFloatIfInClo = Nothing })) + , Flag "fno-llf-in-clo" (noArg (\d -> d{ lateFloatIfInClo = Just 0 })) + , Flag "fllf-clo-growth-in-lam-limit" (intSuffix (\n d -> d{ lateFloatCloGrowthInLam = Just n })) + , Flag "fllf-clo-growth-in-lam-any" (noArg (\d -> d{ lateFloatCloGrowthInLam = Nothing })) + , Flag "fno-llf-clo-growth-in-lam" (noArg (\d -> d{ lateFloatCloGrowthInLam = Just 0 })) , Flag "fhistory-size" (intSuffix (\n d -> d{ historySize = n })) @@ -2761,18 +2761,18 @@ fFlags = [ ( "no-LNE", Opt_NoLNE, nop), - ( "late-float", Opt_LLF, nop), - ( "late-float-abstract-undersat", Opt_LLF_AbsUnsat, nop), - ( "late-float-abstract-sat", Opt_LLF_AbsSat, nop), - ( "late-float-abstract-oversat", Opt_LLF_AbsOversat, nop), - ( "late-float-create-PAPs", Opt_LLF_CreatePAPs, nop), - ( "late-float-simpl", Opt_LLF_Simpl, nop), - ( "late-float-stabilize", Opt_LLF_Stabilize, nop), - ( "late-float-use-strictness", Opt_LLF_UseStr, nop), - ( "late-float-ignore-LNE-clo", Opt_LLF_IgnoreLNEClo, nop), - ( "late-float-LNE0", Opt_LLF_FloatLNE0, nop), - ( "late-float-oneshot", Opt_LLF_OneShot, nop), - ( "late-float-leave-LNE", Opt_LLF_LeaveLNE, nop) + ( "llf", Opt_LLF, nop), + ( "llf-abstract-undersat", Opt_LLF_AbsUnsat, nop), + ( "llf-abstract-sat", Opt_LLF_AbsSat, nop), + ( "llf-abstract-oversat", Opt_LLF_AbsOversat, nop), + ( "llf-create-PAPs", Opt_LLF_CreatePAPs, nop), + ( "llf-simpl", Opt_LLF_Simpl, nop), + ( "llf-stabilize", Opt_LLF_Stabilize, nop), + ( "llf-use-strictness", Opt_LLF_UseStr, nop), + ( "llf-ignore-LNE-clo", Opt_LLF_IgnoreLNEClo, nop), + ( "llf-LNE0", Opt_LLF_FloatLNE0, nop), + ( "llf-oneshot", Opt_LLF_OneShot, nop), + ( "llf-leave-LNE", Opt_LLF_LeaveLNE, nop) ] -- | These @-f\@ flags can all be reversed with @-fno-\@ From git at git.haskell.org Wed Aug 20 01:05:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 01:05:10 +0000 (UTC) Subject: [commit: ghc] wip/llf: only stabilize if TidyPgm would retain the unfolding (4d3f37e) Message-ID: <20140820010510.8433724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/llf Link : http://ghc.haskell.org/trac/ghc/changeset/4d3f37e0c07f35be51b8bb24374ca3163b8b9a46/ghc >--------------------------------------------------------------- commit 4d3f37e0c07f35be51b8bb24374ca3163b8b9a46 Author: Nicolas Frisby Date: Tue Aug 19 19:51:21 2014 -0500 only stabilize if TidyPgm would retain the unfolding >--------------------------------------------------------------- 4d3f37e0c07f35be51b8bb24374ca3163b8b9a46 compiler/main/TidyPgm.lhs | 3 ++- compiler/simplCore/SetLevels.lhs | 15 ++++++++++----- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index b20658b..97ad171 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -5,7 +5,8 @@ \begin{code} module TidyPgm ( - mkBootModDetailsTc, tidyProgram, globaliseAndTidyId + mkBootModDetailsTc, tidyProgram, globaliseAndTidyId, + addExternal ) where #include "HsVersions.h" diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs index 09d69e4..fc1e4df 100644 --- a/compiler/simplCore/SetLevels.lhs +++ b/compiler/simplCore/SetLevels.lhs @@ -84,6 +84,8 @@ import StgCmmArgRep ( ArgRep(P), argRepSizeW, toArgRep ) import StgCmmLayout ( mkVirtHeapOffsets ) import StgCmmClosure ( idPrimRep, addIdReps ) +import qualified TidyPgm + import Demand ( isStrictDmd, splitStrictSig ) import Id import IdInfo @@ -260,13 +262,16 @@ lvlTopBind :: DynFlags -> LevelEnv -> Bind Id -> LvlM (LevelledBind, LevelEnv) lvlTopBind dflags env (NonRec bndr rhs) = do { rhs' <- lvlExpr env (analyzeFVs (initFVEnv $ finalPass env) rhs) ; let -- lambda lifting impedes specialization, so: if the old - -- RHS has an unstable unfolding, "stablize it" so that it - -- ends up in the .hi file + -- RHS has an unstable unfolding that will survive + -- TidyPgm, "stablize it" so that it ends up in the .hi + -- file as-is, prior to LLF squeezing all of the juice out + expose_all = gopt Opt_ExposeAllUnfoldings dflags stab_bndr - | gopt Opt_LLF_Stabilize dflags - , isFinalPass env + | isFinalPass env + , gopt Opt_LLF_Stabilize dflags + , snd $ TidyPgm.addExternal expose_all bndr , isUnstableUnfolding (realIdUnfolding bndr) - = bndr `setIdUnfolding` mkInlinableUnfolding dflags rhs + = bndr `setIdUnfolding` mkInlinableUnfolding dflags rhs | otherwise = bndr ; let (env', [bndr']) = substAndLvlBndrs NonRecursive env tOP_LEVEL [stab_bndr] ; return (NonRec bndr' rhs', env') } From git at git.haskell.org Wed Aug 20 01:05:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 01:05:13 +0000 (UTC) Subject: [commit: ghc] wip/llf: Merge branch 'master' into late-lam-lift (f17ceee) Message-ID: <20140820010513.BD49224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/llf Link : http://ghc.haskell.org/trac/ghc/changeset/f17ceee98221de21f896ac412b7a7ddcfc35a0c6/ghc >--------------------------------------------------------------- commit f17ceee98221de21f896ac412b7a7ddcfc35a0c6 Merge: 4d3f37e 15faa0e Author: Nicolas Frisby Date: Tue Aug 19 20:03:23 2014 -0500 Merge branch 'master' into late-lam-lift Silly conflicts because of new flags -- not sure how best to resolve/avoid this. git is requiring my commit to mention 'submodule' for some reason? Conflicts: compiler/main/DynFlags.hs >--------------------------------------------------------------- Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f17ceee98221de21f896ac412b7a7ddcfc35a0c6 From git at git.haskell.org Wed Aug 20 01:58:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 01:58:43 +0000 (UTC) Subject: [commit: ghc] wip/llf: more recent validate requires LANGUAGE pragma (9c2904c) Message-ID: <20140820015843.5625C24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/llf Link : http://ghc.haskell.org/trac/ghc/changeset/9c2904cafa657cdefd4177e8f16bd30e6b3a37ac/ghc >--------------------------------------------------------------- commit 9c2904cafa657cdefd4177e8f16bd30e6b3a37ac Author: Nicolas Frisby Date: Tue Aug 19 20:58:29 2014 -0500 more recent validate requires LANGUAGE pragma >--------------------------------------------------------------- 9c2904cafa657cdefd4177e8f16bd30e6b3a37ac compiler/simplCore/SetLevels.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs index ad5b119..0ed408a 100644 --- a/compiler/simplCore/SetLevels.lhs +++ b/compiler/simplCore/SetLevels.lhs @@ -1,4 +1,3 @@ - % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section{SetLevels} @@ -42,6 +41,7 @@ the scrutinee of the case, and we can inline it. \begin{code} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. From git at git.haskell.org Wed Aug 20 08:13:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:13:31 +0000 (UTC) Subject: [commit: ghc] master: Make sure that a prototype is included for 'setIOManagerControlFd' (7bf49f8) Message-ID: <20140820081331.330BF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7bf49f86a20f3beda0ee5fbea2db64cfef730d74/ghc >--------------------------------------------------------------- commit 7bf49f86a20f3beda0ee5fbea2db64cfef730d74 Author: Gabor Greif Date: Wed Aug 20 00:32:58 2014 +0200 Make sure that a prototype is included for 'setIOManagerControlFd' >--------------------------------------------------------------- 7bf49f86a20f3beda0ee5fbea2db64cfef730d74 rts/Capability.c | 1 + 1 file changed, 1 insertion(+) diff --git a/rts/Capability.c b/rts/Capability.c index 4543ec7..14c99d0 100644 --- a/rts/Capability.c +++ b/rts/Capability.c @@ -26,6 +26,7 @@ #include "sm/GC.h" // for gcWorkerThread() #include "STM.h" #include "RtsUtils.h" +#include "rts/IOManager.h" #include From git at git.haskell.org Wed Aug 20 08:13:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:13:33 +0000 (UTC) Subject: [commit: ghc] master: Comments fix to Trac #9140 (27c99a1) Message-ID: <20140820081333.8A6E524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/27c99a1f8399fd6cb8931c17385102747556b6cc/ghc >--------------------------------------------------------------- commit 27c99a1f8399fd6cb8931c17385102747556b6cc Author: Simon Peyton Jones Date: Wed Aug 20 09:12:55 2014 +0100 Comments fix to Trac #9140 >--------------------------------------------------------------- 27c99a1f8399fd6cb8931c17385102747556b6cc compiler/typecheck/TcBinds.lhs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 14a5704..9db4125 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -1456,6 +1456,10 @@ checkStrictBinds top_lvl rec_group orig_binds tc_binds poly_ids is_unlifted id = case tcSplitSigmaTy (idType id) of (_, _, rho) -> isUnLiftedType rho + -- For the is_unlifted check, we need to look inside polymorphism + -- and overloading. E.g. x = (# 1, True #) + -- would get type forall a. Num a => (# a, Bool #) + -- and we want to reject that. See Trac #9140 is_monomorphic (L _ (AbsBinds { abs_tvs = tvs, abs_ev_vars = evs })) = null tvs && null evs From git at git.haskell.org Wed Aug 20 08:47:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:47:49 +0000 (UTC) Subject: [commit: ghc] master: coreSyn: detabify/dewhitespace TrieMap (11f05c5) Message-ID: <20140820084753.C112524123@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/11f05c538addda0e037c626d75de96a9eb477f94/ghc >--------------------------------------------------------------- commit 11f05c538addda0e037c626d75de96a9eb477f94 Author: Austin Seipp Date: Wed Aug 20 03:29:49 2014 -0500 coreSyn: detabify/dewhitespace TrieMap Signed-off-by: Austin Seipp >--------------------------------------------------------------- 11f05c538addda0e037c626d75de96a9eb477f94 compiler/coreSyn/TrieMap.lhs | 67 ++++++++++++++++++++------------------------ 1 file changed, 30 insertions(+), 37 deletions(-) diff --git a/compiler/coreSyn/TrieMap.lhs b/compiler/coreSyn/TrieMap.lhs index 2744c5d..d552506 100644 --- a/compiler/coreSyn/TrieMap.lhs +++ b/compiler/coreSyn/TrieMap.lhs @@ -4,13 +4,6 @@ % \begin{code} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - {-# LANGUAGE RankNTypes, TypeFamilies #-} module TrieMap( CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap, @@ -51,14 +44,14 @@ some neat handling of *binders*. In effect they are deBruijn numbered on the fly. %************************************************************************ -%* * +%* * The TrieMap class -%* * +%* * %************************************************************************ \begin{code} -type XT a = Maybe a -> Maybe a -- How to alter a non-existent elt (Nothing) - -- or an existing elt (Just) +type XT a = Maybe a -> Maybe a -- How to alter a non-existent elt (Nothing) + -- or an existing elt (Just) class TrieMap m where type Key m :: * @@ -104,9 +97,9 @@ deMaybe (Just m) = m \end{code} %************************************************************************ -%* * +%* * IntMaps -%* * +%* * %************************************************************************ \begin{code} @@ -140,9 +133,9 @@ instance TrieMap UniqFM where %************************************************************************ -%* * +%* * Lists -%* * +%* * %************************************************************************ If m is a map from k -> val @@ -216,9 +209,9 @@ foldMaybe k (Just a) b = k a b %************************************************************************ -%* * +%* * Basic maps -%* * +%* * %************************************************************************ \begin{code} @@ -242,9 +235,9 @@ xtLit = alterTM \end{code} %************************************************************************ -%* * +%* * CoreMap -%* * +%* * %************************************************************************ Note [Binders] @@ -296,10 +289,10 @@ data CoreMap a wrapEmptyCM :: CoreMap a wrapEmptyCM = CM { cm_var = emptyTM, cm_lit = emptyLiteralMap - , cm_co = emptyTM, cm_type = emptyTM - , cm_cast = emptyTM, cm_app = emptyTM - , cm_lam = emptyTM, cm_letn = emptyTM - , cm_letr = emptyTM, cm_case = emptyTM + , cm_co = emptyTM, cm_type = emptyTM + , cm_cast = emptyTM, cm_app = emptyTM + , cm_lam = emptyTM, cm_letn = emptyTM + , cm_letr = emptyTM, cm_case = emptyTM , cm_ecase = emptyTM, cm_tick = emptyTM } instance TrieMap CoreMap where @@ -315,9 +308,9 @@ mapE :: (a->b) -> CoreMap a -> CoreMap b mapE _ EmptyCM = EmptyCM mapE f (CM { cm_var = cvar, cm_lit = clit , cm_co = cco, cm_type = ctype - , cm_cast = ccast , cm_app = capp - , cm_lam = clam, cm_letn = cletn - , cm_letr = cletr, cm_case = ccase + , cm_cast = ccast , cm_app = capp + , cm_lam = clam, cm_letn = cletn + , cm_letr = cletr, cm_case = ccase , cm_ecase = cecase, cm_tick = ctick }) = CM { cm_var = mapTM f cvar, cm_lit = mapTM f clit , cm_co = mapTM f cco, cm_type = mapTM f ctype @@ -365,9 +358,9 @@ lkE env expr cm | EmptyCM <- cm = Nothing | otherwise = go expr cm where - go (Var v) = cm_var >.> lkVar env v + go (Var v) = cm_var >.> lkVar env v go (Lit l) = cm_lit >.> lkLit l - go (Type t) = cm_type >.> lkT env t + go (Type t) = cm_type >.> lkT env t go (Coercion c) = cm_co >.> lkC env c go (Cast e c) = cm_cast >.> lkE env e >=> lkC env c go (Tick tickish e) = cm_tick >.> lkE env e >=> lkTickish tickish @@ -388,7 +381,7 @@ lkE env expr cm xtE :: CmEnv -> CoreExpr -> XT a -> CoreMap a -> CoreMap a xtE env e f EmptyCM = xtE env e f wrapEmptyCM xtE env (Var v) f m = m { cm_var = cm_var m |> xtVar env v f } -xtE env (Type t) f m = m { cm_type = cm_type m |> xtT env t f } +xtE env (Type t) f m = m { cm_type = cm_type m |> xtT env t f } xtE env (Coercion c) f m = m { cm_co = cm_co m |> xtC env c f } xtE _ (Lit l) f m = m { cm_lit = cm_lit m |> xtLit l f } xtE env (Cast e c) f m = m { cm_cast = cm_cast m |> xtE env e |>> @@ -420,7 +413,7 @@ xtTickish :: Tickish Id -> XT a -> TickishMap a -> TickishMap a xtTickish = alterTM ------------------------ -data AltMap a -- A single alternative +data AltMap a -- A single alternative = AM { am_deflt :: CoreMap a , am_data :: NameEnv (CoreMap a) , am_lit :: LiteralMap (CoreMap a) } @@ -459,9 +452,9 @@ fdA k m = foldTM k (am_deflt m) \end{code} %************************************************************************ -%* * +%* * Coercions -%* * +%* * %************************************************************************ \begin{code} @@ -627,9 +620,9 @@ mapR f = RM . mapTM f . unRM %************************************************************************ -%* * +%* * Types -%* * +%* * %************************************************************************ \begin{code} @@ -775,9 +768,9 @@ foldTyLit l m = flip (Map.fold l) (tlm_string m) %************************************************************************ -%* * +%* * Variables -%* * +%* * %************************************************************************ \begin{code} @@ -811,7 +804,7 @@ xtBndr env v f = xtT env (varType v) f --------- Variable occurrence ------------- data VarMap a = VM { vm_bvar :: BoundVarMap a -- Bound variable - , vm_fvar :: VarEnv a } -- Free variable + , vm_fvar :: VarEnv a } -- Free variable instance TrieMap VarMap where type Key VarMap = Var From git at git.haskell.org Wed Aug 20 08:47:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:47:51 +0000 (UTC) Subject: [commit: ghc] master: coreSyn: detabify/dewhitespace CoreTidy (fbdc21b) Message-ID: <20140820084753.E75D52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fbdc21b8282d3544badaa876d2ebc4fd199d2724/ghc >--------------------------------------------------------------- commit fbdc21b8282d3544badaa876d2ebc4fd199d2724 Author: Austin Seipp Date: Wed Aug 20 03:39:40 2014 -0500 coreSyn: detabify/dewhitespace CoreTidy Signed-off-by: Austin Seipp >--------------------------------------------------------------- fbdc21b8282d3544badaa876d2ebc4fd199d2724 compiler/coreSyn/CoreTidy.lhs | 133 ++++++++++++++++++++---------------------- 1 file changed, 63 insertions(+), 70 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc fbdc21b8282d3544badaa876d2ebc4fd199d2724 From git at git.haskell.org Wed Aug 20 08:47:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:47:54 +0000 (UTC) Subject: [commit: ghc] master: simplCore: detabify/dewhitespace LiberateCase (28a8cd1) Message-ID: <20140820084754.50B8924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/28a8cd143e046d44aae6df4f8a6046dc0cf68ea2/ghc >--------------------------------------------------------------- commit 28a8cd143e046d44aae6df4f8a6046dc0cf68ea2 Author: Austin Seipp Date: Wed Aug 20 03:36:39 2014 -0500 simplCore: detabify/dewhitespace LiberateCase Signed-off-by: Austin Seipp >--------------------------------------------------------------- 28a8cd143e046d44aae6df4f8a6046dc0cf68ea2 compiler/simplCore/LiberateCase.lhs | 230 +++++++++++++++++------------------- 1 file changed, 111 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 28a8cd143e046d44aae6df4f8a6046dc0cf68ea2 From git at git.haskell.org Wed Aug 20 08:47:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:47:57 +0000 (UTC) Subject: [commit: ghc] master: utils: detabify/dewhitespace GraphBase (a9f5c81) Message-ID: <20140820084757.818C924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a9f5c8153f1eef5128ab09c53056cd17af4a2f62/ghc >--------------------------------------------------------------- commit a9f5c8153f1eef5128ab09c53056cd17af4a2f62 Author: Austin Seipp Date: Wed Aug 20 03:33:28 2014 -0500 utils: detabify/dewhitespace GraphBase Signed-off-by: Austin Seipp >--------------------------------------------------------------- a9f5c8153f1eef5128ab09c53056cd17af4a2f62 compiler/utils/GraphBase.hs | 121 ++++++++++++++++++++------------------------ 1 file changed, 54 insertions(+), 67 deletions(-) diff --git a/compiler/utils/GraphBase.hs b/compiler/utils/GraphBase.hs index 2aa16ae..c3850df 100644 --- a/compiler/utils/GraphBase.hs +++ b/compiler/utils/GraphBase.hs @@ -1,20 +1,12 @@ -- | Types for the general graph colorer. - -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module GraphBase ( - Triv, - Graph (..), - initGraph, - graphMapModify, + Triv, + Graph (..), + initGraph, + graphMapModify, - Node (..), newNode, + Node (..), newNode, ) @@ -25,94 +17,89 @@ import UniqFM -- | A fn to check if a node is trivially colorable --- For graphs who's color classes are disjoint then a node is 'trivially colorable' --- when it has less neighbors and exclusions than available colors for that node. +-- For graphs who's color classes are disjoint then a node is 'trivially colorable' +-- when it has less neighbors and exclusions than available colors for that node. -- --- For graph's who's color classes overlap, ie some colors alias other colors, then --- this can be a bit more tricky. There is a general way to calculate this, but --- it's likely be too slow for use in the code. The coloring algorithm takes --- a canned function which can be optimised by the user to be specific to the --- specific graph being colored. +-- For graph's who's color classes overlap, ie some colors alias other colors, then +-- this can be a bit more tricky. There is a general way to calculate this, but +-- it's likely be too slow for use in the code. The coloring algorithm takes +-- a canned function which can be optimised by the user to be specific to the +-- specific graph being colored. -- --- for details, see "A Generalised Algorithm for Graph-Coloring Register Allocation" --- Smith, Ramsey, Holloway - PLDI 2004. +-- for details, see "A Generalised Algorithm for Graph-Coloring Register Allocation" +-- Smith, Ramsey, Holloway - PLDI 2004. -- type Triv k cls color - = cls -- the class of the node we're trying to color. - -> UniqSet k -- the node's neighbors. - -> UniqSet color -- the node's exclusions. - -> Bool + = cls -- the class of the node we're trying to color. + -> UniqSet k -- the node's neighbors. + -> UniqSet color -- the node's exclusions. + -> Bool -- | The Interference graph. --- There used to be more fields, but they were turfed out in a previous revision. --- maybe we'll want more later.. +-- There used to be more fields, but they were turfed out in a previous revision. +-- maybe we'll want more later.. -- data Graph k cls color - = Graph { - -- | All active nodes in the graph. - graphMap :: UniqFM (Node k cls color) } + = Graph { + -- | All active nodes in the graph. + graphMap :: UniqFM (Node k cls color) } -- | An empty graph. initGraph :: Graph k cls color initGraph - = Graph - { graphMap = emptyUFM } + = Graph + { graphMap = emptyUFM } -- | Modify the finite map holding the nodes in the graph. graphMapModify - :: (UniqFM (Node k cls color) -> UniqFM (Node k cls color)) - -> Graph k cls color -> Graph k cls color + :: (UniqFM (Node k cls color) -> UniqFM (Node k cls color)) + -> Graph k cls color -> Graph k cls color graphMapModify f graph - = graph { graphMap = f (graphMap graph) } + = graph { graphMap = f (graphMap graph) } -- | Graph nodes. --- Represents a thing that can conflict with another thing. --- For the register allocater the nodes represent registers. +-- Represents a thing that can conflict with another thing. +-- For the register allocater the nodes represent registers. -- data Node k cls color - = Node { - -- | A unique identifier for this node. - nodeId :: k + = Node { + -- | A unique identifier for this node. + nodeId :: k - -- | The class of this node, - -- determines the set of colors that can be used. - , nodeClass :: cls + -- | The class of this node, + -- determines the set of colors that can be used. + , nodeClass :: cls - -- | The color of this node, if any. - , nodeColor :: Maybe color + -- | The color of this node, if any. + , nodeColor :: Maybe color - -- | Neighbors which must be colored differently to this node. - , nodeConflicts :: UniqSet k + -- | Neighbors which must be colored differently to this node. + , nodeConflicts :: UniqSet k - -- | Colors that cannot be used by this node. - , nodeExclusions :: UniqSet color + -- | Colors that cannot be used by this node. + , nodeExclusions :: UniqSet color - -- | Colors that this node would prefer to be, in decending order. - , nodePreference :: [color] + -- | Colors that this node would prefer to be, in decending order. + , nodePreference :: [color] - -- | Neighbors that this node would like to be colored the same as. - , nodeCoalesce :: UniqSet k } + -- | Neighbors that this node would like to be colored the same as. + , nodeCoalesce :: UniqSet k } -- | An empty node. newNode :: k -> cls -> Node k cls color newNode k cls - = Node - { nodeId = k - , nodeClass = cls - , nodeColor = Nothing - , nodeConflicts = emptyUniqSet - , nodeExclusions = emptyUniqSet - , nodePreference = [] - , nodeCoalesce = emptyUniqSet } - - - - - + = Node + { nodeId = k + , nodeClass = cls + , nodeColor = Nothing + , nodeConflicts = emptyUniqSet + , nodeExclusions = emptyUniqSet + , nodePreference = [] + , nodeCoalesce = emptyUniqSet } From git at git.haskell.org Wed Aug 20 08:47:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:47:59 +0000 (UTC) Subject: [commit: ghc] master: utils: detabify/dewhitespace GraphPpr (e3a5bad) Message-ID: <20140820084800.09BDC24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e3a5bad81686a21792bf80d891a52c20d7066db9/ghc >--------------------------------------------------------------- commit e3a5bad81686a21792bf80d891a52c20d7066db9 Author: Austin Seipp Date: Wed Aug 20 03:33:57 2014 -0500 utils: detabify/dewhitespace GraphPpr Signed-off-by: Austin Seipp >--------------------------------------------------------------- e3a5bad81686a21792bf80d891a52c20d7066db9 compiler/utils/GraphPpr.hs | 226 ++++++++++++++++++++++----------------------- 1 file changed, 109 insertions(+), 117 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e3a5bad81686a21792bf80d891a52c20d7066db9 From git at git.haskell.org Wed Aug 20 08:48:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:48:02 +0000 (UTC) Subject: [commit: ghc] master: stranal: detabify/dewhitespace WorkWrap (236e2ea) Message-ID: <20140820084803.0353E24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/236e2ea646a8ebd0d98d04c3908cca26dc5cafe8/ghc >--------------------------------------------------------------- commit 236e2ea646a8ebd0d98d04c3908cca26dc5cafe8 Author: Austin Seipp Date: Wed Aug 20 03:31:18 2014 -0500 stranal: detabify/dewhitespace WorkWrap Signed-off-by: Austin Seipp >--------------------------------------------------------------- 236e2ea646a8ebd0d98d04c3908cca26dc5cafe8 compiler/stranal/WorkWrap.lhs | 163 ++++++++++++++++++++---------------------- 1 file changed, 78 insertions(+), 85 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 236e2ea646a8ebd0d98d04c3908cca26dc5cafe8 From git at git.haskell.org Wed Aug 20 08:48:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:48:05 +0000 (UTC) Subject: [commit: ghc] master: simplCore: detabify/dewhitespace SAT (96c3599) Message-ID: <20140820084805.8154C24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/96c3599375d040b914d433cda97d532ff0aae3bc/ghc >--------------------------------------------------------------- commit 96c3599375d040b914d433cda97d532ff0aae3bc Author: Austin Seipp Date: Wed Aug 20 03:31:49 2014 -0500 simplCore: detabify/dewhitespace SAT Signed-off-by: Austin Seipp >--------------------------------------------------------------- 96c3599375d040b914d433cda97d532ff0aae3bc compiler/simplCore/SAT.lhs | 70 ++++++++++++++++++++-------------------------- 1 file changed, 31 insertions(+), 39 deletions(-) diff --git a/compiler/simplCore/SAT.lhs b/compiler/simplCore/SAT.lhs index 92ebdfe..a0b3151 100644 --- a/compiler/simplCore/SAT.lhs +++ b/compiler/simplCore/SAT.lhs @@ -50,14 +50,6 @@ essential to make this work well! \begin{code} {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - - module SAT ( doStaticArgs ) where import Var @@ -112,7 +104,7 @@ satBind (Rec [(binder, rhs)]) interesting_ids = do else sat_info_rhs' bind' <- saTransformMaybe binder (lookupUFM sat_info_rhs' binder) - rhs_binders rhs_body' + rhs_binders rhs_body' return (bind', sat_info_rhs'') satBind (Rec pairs) interesting_ids = do let (binders, rhss) = unzip pairs @@ -298,13 +290,13 @@ to map :: forall a b. (a->b) -> [a] -> [b] map = /\ab. \(f:a->b) (as:[a]) -> letrec map' :: [a] -> [b] - -- The "worker function + -- The "worker function map' = \(as:[a]) -> - let map :: forall a' b'. (a -> b) -> [a] -> [b] - -- The "shadow function - map = /\a'b'. \(f':(a->b) (as:[a]). - map' as - in body[map] + let map :: forall a' b'. (a -> b) -> [a] -> [b] + -- The "shadow function + map = /\a'b'. \(f':(a->b) (as:[a]). + map' as + in body[map] in map' as Note [Shadow binding] @@ -379,13 +371,13 @@ saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body where should_transform staticness = n_static_args > 1 -- THIS IS THE DECISION POINT where - n_static_args = length (filter isStaticValue staticness) + n_static_args = length (filter isStaticValue staticness) saTransform :: Id -> SATInfo -> [Id] -> CoreExpr -> SatM CoreBind saTransform binder arg_staticness rhs_binders rhs_body - = do { shadow_lam_bndrs <- mapM clone binders_w_staticness - ; uniq <- newUnique - ; return (NonRec binder (mk_new_rhs uniq shadow_lam_bndrs)) } + = do { shadow_lam_bndrs <- mapM clone binders_w_staticness + ; uniq <- newUnique + ; return (NonRec binder (mk_new_rhs uniq shadow_lam_bndrs)) } where -- Running example: foldr -- foldr \alpha \beta c n xs = e, for some e @@ -394,43 +386,43 @@ saTransform binder arg_staticness rhs_binders rhs_body -- rhs_body = e binders_w_staticness = rhs_binders `zip` (arg_staticness ++ repeat NotStatic) - -- Any extra args are assumed NotStatic + -- Any extra args are assumed NotStatic non_static_args :: [Var] - -- non_static_args = [xs] - -- rhs_binders_without_type_capture = [\alpha', \beta', c, n, xs] + -- non_static_args = [xs] + -- rhs_binders_without_type_capture = [\alpha', \beta', c, n, xs] non_static_args = [v | (v, NotStatic) <- binders_w_staticness] clone (bndr, NotStatic) = return bndr clone (bndr, _ ) = do { uniq <- newUnique - ; return (setVarUnique bndr uniq) } + ; return (setVarUnique bndr uniq) } -- new_rhs = \alpha beta c n xs -> -- let sat_worker = \xs -> let sat_shadow = \alpha' beta' c n xs -> - -- sat_worker xs + -- sat_worker xs -- in e -- in sat_worker xs mk_new_rhs uniq shadow_lam_bndrs - = mkLams rhs_binders $ - Let (Rec [(rec_body_bndr, rec_body)]) - local_body - where - local_body = mkVarApps (Var rec_body_bndr) non_static_args + = mkLams rhs_binders $ + Let (Rec [(rec_body_bndr, rec_body)]) + local_body + where + local_body = mkVarApps (Var rec_body_bndr) non_static_args - rec_body = mkLams non_static_args $ + rec_body = mkLams non_static_args $ Let (NonRec shadow_bndr shadow_rhs) rhs_body - -- See Note [Binder type capture] - shadow_rhs = mkLams shadow_lam_bndrs local_body - -- nonrec_rhs = \alpha' beta' c n xs -> sat_worker xs + -- See Note [Binder type capture] + shadow_rhs = mkLams shadow_lam_bndrs local_body + -- nonrec_rhs = \alpha' beta' c n xs -> sat_worker xs - rec_body_bndr = mkSysLocal (fsLit "sat_worker") uniq (exprType rec_body) - -- rec_body_bndr = sat_worker + rec_body_bndr = mkSysLocal (fsLit "sat_worker") uniq (exprType rec_body) + -- rec_body_bndr = sat_worker - -- See Note [Shadow binding]; make a SysLocal - shadow_bndr = mkSysLocal (occNameFS (getOccName binder)) - (idUnique binder) - (exprType shadow_rhs) + -- See Note [Shadow binding]; make a SysLocal + shadow_bndr = mkSysLocal (occNameFS (getOccName binder)) + (idUnique binder) + (exprType shadow_rhs) isStaticValue :: Staticness App -> Bool isStaticValue (Static (VarApp _)) = True From git at git.haskell.org Wed Aug 20 08:48:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:48:08 +0000 (UTC) Subject: [commit: ghc] master: utils: detabify/dewhitespace BufWrite (fb9bc40) Message-ID: <20140820084808.CCBDE24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fb9bc40af7ced7ede22e91f12b66dc8035f94ff5/ghc >--------------------------------------------------------------- commit fb9bc40af7ced7ede22e91f12b66dc8035f94ff5 Author: Austin Seipp Date: Wed Aug 20 03:33:02 2014 -0500 utils: detabify/dewhitespace BufWrite Signed-off-by: Austin Seipp >--------------------------------------------------------------- fb9bc40af7ced7ede22e91f12b66dc8035f94ff5 compiler/utils/BufWrite.hs | 73 +++++++++++++++++++++------------------------- 1 file changed, 33 insertions(+), 40 deletions(-) diff --git a/compiler/utils/BufWrite.hs b/compiler/utils/BufWrite.hs index 7eba075..482e9ee 100644 --- a/compiler/utils/BufWrite.hs +++ b/compiler/utils/BufWrite.hs @@ -12,22 +12,15 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module BufWrite ( - BufHandle(..), - newBufHandle, - bPutChar, - bPutStr, - bPutFS, - bPutFZS, - bPutLitString, - bFlush, + BufHandle(..), + newBufHandle, + bPutChar, + bPutStr, + bPutFS, + bPutFZS, + bPutLitString, + bFlush, ) where #include "HsVersions.h" @@ -36,10 +29,10 @@ import FastString import FastTypes import FastMutInt -import Control.Monad ( when ) +import Control.Monad ( when ) import Data.ByteString (ByteString) import qualified Data.ByteString.Unsafe as BS -import Data.Char ( ord ) +import Data.Char ( ord ) import Foreign import Foreign.C.String import System.IO @@ -47,8 +40,8 @@ import System.IO -- ----------------------------------------------------------------------------- data BufHandle = BufHandle {-#UNPACK#-}!(Ptr Word8) - {-#UNPACK#-}!FastMutInt - Handle + {-#UNPACK#-}!FastMutInt + Handle newBufHandle :: Handle -> IO BufHandle newBufHandle hdl = do @@ -68,11 +61,11 @@ STRICT2(bPutChar) bPutChar b@(BufHandle buf r hdl) c = do i <- readFastMutInt r if (i >= buf_size) - then do hPutBuf hdl buf buf_size - writeFastMutInt r 0 - bPutChar b c - else do pokeElemOff buf i (fromIntegral (ord c) :: Word8) - writeFastMutInt r (i+1) + then do hPutBuf hdl buf buf_size + writeFastMutInt r 0 + bPutChar b c + else do pokeElemOff buf i (fromIntegral (ord c) :: Word8) + writeFastMutInt r (i+1) bPutStr :: BufHandle -> String -> IO () STRICT2(bPutStr) @@ -80,14 +73,14 @@ bPutStr (BufHandle buf r hdl) str = do i <- readFastMutInt r loop str i where loop _ i | i `seq` False = undefined - loop "" i = do writeFastMutInt r i; return () - loop (c:cs) i - | i >= buf_size = do - hPutBuf hdl buf buf_size - loop (c:cs) 0 - | otherwise = do - pokeElemOff buf i (fromIntegral (ord c)) - loop cs (i+1) + loop "" i = do writeFastMutInt r i; return () + loop (c:cs) i + | i >= buf_size = do + hPutBuf hdl buf buf_size + loop (c:cs) 0 + | otherwise = do + pokeElemOff buf i (fromIntegral (ord c)) + loop cs (i+1) bPutFS :: BufHandle -> FastString -> IO () bPutFS b fs = bPutBS b $ fastStringToByteString fs @@ -116,14 +109,14 @@ bPutLitString b@(BufHandle buf r hdl) a len_ = a `seq` do let len = iBox len_ i <- readFastMutInt r if (i+len) >= buf_size - then do hPutBuf hdl buf i - writeFastMutInt r 0 - if (len >= buf_size) - then hPutBuf hdl a len - else bPutLitString b a len_ - else do - copyBytes (buf `plusPtr` i) a len - writeFastMutInt r (i+len) + then do hPutBuf hdl buf i + writeFastMutInt r 0 + if (len >= buf_size) + then hPutBuf hdl a len + else bPutLitString b a len_ + else do + copyBytes (buf `plusPtr` i) a len + writeFastMutInt r (i+len) bFlush :: BufHandle -> IO () bFlush (BufHandle buf r hdl) = do From git at git.haskell.org Wed Aug 20 08:48:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:48:10 +0000 (UTC) Subject: [commit: ghc] master: prelude: detabify/dewhitespace TysPrim (ef9dd9f) Message-ID: <20140820084810.EE1D924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ef9dd9fcb9df0ab8729e312103f20b7288574d6b/ghc >--------------------------------------------------------------- commit ef9dd9fcb9df0ab8729e312103f20b7288574d6b Author: Austin Seipp Date: Wed Aug 20 03:38:01 2014 -0500 prelude: detabify/dewhitespace TysPrim Signed-off-by: Austin Seipp >--------------------------------------------------------------- ef9dd9fcb9df0ab8729e312103f20b7288574d6b compiler/prelude/TysPrim.lhs | 333 +++++++++++++++++++++---------------------- 1 file changed, 163 insertions(+), 170 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ef9dd9fcb9df0ab8729e312103f20b7288574d6b From git at git.haskell.org Wed Aug 20 08:48:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:48:13 +0000 (UTC) Subject: [commit: ghc] master: simplCore: detabify/dewhitespace SetLevels (6f01f0b) Message-ID: <20140820084813.6BDDE24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f01f0b9801f5dddda956b643221969ed1357187/ghc >--------------------------------------------------------------- commit 6f01f0b9801f5dddda956b643221969ed1357187 Author: Austin Seipp Date: Wed Aug 20 03:35:36 2014 -0500 simplCore: detabify/dewhitespace SetLevels Signed-off-by: Austin Seipp >--------------------------------------------------------------- 6f01f0b9801f5dddda956b643221969ed1357187 compiler/simplCore/SetLevels.lhs | 488 +++++++++++++++++++-------------------- 1 file changed, 240 insertions(+), 248 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6f01f0b9801f5dddda956b643221969ed1357187 From git at git.haskell.org Wed Aug 20 08:48:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:48:17 +0000 (UTC) Subject: [commit: ghc] master: basicTypes: detabify/dewhitespace NameSet (1ad35f4) Message-ID: <20140820084817.CB46424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1ad35f4c52a9e5727a009531c1241dba4ba389bd/ghc >--------------------------------------------------------------- commit 1ad35f4c52a9e5727a009531c1241dba4ba389bd Author: Austin Seipp Date: Wed Aug 20 03:45:15 2014 -0500 basicTypes: detabify/dewhitespace NameSet Signed-off-by: Austin Seipp >--------------------------------------------------------------- 1ad35f4c52a9e5727a009531c1241dba4ba389bd compiler/basicTypes/NameSet.lhs | 113 +++++++++++++++++++--------------------- 1 file changed, 53 insertions(+), 60 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1ad35f4c52a9e5727a009531c1241dba4ba389bd From git at git.haskell.org Wed Aug 20 08:48:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:48:19 +0000 (UTC) Subject: [commit: ghc] master: deSugar: detabify/dewhitespace DsCCall (8396e44) Message-ID: <20140820084823.28DE22406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8396e44500606368e1acd1c7c0c98e66c9da8f66/ghc >--------------------------------------------------------------- commit 8396e44500606368e1acd1c7c0c98e66c9da8f66 Author: Austin Seipp Date: Wed Aug 20 03:41:32 2014 -0500 deSugar: detabify/dewhitespace DsCCall Signed-off-by: Austin Seipp >--------------------------------------------------------------- 8396e44500606368e1acd1c7c0c98e66c9da8f66 compiler/deSugar/DsCCall.lhs | 175 +++++++++++++++++++++---------------------- 1 file changed, 84 insertions(+), 91 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8396e44500606368e1acd1c7c0c98e66c9da8f66 From git at git.haskell.org Wed Aug 20 08:48:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:48:22 +0000 (UTC) Subject: [commit: ghc] master: basicTypes: detabify/dewhitespace IdInfo (37743a1) Message-ID: <20140820084823.5643D24123@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/37743a136b588b5217b71ec5bb430b854359631a/ghc >--------------------------------------------------------------- commit 37743a136b588b5217b71ec5bb430b854359631a Author: Austin Seipp Date: Wed Aug 20 03:46:22 2014 -0500 basicTypes: detabify/dewhitespace IdInfo Signed-off-by: Austin Seipp >--------------------------------------------------------------- 37743a136b588b5217b71ec5bb430b854359631a compiler/basicTypes/IdInfo.lhs | 265 ++++++++++++++++++++--------------------- 1 file changed, 129 insertions(+), 136 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 37743a136b588b5217b71ec5bb430b854359631a From git at git.haskell.org Wed Aug 20 08:48:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:48:25 +0000 (UTC) Subject: [commit: ghc] master: hsSyn: detabify/dewhitespace HsLit (8a8ead0) Message-ID: <20140820084825.A4B6224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8a8ead0e467bb6d1ec40d5db3efd76fbf18c913c/ghc >--------------------------------------------------------------- commit 8a8ead0e467bb6d1ec40d5db3efd76fbf18c913c Author: Austin Seipp Date: Wed Aug 20 03:43:14 2014 -0500 hsSyn: detabify/dewhitespace HsLit Signed-off-by: Austin Seipp >--------------------------------------------------------------- 8a8ead0e467bb6d1ec40d5db3efd76fbf18c913c compiler/hsSyn/HsLit.lhs | 104 ++++++++++++++++++++++------------------------- 1 file changed, 48 insertions(+), 56 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8a8ead0e467bb6d1ec40d5db3efd76fbf18c913c From git at git.haskell.org Wed Aug 20 08:48:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:48:28 +0000 (UTC) Subject: [commit: ghc] master: basicTypes: detabify/dewhitespace NameEnv (1b55153) Message-ID: <20140820084829.37A4D24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1b551534cbdf7ac32d18cf5c6fb40e5e79892f4b/ghc >--------------------------------------------------------------- commit 1b551534cbdf7ac32d18cf5c6fb40e5e79892f4b Author: Austin Seipp Date: Wed Aug 20 03:45:44 2014 -0500 basicTypes: detabify/dewhitespace NameEnv Signed-off-by: Austin Seipp >--------------------------------------------------------------- 1b551534cbdf7ac32d18cf5c6fb40e5e79892f4b compiler/basicTypes/NameEnv.lhs | 76 ++++++++++++++++++----------------------- 1 file changed, 34 insertions(+), 42 deletions(-) diff --git a/compiler/basicTypes/NameEnv.lhs b/compiler/basicTypes/NameEnv.lhs index f396277..1fe908b 100644 --- a/compiler/basicTypes/NameEnv.lhs +++ b/compiler/basicTypes/NameEnv.lhs @@ -6,26 +6,19 @@ \begin{code} {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module NameEnv ( - -- * Var, Id and TyVar environments (maps) - NameEnv, + -- * Var, Id and TyVar environments (maps) + NameEnv, - -- ** Manipulating these environments - mkNameEnv, - emptyNameEnv, unitNameEnv, nameEnvElts, nameEnvUniqueElts, - extendNameEnv_C, extendNameEnv_Acc, extendNameEnv, + -- ** Manipulating these environments + mkNameEnv, + emptyNameEnv, unitNameEnv, nameEnvElts, nameEnvUniqueElts, + extendNameEnv_C, extendNameEnv_Acc, extendNameEnv, extendNameEnvList, extendNameEnvList_C, - foldNameEnv, filterNameEnv, - plusNameEnv, plusNameEnv_C, alterNameEnv, - lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv, - elemNameEnv, mapNameEnv, + foldNameEnv, filterNameEnv, + plusNameEnv, plusNameEnv_C, alterNameEnv, + lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv, + elemNameEnv, mapNameEnv, -- ** Dependency analysis depAnal @@ -41,9 +34,9 @@ import Maybes \end{code} %************************************************************************ -%* * +%* * \subsection{Name environment} -%* * +%* * %************************************************************************ \begin{code} @@ -67,50 +60,50 @@ depAnal get_defs get_uses nodes %************************************************************************ -%* * +%* * \subsection{Name environment} -%* * +%* * %************************************************************************ \begin{code} -type NameEnv a = UniqFM a -- Domain is Name +type NameEnv a = UniqFM a -- Domain is Name -emptyNameEnv :: NameEnv a -mkNameEnv :: [(Name,a)] -> NameEnv a -nameEnvElts :: NameEnv a -> [a] +emptyNameEnv :: NameEnv a +mkNameEnv :: [(Name,a)] -> NameEnv a +nameEnvElts :: NameEnv a -> [a] nameEnvUniqueElts :: NameEnv a -> [(Unique, a)] alterNameEnv :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a extendNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a extendNameEnv_Acc :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b -extendNameEnv :: NameEnv a -> Name -> a -> NameEnv a -plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a -plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a +extendNameEnv :: NameEnv a -> Name -> a -> NameEnv a +plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a +plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a extendNameEnvList :: NameEnv a -> [(Name,a)] -> NameEnv a extendNameEnvList_C :: (a->a->a) -> NameEnv a -> [(Name,a)] -> NameEnv a -delFromNameEnv :: NameEnv a -> Name -> NameEnv a +delFromNameEnv :: NameEnv a -> Name -> NameEnv a delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a -elemNameEnv :: Name -> NameEnv a -> Bool -unitNameEnv :: Name -> a -> NameEnv a -lookupNameEnv :: NameEnv a -> Name -> Maybe a +elemNameEnv :: Name -> NameEnv a -> Bool +unitNameEnv :: Name -> a -> NameEnv a +lookupNameEnv :: NameEnv a -> Name -> Maybe a lookupNameEnv_NF :: NameEnv a -> Name -> a -foldNameEnv :: (a -> b -> b) -> b -> NameEnv a -> b -filterNameEnv :: (elt -> Bool) -> NameEnv elt -> NameEnv elt -mapNameEnv :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2 +foldNameEnv :: (a -> b -> b) -> b -> NameEnv a -> b +filterNameEnv :: (elt -> Bool) -> NameEnv elt -> NameEnv elt +mapNameEnv :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2 nameEnvElts x = eltsUFM x -emptyNameEnv = emptyUFM +emptyNameEnv = emptyUFM unitNameEnv x y = unitUFM x y extendNameEnv x y z = addToUFM x y z extendNameEnvList x l = addListToUFM x l lookupNameEnv x y = lookupUFM x y alterNameEnv = alterUFM mkNameEnv l = listToUFM l -elemNameEnv x y = elemUFM x y -foldNameEnv a b c = foldUFM a b c -plusNameEnv x y = plusUFM x y -plusNameEnv_C f x y = plusUFM_C f x y +elemNameEnv x y = elemUFM x y +foldNameEnv a b c = foldUFM a b c +plusNameEnv x y = plusUFM x y +plusNameEnv_C f x y = plusUFM_C f x y extendNameEnv_C f x y z = addToUFM_C f x y z -mapNameEnv f x = mapUFM f x +mapNameEnv f x = mapUFM f x nameEnvUniqueElts x = ufmToList x extendNameEnv_Acc x y z a b = addToUFM_Acc x y z a b extendNameEnvList_C x y z = addListToUFM_C x y z @@ -120,4 +113,3 @@ filterNameEnv x y = filterUFM x y lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n) \end{code} - From git at git.haskell.org Wed Aug 20 08:48:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:48:32 +0000 (UTC) Subject: [commit: ghc] master: stranal: detabify/dewhitespace DmdAnal (07d01c9) Message-ID: <20140820084832.0EE4D24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/07d01c9f77b510c6e1d64e090f6ff008d9fb5d56/ghc >--------------------------------------------------------------- commit 07d01c9f77b510c6e1d64e090f6ff008d9fb5d56 Author: Austin Seipp Date: Wed Aug 20 03:42:38 2014 -0500 stranal: detabify/dewhitespace DmdAnal Signed-off-by: Austin Seipp >--------------------------------------------------------------- 07d01c9f77b510c6e1d64e090f6ff008d9fb5d56 compiler/stranal/DmdAnal.lhs | 515 +++++++++++++++++++++---------------------- 1 file changed, 257 insertions(+), 258 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 07d01c9f77b510c6e1d64e090f6ff008d9fb5d56 From git at git.haskell.org Wed Aug 20 08:48:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:48:34 +0000 (UTC) Subject: [commit: ghc] master: coreSyn: detabify/dewhitespace CoreSubst (ffc1afe) Message-ID: <20140820084834.902EF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ffc1afe77e73dcd113fafb92cf85e01e1d3c617f/ghc >--------------------------------------------------------------- commit ffc1afe77e73dcd113fafb92cf85e01e1d3c617f Author: Austin Seipp Date: Wed Aug 20 03:40:18 2014 -0500 coreSyn: detabify/dewhitespace CoreSubst Signed-off-by: Austin Seipp >--------------------------------------------------------------- ffc1afe77e73dcd113fafb92cf85e01e1d3c617f compiler/coreSyn/CoreSubst.lhs | 303 ++++++++++++++++++++--------------------- 1 file changed, 148 insertions(+), 155 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ffc1afe77e73dcd113fafb92cf85e01e1d3c617f From git at git.haskell.org Wed Aug 20 08:48:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 08:48:37 +0000 (UTC) Subject: [commit: ghc] master: basicTypes: detabify/dewhitespace Var (99f6224) Message-ID: <20140820084837.9B28D24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/99f6224aef23750eba29e6f312710bd419494be2/ghc >--------------------------------------------------------------- commit 99f6224aef23750eba29e6f312710bd419494be2 Author: Austin Seipp Date: Wed Aug 20 03:44:52 2014 -0500 basicTypes: detabify/dewhitespace Var Signed-off-by: Austin Seipp >--------------------------------------------------------------- 99f6224aef23750eba29e6f312710bd419494be2 compiler/basicTypes/Var.lhs | 161 +++++++++++++++++++++----------------------- 1 file changed, 77 insertions(+), 84 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 99f6224aef23750eba29e6f312710bd419494be2 From git at git.haskell.org Wed Aug 20 12:23:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 12:23:23 +0000 (UTC) Subject: [commit: ghc] master: genprimopcode: Don't output tabs (a2d2546) Message-ID: <20140820122323.8E72424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a2d25464bc79102bd81b7889cec9bf534c1c8864/ghc >--------------------------------------------------------------- commit a2d25464bc79102bd81b7889cec9bf534c1c8864 Author: Austin Seipp Date: Wed Aug 20 07:12:01 2014 -0500 genprimopcode: Don't output tabs Otherwise the build breaks, because its output is included in tab-free files. See ef9dd9f. Signed-off-by: Austin Seipp >--------------------------------------------------------------- a2d25464bc79102bd81b7889cec9bf534c1c8864 utils/genprimopcode/Main.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 7fe375a..bb40917 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -242,7 +242,7 @@ gen_hs_source (Info defaults entries) = ++ "-----------------------------------------------------------------------------\n" ++ "{-# LANGUAGE MagicHash, MultiParamTypeClasses, NoImplicitPrelude, UnboxedTuples #-}\n" ++ "module GHC.Prim (\n" - ++ unlines (map (("\t" ++) . hdr) entries') + ++ unlines (map ((" " ++) . hdr) entries') ++ ") where\n" ++ "\n" ++ "{-\n" @@ -735,7 +735,7 @@ gen_primop_vector_tys_exports (Info _ entries) mkVecTypes :: Entry -> String mkVecTypes i = - "\t" ++ ty_id ++ ", " ++ tycon_id ++ "," + " " ++ ty_id ++ ", " ++ tycon_id ++ "," where ty_id = prefix i ++ "PrimTy" tycon_id = prefix i ++ "PrimTyCon" From git at git.haskell.org Wed Aug 20 14:42:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 14:42:28 +0000 (UTC) Subject: [commit: ghc] master: Update a comment in base cbits (067bb0d) Message-ID: <20140820144228.17AEA24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/067bb0d1183573504aa10ac2132c37aa0dac4aa6/ghc >--------------------------------------------------------------- commit 067bb0d1183573504aa10ac2132c37aa0dac4aa6 Author: Reid Barton Date: Wed Aug 20 10:42:10 2014 -0400 Update a comment in base cbits >--------------------------------------------------------------- 067bb0d1183573504aa10ac2132c37aa0dac4aa6 libraries/base/cbits/PrelIOUtils.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/cbits/PrelIOUtils.c b/libraries/base/cbits/PrelIOUtils.c index 9e05f08..415e6b7 100644 --- a/libraries/base/cbits/PrelIOUtils.c +++ b/libraries/base/cbits/PrelIOUtils.c @@ -1,7 +1,7 @@ /* * (c) The University of Glasgow 2002 * - * static versions of the inline functions in HsCore.h + * static versions of the inline functions in HsBase.h */ #define INLINE From git at git.haskell.org Wed Aug 20 16:31:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 16:31:08 +0000 (UTC) Subject: [commit: ghc] master: Add a missing newline to a GHCi linker debugBelch (92bb7be) Message-ID: <20140820163108.0B01424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/92bb7bec0ca3bdcb1a32afb7e460fe2af5afa37c/ghc >--------------------------------------------------------------- commit 92bb7bec0ca3bdcb1a32afb7e460fe2af5afa37c Author: Reid Barton Date: Wed Aug 20 12:17:16 2014 -0400 Add a missing newline to a GHCi linker debugBelch >--------------------------------------------------------------- 92bb7bec0ca3bdcb1a32afb7e460fe2af5afa37c rts/Linker.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/Linker.c b/rts/Linker.c index 1f716e3..76cfa8c 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -5643,7 +5643,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol); return 0; } - IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S )); + IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S )); } IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n", From git at git.haskell.org Wed Aug 20 17:31:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:15 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace Ticky.c (ff4f844) Message-ID: <20140820173115.E359524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ff4f8448ca844751702482b33ea71f9c4026b6c7/ghc >--------------------------------------------------------------- commit ff4f8448ca844751702482b33ea71f9c4026b6c7 Author: Austin Seipp Date: Wed Aug 20 12:13:45 2014 -0500 rts: detabify/dewhitespace Ticky.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- ff4f8448ca844751702482b33ea71f9c4026b6c7 rts/Ticky.c | 172 ++++++++++++++++++++++++++++++------------------------------ 1 file changed, 86 insertions(+), 86 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ff4f8448ca844751702482b33ea71f9c4026b6c7 From git at git.haskell.org Wed Aug 20 17:31:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:18 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace Weak.c (b4c7bcd) Message-ID: <20140820173118.4BD7F24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b4c7bcd5f65809851bd5e4085206ae1f7f27aa5c/ghc >--------------------------------------------------------------- commit b4c7bcd5f65809851bd5e4085206ae1f7f27aa5c Author: Austin Seipp Date: Wed Aug 20 12:14:33 2014 -0500 rts: detabify/dewhitespace Weak.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- b4c7bcd5f65809851bd5e4085206ae1f7f27aa5c rts/Weak.c | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/rts/Weak.c b/rts/Weak.c index 5ee38cc..62d4c92 100644 --- a/rts/Weak.c +++ b/rts/Weak.c @@ -43,7 +43,7 @@ runAllCFinalizers(StgWeak *list) } for (w = list; w; w = w->link) { - runCFinalizers((StgCFinalizerList *)w->cfinalizers); + runCFinalizers((StgCFinalizerList *)w->cfinalizers); } if (task != NULL) { @@ -84,26 +84,26 @@ scheduleFinalizers(Capability *cap, StgWeak *list) // count number of finalizers, and kill all the weak pointers first... n = 0; for (w = list; w; w = w->link) { - // Better not be a DEAD_WEAK at this stage; the garbage - // collector removes DEAD_WEAKs from the weak pointer list. - ASSERT(w->header.info != &stg_DEAD_WEAK_info); + // Better not be a DEAD_WEAK at this stage; the garbage + // collector removes DEAD_WEAKs from the weak pointer list. + ASSERT(w->header.info != &stg_DEAD_WEAK_info); - if (w->finalizer != &stg_NO_FINALIZER_closure) { - n++; - } + if (w->finalizer != &stg_NO_FINALIZER_closure) { + n++; + } - runCFinalizers((StgCFinalizerList *)w->cfinalizers); + runCFinalizers((StgCFinalizerList *)w->cfinalizers); #ifdef PROFILING // A weak pointer is inherently used, so we do not need to call // LDV_recordDead(). - // + // // Furthermore, when PROFILING is turned on, dead weak // pointers are exactly as large as weak pointers, so there is // no need to fill the slop, either. See stg_DEAD_WEAK_info // in StgMiscClosures.hc. #endif - SET_HDR(w, &stg_DEAD_WEAK_info, w->header.prof.ccs); + SET_HDR(w, &stg_DEAD_WEAK_info, w->header.prof.ccs); } if (task != NULL) { @@ -124,10 +124,10 @@ scheduleFinalizers(Capability *cap, StgWeak *list) n = 0; for (w = list; w; w = w->link) { - if (w->finalizer != &stg_NO_FINALIZER_closure) { - arr->payload[n] = w->finalizer; - n++; - } + if (w->finalizer != &stg_NO_FINALIZER_closure) { + arr->payload[n] = w->finalizer; + n++; + } } // set all the cards to 1 for (i = n; i < size; i++) { @@ -135,13 +135,13 @@ scheduleFinalizers(Capability *cap, StgWeak *list) } t = createIOThread(cap, - RtsFlags.GcFlags.initialStkSize, - rts_apply(cap, - rts_apply(cap, - (StgClosure *)runFinalizerBatch_closure, - rts_mkInt(cap,n)), - (StgClosure *)arr) - ); + RtsFlags.GcFlags.initialStkSize, + rts_apply(cap, + rts_apply(cap, + (StgClosure *)runFinalizerBatch_closure, + rts_mkInt(cap,n)), + (StgClosure *)arr) + ); scheduleThread(cap,t); } From git at git.haskell.org Wed Aug 20 17:31:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:21 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace Updates.h (dea58de) Message-ID: <20140820173121.7288024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dea58def866e012130536397d318edafffcf5861/ghc >--------------------------------------------------------------- commit dea58def866e012130536397d318edafffcf5861 Author: Austin Seipp Date: Wed Aug 20 12:15:15 2014 -0500 rts: detabify/dewhitespace Updates.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- dea58def866e012130536397d318edafffcf5861 rts/Updates.h | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/rts/Updates.h b/rts/Updates.h index 36280b5..c6ed283 100644 --- a/rts/Updates.h +++ b/rts/Updates.h @@ -42,21 +42,21 @@ #define updateWithIndirection(p1, p2, and_then) \ - W_ bd; \ - \ + W_ bd; \ + \ OVERWRITING_CLOSURE(p1); \ StgInd_indirectee(p1) = p2; \ prim_write_barrier; \ SET_INFO(p1, stg_BLACKHOLE_info); \ LDV_RECORD_CREATE(p1); \ - bd = Bdescr(p1); \ - if (bdescr_gen_no(bd) != 0 :: bits16) { \ + bd = Bdescr(p1); \ + if (bdescr_gen_no(bd) != 0 :: bits16) { \ recordMutableCap(p1, TO_W_(bdescr_gen_no(bd))); \ - TICK_UPD_OLD_IND(); \ - and_then; \ - } else { \ - TICK_UPD_NEW_IND(); \ - and_then; \ + TICK_UPD_OLD_IND(); \ + and_then; \ + } else { \ + TICK_UPD_NEW_IND(); \ + and_then; \ } #else /* !CMINUSMINUS */ From git at git.haskell.org Wed Aug 20 17:31:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:24 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace Timer.c (514a631) Message-ID: <20140820173124.D218D24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/514a6310281c1f810508115a41c25c02305f914e/ghc >--------------------------------------------------------------- commit 514a6310281c1f810508115a41c25c02305f914e Author: Austin Seipp Date: Wed Aug 20 12:15:58 2014 -0500 rts: detabify/dewhitespace Timer.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 514a6310281c1f810508115a41c25c02305f914e rts/Timer.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/Timer.c b/rts/Timer.c index c2c4caa..2a229a4 100644 --- a/rts/Timer.c +++ b/rts/Timer.c @@ -45,7 +45,7 @@ handle_tick(int unused STG_UNUSED) if (RtsFlags.ConcFlags.ctxtSwitchTicks > 0) { ticks_to_ctxt_switch--; if (ticks_to_ctxt_switch <= 0) { - ticks_to_ctxt_switch = RtsFlags.ConcFlags.ctxtSwitchTicks; + ticks_to_ctxt_switch = RtsFlags.ConcFlags.ctxtSwitchTicks; contextSwitchAllCapabilities(); /* schedule a context switch */ } } From git at git.haskell.org Wed Aug 20 17:31:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:27 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace Trace.c (43c68d6) Message-ID: <20140820173127.AD65824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/43c68d650457f81dc0e06956bb143e4d2b359d44/ghc >--------------------------------------------------------------- commit 43c68d650457f81dc0e06956bb143e4d2b359d44 Author: Austin Seipp Date: Wed Aug 20 12:16:09 2014 -0500 rts: detabify/dewhitespace Trace.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 43c68d650457f81dc0e06956bb143e4d2b359d44 rts/Trace.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/Trace.c b/rts/Trace.c index 4671919..b69c035 100644 --- a/rts/Trace.c +++ b/rts/Trace.c @@ -165,7 +165,7 @@ static void tracePreface (void) debugBelch("%12lx: ", (unsigned long)osThreadId()); #endif if (RtsFlags.TraceFlags.timestamp) { - debugBelch("%9" FMT_Word64 ": ", stat_getElapsedTime()); + debugBelch("%9" FMT_Word64 ": ", stat_getElapsedTime()); } } #endif From git at git.haskell.org Wed Aug 20 17:31:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:30 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace STM.c (221c231) Message-ID: <20140820173130.4FBC624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/221c2314e05a29595c3c198b18b6be3cae5370c9/ghc >--------------------------------------------------------------- commit 221c2314e05a29595c3c198b18b6be3cae5370c9 Author: Austin Seipp Date: Wed Aug 20 12:16:40 2014 -0500 rts: detabify/dewhitespace STM.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 221c2314e05a29595c3c198b18b6be3cae5370c9 rts/STM.c | 230 +++++++++++++++++++++++++++++++------------------------------- 1 file changed, 115 insertions(+), 115 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 221c2314e05a29595c3c198b18b6be3cae5370c9 From git at git.haskell.org Wed Aug 20 17:31:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:32 +0000 (UTC) Subject: [commit: ghc] master: rts: reflow some comments in STM.c (c49f2e7) Message-ID: <20140820173132.F2A2A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c49f2e7385933fd73afb8225a30a28a35c3afd29/ghc >--------------------------------------------------------------- commit c49f2e7385933fd73afb8225a30a28a35c3afd29 Author: Austin Seipp Date: Wed Aug 20 12:17:25 2014 -0500 rts: reflow some comments in STM.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- c49f2e7385933fd73afb8225a30a28a35c3afd29 rts/STM.c | 68 +++++++++++++++++++++++++++++++-------------------------------- 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/rts/STM.c b/rts/STM.c index 73c859c..449c488 100644 --- a/rts/STM.c +++ b/rts/STM.c @@ -6,32 +6,33 @@ * Overview * -------- * - * See the PPoPP 2005 paper "Composable memory transactions". In summary, - * each transaction has a TRec (transaction record) holding entries for each of the - * TVars (transactional variables) that it has accessed. Each entry records - * (a) the TVar, (b) the expected value seen in the TVar, (c) the new value that - * the transaction wants to write to the TVar, (d) during commit, the identity of + * See the PPoPP 2005 paper "Composable memory transactions". In summary, each + * transaction has a TRec (transaction record) holding entries for each of the + * TVars (transactional variables) that it has accessed. Each entry records (a) + * the TVar, (b) the expected value seen in the TVar, (c) the new value that the + * transaction wants to write to the TVar, (d) during commit, the identity of * the TRec that wrote the expected value. * - * Separate TRecs are used for each level in a nest of transactions. This allows - * a nested transaction to be aborted without condemning its enclosing transactions. - * This is needed in the implementation of catchRetry. Note that the "expected value" - * in a nested transaction's TRec is the value expected to be *held in memory* if - * the transaction commits -- not the "new value" stored in one of the enclosing - * transactions. This means that validation can be done without searching through - * a nest of TRecs. + * Separate TRecs are used for each level in a nest of transactions. This + * allows a nested transaction to be aborted without condemning its enclosing + * transactions. This is needed in the implementation of catchRetry. Note that + * the "expected value" in a nested transaction's TRec is the value expected to + * be *held in memory* if the transaction commits -- not the "new value" stored + * in one of the enclosing transactions. This means that validation can be done + * without searching through a nest of TRecs. * * Concurrency control * ------------------- * - * Three different concurrency control schemes can be built according to the settings - * in STM.h: + * Three different concurrency control schemes can be built according to the + * settings in STM.h: * - * STM_UNIPROC assumes that the caller serialises invocations on the STM interface. - * In the Haskell RTS this means it is suitable only for non-THREADED_RTS builds. + * STM_UNIPROC assumes that the caller serialises invocations on the STM + * interface. In the Haskell RTS this means it is suitable only for + * non-THREADED_RTS builds. * - * STM_CG_LOCK uses coarse-grained locking -- a single 'stm lock' is acquired during - * an invocation on the STM interface. Note that this does not mean that + * STM_CG_LOCK uses coarse-grained locking -- a single 'stm lock' is acquired + * during an invocation on the STM interface. Note that this does not mean that * transactions are simply serialized -- the lock is only held *within* the * implementation of stmCommitTransaction, stmWait etc. * @@ -52,11 +53,11 @@ * lock_stm & unlock_stm are straightforward : they acquire a simple spin-lock * using STM_CG_LOCK, and otherwise they are no-ops. * - * lock_tvar / cond_lock_tvar and unlock_tvar are more complex because they - * have other effects (present in STM_UNIPROC and STM_CG_LOCK builds) as well - * as the actual business of manipulating a lock (present only in STM_FG_LOCKS - * builds). This is because locking a TVar is implemented by writing the lock - * holder's TRec into the TVar's current_value field: + * lock_tvar / cond_lock_tvar and unlock_tvar are more complex because they have + * other effects (present in STM_UNIPROC and STM_CG_LOCK builds) as well as the + * actual business of manipulating a lock (present only in STM_FG_LOCKS builds). + * This is because locking a TVar is implemented by writing the lock holder's + * TRec into the TVar's current_value field: * * lock_tvar - lock a specified TVar (STM_FG_LOCKS only), returning the value * it contained. @@ -68,18 +69,17 @@ * unlock_tvar - release the lock on a specified TVar (STM_FG_LOCKS only), * storing a specified value in place of the lock entry. * - * Using these operations, the typical pattern of a commit/validate/wait operation - * is to (a) lock the STM, (b) lock all the TVars being updated, (c) check that - * the TVars that were only read from still contain their expected values, - * (d) release the locks on the TVars, writing updates to them in the case of a - * commit, (e) unlock the STM. + * Using these operations, the typical pattern of a commit/validate/wait + * operation is to (a) lock the STM, (b) lock all the TVars being updated, (c) + * check that the TVars that were only read from still contain their expected + * values, (d) release the locks on the TVars, writing updates to them in the + * case of a commit, (e) unlock the STM. * - * Queues of waiting threads hang off the first_watch_queue_entry - * field of each TVar. This may only be manipulated when holding that - * TVar's lock. In particular, when a thread is putting itself to - * sleep, it mustn't release the TVar's lock until it has added itself - * to the wait queue and marked its TSO as BlockedOnSTM -- this makes - * sure that other threads will know to wake it. + * Queues of waiting threads hang off the first_watch_queue_entry field of each + * TVar. This may only be manipulated when holding that TVar's lock. In + * particular, when a thread is putting itself to sleep, it mustn't release the + * TVar's lock until it has added itself to the wait queue and marked its TSO as + * BlockedOnSTM -- this makes sure that other threads will know to wake it. * * ---------------------------------------------------------------------------*/ From git at git.haskell.org Wed Aug 20 17:31:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:35 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace Task.c (4cbf966) Message-ID: <20140820173135.D5F0924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4cbf96680948de003e5da01cc053be6e672e2490/ghc >--------------------------------------------------------------- commit 4cbf96680948de003e5da01cc053be6e672e2490 Author: Austin Seipp Date: Wed Aug 20 12:17:50 2014 -0500 rts: detabify/dewhitespace Task.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 4cbf96680948de003e5da01cc053be6e672e2490 rts/Task.c | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/rts/Task.c b/rts/Task.c index 0421d8b..7e4c040 100644 --- a/rts/Task.c +++ b/rts/Task.c @@ -73,7 +73,7 @@ initTaskManager (void) tasksInitialized = 1; #if defined(THREADED_RTS) #if !defined(MYTASK_USE_TLV) - newThreadLocalKey(¤tTaskKey); + newThreadLocalKey(¤tTaskKey); #endif initMutex(&all_tasks_mutex); #endif @@ -497,20 +497,20 @@ printAllTasks(void) { Task *task; for (task = all_tasks; task != NULL; task = task->all_next) { - debugBelch("task %#" FMT_HexWord64 " is %s, ", serialisableTaskId(task), + debugBelch("task %#" FMT_HexWord64 " is %s, ", serialisableTaskId(task), task->stopped ? "stopped" : "alive"); - if (!task->stopped) { - if (task->cap) { - debugBelch("on capability %d, ", task->cap->no); - } - if (task->incall->tso) { - debugBelch("bound to thread %lu", + if (!task->stopped) { + if (task->cap) { + debugBelch("on capability %d, ", task->cap->no); + } + if (task->incall->tso) { + debugBelch("bound to thread %lu", (unsigned long)task->incall->tso->id); - } else { - debugBelch("worker"); - } - } - debugBelch("\n"); + } else { + debugBelch("worker"); + } + } + debugBelch("\n"); } } From git at git.haskell.org Wed Aug 20 17:31:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:38 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace sm/Storage.h (684be04) Message-ID: <20140820173138.7A64124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/684be04dfbde7e92fb49a5134bb36227152cd1f6/ghc >--------------------------------------------------------------- commit 684be04dfbde7e92fb49a5134bb36227152cd1f6 Author: Austin Seipp Date: Wed Aug 20 12:18:42 2014 -0500 rts: detabify/dewhitespace sm/Storage.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 684be04dfbde7e92fb49a5134bb36227152cd1f6 rts/sm/Storage.h | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/rts/sm/Storage.h b/rts/sm/Storage.h index c1a92ac..8218e3b 100644 --- a/rts/sm/Storage.h +++ b/rts/sm/Storage.h @@ -43,9 +43,9 @@ bdescr * splitLargeBlock (bdescr *bd, W_ blocks); Generational garbage collection support updateWithIndirection(p1,p2) Updates the object at p1 with an - indirection pointing to p2. This is - normally called for objects in an old - generation (>0) when they are updated. + indirection pointing to p2. This is + normally called for objects in an old + generation (>0) when they are updated. updateWithPermIndirection(p1,p2) As above but uses a permanent indir. From git at git.haskell.org Wed Aug 20 17:31:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:40 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace sm/BlockAlloc.c (f20708c) Message-ID: <20140820173140.D3C9A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f20708c29426310aab241b6794795429022ea464/ghc >--------------------------------------------------------------- commit f20708c29426310aab241b6794795429022ea464 Author: Austin Seipp Date: Wed Aug 20 12:19:20 2014 -0500 rts: detabify/dewhitespace sm/BlockAlloc.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- f20708c29426310aab241b6794795429022ea464 rts/sm/BlockAlloc.c | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/rts/sm/BlockAlloc.c b/rts/sm/BlockAlloc.c index 55310fd..681574b 100644 --- a/rts/sm/BlockAlloc.c +++ b/rts/sm/BlockAlloc.c @@ -329,7 +329,7 @@ alloc_mega_group (StgWord mblocks) else { void *mblock = getMBlocks(mblocks); - initMBlock(mblock); // only need to init the 1st one + initMBlock(mblock); // only need to init the 1st one bd = FIRST_BDESCR(mblock); } bd->blocks = MBLOCK_GROUP_BLOCKS(mblocks); @@ -382,18 +382,18 @@ allocGroup (W_ n) bd = alloc_mega_group(1); bd->blocks = n; - initGroup(bd); // we know the group will fit + initGroup(bd); // we know the group will fit rem = bd + n; rem->blocks = BLOCKS_PER_MBLOCK-n; initGroup(rem); // init the slop n_alloc_blocks += rem->blocks; - freeGroup(rem); // add the slop on to the free list + freeGroup(rem); // add the slop on to the free list goto finish; } bd = free_list[ln]; - if (bd->blocks == n) // exactly the right size! + if (bd->blocks == n) // exactly the right size! { dbl_link_remove(bd, &free_list[ln]); initGroup(bd); @@ -690,7 +690,7 @@ countBlocks(bdescr *bd) { W_ n; for (n=0; bd != NULL; bd=bd->link) { - n += bd->blocks; + n += bd->blocks; } return n; } @@ -705,12 +705,12 @@ countAllocdBlocks(bdescr *bd) { W_ n; for (n=0; bd != NULL; bd=bd->link) { - n += bd->blocks; - // hack for megablock groups: see (*1) above - if (bd->blocks > BLOCKS_PER_MBLOCK) { - n -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK) - * (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE)); - } + n += bd->blocks; + // hack for megablock groups: see (*1) above + if (bd->blocks > BLOCKS_PER_MBLOCK) { + n -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK) + * (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE)); + } } return n; } From git at git.haskell.org Wed Aug 20 17:31:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:43 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace sm/MarkWeak.c (2f3649e) Message-ID: <20140820173145.208F524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f3649e5f4f95fff26f7dbf81d2123db486a7134/ghc >--------------------------------------------------------------- commit 2f3649e5f4f95fff26f7dbf81d2123db486a7134 Author: Austin Seipp Date: Wed Aug 20 12:19:48 2014 -0500 rts: detabify/dewhitespace sm/MarkWeak.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2f3649e5f4f95fff26f7dbf81d2123db486a7134 rts/sm/MarkWeak.c | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Wed Aug 20 17:31:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:45 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace sm/GCAux.c (08093a9) Message-ID: <20140820173145.D3A2024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/08093a94cd4889f98803525ca99aa2b3af57b229/ghc >--------------------------------------------------------------- commit 08093a94cd4889f98803525ca99aa2b3af57b229 Author: Austin Seipp Date: Wed Aug 20 12:20:17 2014 -0500 rts: detabify/dewhitespace sm/GCAux.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 08093a94cd4889f98803525ca99aa2b3af57b229 rts/sm/GCAux.c | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/rts/sm/GCAux.c b/rts/sm/GCAux.c index 145ff63..48b18bc 100644 --- a/rts/sm/GCAux.c +++ b/rts/sm/GCAux.c @@ -54,7 +54,7 @@ isAlive(StgClosure *p) // for static closures with an empty SRT or CONSTR_STATIC_NOCAFs. // if (!HEAP_ALLOCED_GC(q)) { - return p; + return p; } // ignore closures in generations that we're not collecting. @@ -62,7 +62,7 @@ isAlive(StgClosure *p) // if it's a pointer into to-space, then we're done if (bd->flags & BF_EVACUATED) { - return p; + return p; } // large objects use the evacuated flag @@ -72,7 +72,7 @@ isAlive(StgClosure *p) // check the mark bit for compacted steps if ((bd->flags & BF_MARKED) && is_marked((P_)q,bd)) { - return p; + return p; } info = q->header.info; @@ -119,11 +119,11 @@ revertCAFs( void ) for (c = revertible_caf_list; c != (StgIndStatic *)END_OF_STATIC_LIST; - c = (StgIndStatic *)c->static_link) + c = (StgIndStatic *)c->static_link) { SET_INFO((StgClosure *)c, c->saved_info); - c->saved_info = NULL; - // could, but not necessary: c->static_link = NULL; + c->saved_info = NULL; + // could, but not necessary: c->static_link = NULL; } revertible_caf_list = (StgIndStatic*)END_OF_STATIC_LIST; } @@ -135,15 +135,15 @@ markCAFs (evac_fn evac, void *user) for (c = dyn_caf_list; c != (StgIndStatic*)END_OF_STATIC_LIST; - c = (StgIndStatic *)c->static_link) + c = (StgIndStatic *)c->static_link) { - evac(user, &c->indirectee); + evac(user, &c->indirectee); } for (c = revertible_caf_list; c != (StgIndStatic*)END_OF_STATIC_LIST; - c = (StgIndStatic *)c->static_link) + c = (StgIndStatic *)c->static_link) { - evac(user, &c->indirectee); + evac(user, &c->indirectee); } } From git at git.haskell.org Wed Aug 20 17:31:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:48 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace sm/GCUtils.h (7e60787) Message-ID: <20140820173150.577DE24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7e6078757e3f3b14874a940343b1322b4493bade/ghc >--------------------------------------------------------------- commit 7e6078757e3f3b14874a940343b1322b4493bade Author: Austin Seipp Date: Wed Aug 20 12:20:41 2014 -0500 rts: detabify/dewhitespace sm/GCUtils.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 7e6078757e3f3b14874a940343b1322b4493bade rts/sm/GCUtils.h | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/rts/sm/GCUtils.h b/rts/sm/GCUtils.h index de5aefc..19750b5 100644 --- a/rts/sm/GCUtils.h +++ b/rts/sm/GCUtils.h @@ -54,11 +54,11 @@ recordMutableGen_GC (StgClosure *p, nat gen_no) bd = gct->mut_lists[gen_no]; if (bd->free >= bd->start + BLOCK_SIZE_W) { - bdescr *new_bd; - new_bd = allocBlock_sync(); - new_bd->link = bd; - bd = new_bd; - gct->mut_lists[gen_no] = bd; + bdescr *new_bd; + new_bd = allocBlock_sync(); + new_bd->link = bd; + bd = new_bd; + gct->mut_lists[gen_no] = bd; } *bd->free++ = (StgWord)p; } From git at git.haskell.org Wed Aug 20 17:31:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:50 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace sm/GCUtils.c (7318aab) Message-ID: <20140820173150.AE8B724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7318aabb2a7cd0fa5f18203b775646329a298028/ghc >--------------------------------------------------------------- commit 7318aabb2a7cd0fa5f18203b775646329a298028 Author: Austin Seipp Date: Wed Aug 20 12:21:03 2014 -0500 rts: detabify/dewhitespace sm/GCUtils.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 7318aabb2a7cd0fa5f18203b775646329a298028 rts/sm/GCUtils.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/rts/sm/GCUtils.c b/rts/sm/GCUtils.c index 078da12..206ffa4 100644 --- a/rts/sm/GCUtils.c +++ b/rts/sm/GCUtils.c @@ -98,14 +98,14 @@ grab_local_todo_block (gen_workspace *ws) ws->todo_overflow = bd->link; bd->link = NULL; ws->n_todo_overflow--; - return bd; + return bd; } bd = popWSDeque(ws->todo_q); if (bd != NULL) { - ASSERT(bd->link == NULL); - return bd; + ASSERT(bd->link == NULL); + return bd; } return NULL; @@ -336,9 +336,9 @@ printMutableList(bdescr *bd) debugBelch("mutable list %p: ", bd); for (; bd != NULL; bd = bd->link) { - for (p = bd->start; p < bd->free; p++) { - debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p)); - } + for (p = bd->start; p < bd->free; p++) { + debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p)); + } } debugBelch("\n"); } From git at git.haskell.org Wed Aug 20 17:31:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:53 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace sm/MBlock.c (b7b427f) Message-ID: <20140820173153.BA2A324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b7b427fc872443168d7b98c3a0922fb28b646a87/ghc >--------------------------------------------------------------- commit b7b427fc872443168d7b98c3a0922fb28b646a87 Author: Austin Seipp Date: Wed Aug 20 12:21:10 2014 -0500 rts: detabify/dewhitespace sm/MBlock.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- b7b427fc872443168d7b98c3a0922fb28b646a87 rts/sm/MBlock.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/rts/sm/MBlock.c b/rts/sm/MBlock.c index 20b3015..2ed14ef 100644 --- a/rts/sm/MBlock.c +++ b/rts/sm/MBlock.c @@ -52,8 +52,8 @@ findMBlockMap(void *p) { if(mblock_maps[i]->addrHigh32 == hi) { - return mblock_maps[i]; - } + return mblock_maps[i]; + } } return NULL; } @@ -87,14 +87,14 @@ setHeapAlloced(void *p, StgWord8 i) MBlockMap *map = findMBlockMap(p); if(map == NULL) { - mblock_map_count++; - mblock_maps = stgReallocBytes(mblock_maps, + mblock_map_count++; + mblock_maps = stgReallocBytes(mblock_maps, sizeof(MBlockMap*) * mblock_map_count, "markHeapAlloced(1)"); - map = mblock_maps[mblock_map_count-1] = + map = mblock_maps[mblock_map_count-1] = stgMallocBytes(sizeof(MBlockMap),"markHeapAlloced(2)"); memset(map,0,sizeof(MBlockMap)); - map->addrHigh32 = (StgWord32) (((StgWord)p) >> 32); + map->addrHigh32 = (StgWord32) (((StgWord)p) >> 32); } map->lines[MBLOCK_MAP_LINE(p)] = i; From git at git.haskell.org Wed Aug 20 17:31:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:56 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace Apply.cmm (870cca8) Message-ID: <20140820173156.CF62124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/870cca8382f8c69d66eff54fe16cd4445e83dda6/ghc >--------------------------------------------------------------- commit 870cca8382f8c69d66eff54fe16cd4445e83dda6 Author: Austin Seipp Date: Wed Aug 20 12:22:24 2014 -0500 rts: detabify/dewhitespace Apply.cmm Signed-off-by: Austin Seipp >--------------------------------------------------------------- 870cca8382f8c69d66eff54fe16cd4445e83dda6 rts/Apply.cmm | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/rts/Apply.cmm b/rts/Apply.cmm index b89abea..9d18e95 100644 --- a/rts/Apply.cmm +++ b/rts/Apply.cmm @@ -105,13 +105,13 @@ for: /* DEBUGGING CODE, ensures that arity 1 and 2 functions are entered tagged if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 1 ) { if (GETTAG(R1)!=1) { - W_[0]=1; + W_[0]=1; } } if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 2 ) { if (GETTAG(R1)!=2) { - W_[0]=1; + W_[0]=1; } } */ @@ -133,9 +133,9 @@ for: jump StgFunInfoExtra_slow_apply(info) [R1]; } if (type == ARG_BCO) { - Sp_adj(-2); - Sp(1) = R1; - Sp(0) = stg_apply_interp_info; + Sp_adj(-2); + Sp(1) = R1; + Sp(0) = stg_apply_interp_info; jump stg_yield_to_interpreter []; } jump W_[stg_ap_stack_entries + @@ -209,9 +209,9 @@ for: jump StgFunInfoExtra_slow_apply(info) [R1]; } if (type == ARG_BCO) { - Sp_adj(-2); - Sp(1) = R1; - Sp(0) = stg_apply_interp_info; + Sp_adj(-2); + Sp(1) = R1; + Sp(0) = stg_apply_interp_info; jump stg_yield_to_interpreter []; } jump W_[stg_ap_stack_entries + @@ -278,9 +278,9 @@ for: jump StgFunInfoExtra_slow_apply(info) [R1]; } if (type == ARG_BCO) { - Sp_adj(-2); - Sp(1) = R1; - Sp(0) = stg_apply_interp_info; + Sp_adj(-2); + Sp(1) = R1; + Sp(0) = stg_apply_interp_info; jump stg_yield_to_interpreter []; } jump W_[stg_ap_stack_entries + From git at git.haskell.org Wed Aug 20 17:31:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:31:59 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace Hpc.c (93ec914) Message-ID: <20140820173159.615FF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/93ec914b14db06b111f2fb7cd0e7a0eece214684/ghc >--------------------------------------------------------------- commit 93ec914b14db06b111f2fb7cd0e7a0eece214684 Author: Austin Seipp Date: Wed Aug 20 12:22:48 2014 -0500 rts: detabify/dewhitespace Hpc.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 93ec914b14db06b111f2fb7cd0e7a0eece214684 rts/Hpc.c | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/rts/Hpc.c b/rts/Hpc.c index c4f43cd..ca3386d 100644 --- a/rts/Hpc.c +++ b/rts/Hpc.c @@ -32,11 +32,11 @@ * */ -static int hpc_inited = 0; // Have you started this component? -static pid_t hpc_pid = 0; // pid of this process at hpc-boot time. - // Only this pid will read or write .tix file(s). -static FILE *tixFile; // file being read/written -static int tix_ch; // current char +static int hpc_inited = 0; // Have you started this component? +static pid_t hpc_pid = 0; // pid of this process at hpc-boot time. + // Only this pid will read or write .tix file(s). +static FILE *tixFile; // file being read/written +static int tix_ch; // current char static HashTable * moduleHash = NULL; // module name -> HpcModuleInfo @@ -143,8 +143,8 @@ readTix(void) { tmpModule->tixArr[i] = expectWord64(); ws(); if (tix_ch == ',') { - expect(','); - ws(); + expect(','); + ws(); } } expect(']'); @@ -252,8 +252,8 @@ startupHpc(void) void hs_hpc_module(char *modName, - StgWord32 modCount, - StgWord32 modHashNo, + StgWord32 modCount, + StgWord32 modHashNo, StgWord64 *tixArr) { HpcModuleInfo *tmpModule; @@ -331,26 +331,26 @@ writeTix(FILE *f) { outer_comma = 1; } fprintf(f," TixModule \"%s\" %u %u [", - tmpModule->modName, - (nat)tmpModule->hashNo, - (nat)tmpModule->tickCount); + tmpModule->modName, + (nat)tmpModule->hashNo, + (nat)tmpModule->tickCount); debugTrace(DEBUG_hpc,"%s: %u (hash=%u)\n", - tmpModule->modName, - (nat)tmpModule->tickCount, + tmpModule->modName, + (nat)tmpModule->tickCount, (nat)tmpModule->hashNo); inner_comma = 0; for(i = 0;i < tmpModule->tickCount;i++) { if (inner_comma) { - fprintf(f,","); + fprintf(f,","); } else { - inner_comma = 1; + inner_comma = 1; } if (tmpModule->tixArr) { - fprintf(f,"%" FMT_Word64,tmpModule->tixArr[i]); + fprintf(f,"%" FMT_Word64,tmpModule->tixArr[i]); } else { - fprintf(f,"0"); + fprintf(f,"0"); } } fprintf(f,"]"); From git at git.haskell.org Wed Aug 20 17:32:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:32:01 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace Printer.h (219785b) Message-ID: <20140820173202.13BC924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/219785b5b47aa912a1b0c0514ea7c1c84739271e/ghc >--------------------------------------------------------------- commit 219785b5b47aa912a1b0c0514ea7c1c84739271e Author: Austin Seipp Date: Wed Aug 20 12:24:19 2014 -0500 rts: detabify/dewhitespace Printer.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 219785b5b47aa912a1b0c0514ea7c1c84739271e rts/Printer.h | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/rts/Printer.h b/rts/Printer.h index 2a35f7a..43ccfe9 100644 --- a/rts/Printer.h +++ b/rts/Printer.h @@ -11,19 +11,19 @@ #include "BeginPrivate.h" -extern void printPtr ( StgPtr p ); -extern void printObj ( StgClosure *obj ); +extern void printPtr ( StgPtr p ); +extern void printObj ( StgClosure *obj ); extern char * closure_type_names[]; -void info_hdr_type ( StgClosure *closure, char *res ); -char * info_type ( StgClosure *closure ); -char * info_type_by_ip ( StgInfoTable *ip ); +void info_hdr_type ( StgClosure *closure, char *res ); +char * info_type ( StgClosure *closure ); +char * info_type_by_ip ( StgInfoTable *ip ); char * info_update_frame ( StgClosure *closure ); #ifdef DEBUG extern void prettyPrintClosure (StgClosure *obj); -extern void printClosure ( StgClosure *obj ); +extern void printClosure ( StgClosure *obj ); extern StgPtr printStackObj ( StgPtr sp ); extern void printStackChunk ( StgPtr sp, StgPtr spLim ); extern void printTSO ( StgTSO *tso ); From git at git.haskell.org Wed Aug 20 17:32:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:32:04 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace Task.h (ee0e47d) Message-ID: <20140820173204.81DFF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ee0e47d7d74cdc347516a757a74e5349620bf44c/ghc >--------------------------------------------------------------- commit ee0e47d7d74cdc347516a757a74e5349620bf44c Author: Austin Seipp Date: Wed Aug 20 12:24:37 2014 -0500 rts: detabify/dewhitespace Task.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- ee0e47d7d74cdc347516a757a74e5349620bf44c rts/Task.h | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/rts/Task.h b/rts/Task.h index 7019499..82071c5 100644 --- a/rts/Task.h +++ b/rts/Task.h @@ -64,7 +64,7 @@ (a) waiting on the condition task->cond. The Task is either (1) a bound Task, the TSO will be on a queue somewhere - (2) a worker task, on the spare_workers queue of task->cap. + (2) a worker task, on the spare_workers queue of task->cap. (b) making a foreign call. The InCall will be on the suspended_ccalls list. @@ -74,7 +74,7 @@ (a) the task is currently blocked in yieldCapability(). This call will return when we have ownership of the Task and a Capability. The Capability we get might not be the same - as the one we had when we called yieldCapability(). + as the one we had when we called yieldCapability(). (b) we must call resumeThread(task), which will safely establish ownership of the Task and a Capability. @@ -86,7 +86,7 @@ typedef struct InCall_ { StgTSO * tso; // the bound TSO (or NULL for a worker) StgTSO * suspended_tso; // the TSO is stashed here when we - // make a foreign call (NULL otherwise); + // make a foreign call (NULL otherwise); Capability *suspended_cap; // The capability that the // suspended_tso is on, because @@ -113,10 +113,10 @@ typedef struct InCall_ { typedef struct Task_ { #if defined(THREADED_RTS) - OSThreadId id; // The OS Thread ID of this task + OSThreadId id; // The OS Thread ID of this task Condition cond; // used for sleeping & waking up this task - Mutex lock; // lock for the condition variable + Mutex lock; // lock for the condition variable // this flag tells the task whether it should wait on task->cond // or just continue immediately. It's a workaround for the fact From git at git.haskell.org Wed Aug 20 17:32:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:32:06 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace AutoApply.h (c71ab57) Message-ID: <20140820173206.F369424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c71ab572e85ecb0524344e93d96f1b4f42b92826/ghc >--------------------------------------------------------------- commit c71ab572e85ecb0524344e93d96f1b4f42b92826 Author: Austin Seipp Date: Wed Aug 20 12:25:24 2014 -0500 rts: detabify/dewhitespace AutoApply.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- c71ab572e85ecb0524344e93d96f1b4f42b92826 rts/AutoApply.h | 106 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 53 insertions(+), 53 deletions(-) diff --git a/rts/AutoApply.h b/rts/AutoApply.h index ee756be..7ad2d79 100644 --- a/rts/AutoApply.h +++ b/rts/AutoApply.h @@ -13,67 +13,67 @@ // ret addr and m arguments taking up n words are on the stack. // NB. x is a dummy argument attached to the 'for' label so that // BUILD_PAP can be used multiple times in the same function. -#define BUILD_PAP(m,n,f,x) \ - W_ pap; \ - W_ size; \ - W_ i; \ - size = SIZEOF_StgPAP + WDS(n); \ - HP_CHK_NP_ASSIGN_SP0(size,f); \ - TICK_ALLOC_PAP(size, 0); \ - CCCS_ALLOC(size); \ - pap = Hp + WDS(1) - size; \ +#define BUILD_PAP(m,n,f,x) \ + W_ pap; \ + W_ size; \ + W_ i; \ + size = SIZEOF_StgPAP + WDS(n); \ + HP_CHK_NP_ASSIGN_SP0(size,f); \ + TICK_ALLOC_PAP(size, 0); \ + CCCS_ALLOC(size); \ + pap = Hp + WDS(1) - size; \ SET_HDR(pap, stg_PAP_info, CCCS); \ - StgPAP_arity(pap) = HALF_W_(arity - m); \ - StgPAP_fun(pap) = R1; \ - StgPAP_n_args(pap) = HALF_W_(n); \ - i = 0; \ - for##x: \ - if (i < n) { \ - StgPAP_payload(pap,i) = Sp(1+i); \ - i = i + 1; \ - goto for##x; \ - } \ - R1 = pap; \ - Sp_adj(1 + n); \ + StgPAP_arity(pap) = HALF_W_(arity - m); \ + StgPAP_fun(pap) = R1; \ + StgPAP_n_args(pap) = HALF_W_(n); \ + i = 0; \ + for##x: \ + if (i < n) { \ + StgPAP_payload(pap,i) = Sp(1+i); \ + i = i + 1; \ + goto for##x; \ + } \ + R1 = pap; \ + Sp_adj(1 + n); \ jump %ENTRY_CODE(Sp(0)) [R1]; // Copy the old PAP, build a new one with the extra arg(s) // ret addr and m arguments taking up n words are on the stack. // NB. x is a dummy argument attached to the 'for' label so that // BUILD_PAP can be used multiple times in the same function. -#define NEW_PAP(m,n,f,x) \ - W_ pap; \ - W_ new_pap; \ - W_ size; \ - W_ i; \ - pap = R1; \ - size = SIZEOF_StgPAP + WDS(TO_W_(StgPAP_n_args(pap))) + WDS(n); \ - HP_CHK_NP_ASSIGN_SP0(size,f); \ - TICK_ALLOC_PAP(size, 0); \ - CCCS_ALLOC(size); \ - new_pap = Hp + WDS(1) - size; \ +#define NEW_PAP(m,n,f,x) \ + W_ pap; \ + W_ new_pap; \ + W_ size; \ + W_ i; \ + pap = R1; \ + size = SIZEOF_StgPAP + WDS(TO_W_(StgPAP_n_args(pap))) + WDS(n); \ + HP_CHK_NP_ASSIGN_SP0(size,f); \ + TICK_ALLOC_PAP(size, 0); \ + CCCS_ALLOC(size); \ + new_pap = Hp + WDS(1) - size; \ SET_HDR(new_pap, stg_PAP_info, CCCS); \ - StgPAP_arity(new_pap) = HALF_W_(arity - m); \ - W_ n_args; \ - n_args = TO_W_(StgPAP_n_args(pap)); \ - StgPAP_n_args(new_pap) = HALF_W_(n_args + n); \ - StgPAP_fun(new_pap) = StgPAP_fun(pap); \ - i = 0; \ - for1##x: \ - if (i < n_args) { \ - StgPAP_payload(new_pap,i) = StgPAP_payload(pap,i); \ - i = i + 1; \ - goto for1##x; \ - } \ - i = 0; \ - for2##x: \ - if (i < n) { \ - StgPAP_payload(new_pap,n_args+i) = Sp(1+i); \ - i = i + 1; \ - goto for2##x; \ - } \ - R1 = new_pap; \ - Sp_adj(n+1); \ + StgPAP_arity(new_pap) = HALF_W_(arity - m); \ + W_ n_args; \ + n_args = TO_W_(StgPAP_n_args(pap)); \ + StgPAP_n_args(new_pap) = HALF_W_(n_args + n); \ + StgPAP_fun(new_pap) = StgPAP_fun(pap); \ + i = 0; \ + for1##x: \ + if (i < n_args) { \ + StgPAP_payload(new_pap,i) = StgPAP_payload(pap,i); \ + i = i + 1; \ + goto for1##x; \ + } \ + i = 0; \ + for2##x: \ + if (i < n) { \ + StgPAP_payload(new_pap,n_args+i) = Sp(1+i); \ + i = i + 1; \ + goto for2##x; \ + } \ + R1 = new_pap; \ + Sp_adj(n+1); \ jump %ENTRY_CODE(Sp(0)) [R1]; // Jump to target, saving CCCS and restoring it on return From git at git.haskell.org Wed Aug 20 17:32:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:32:09 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace StgStdThunks.cmm (ef02edc) Message-ID: <20140820173211.01BF324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ef02edc1b05ef8f3ec2ebe4d7b4ecef93c9d0aa2/ghc >--------------------------------------------------------------- commit ef02edc1b05ef8f3ec2ebe4d7b4ecef93c9d0aa2 Author: Austin Seipp Date: Wed Aug 20 12:25:52 2014 -0500 rts: detabify/dewhitespace StgStdThunks.cmm Signed-off-by: Austin Seipp >--------------------------------------------------------------- ef02edc1b05ef8f3ec2ebe4d7b4ecef93c9d0aa2 rts/StgStdThunks.cmm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/StgStdThunks.cmm b/rts/StgStdThunks.cmm index ba15d3c..208c8d6 100644 --- a/rts/StgStdThunks.cmm +++ b/rts/StgStdThunks.cmm @@ -153,8 +153,8 @@ SELECTOR_CODE_NOUPD(15) An apply thunk is a thunk of the form - let z = [x1...xn] \u x1...xn - in ... + let z = [x1...xn] \u x1...xn + in ... We pre-compile some of these because the code is always the same. From git at git.haskell.org Wed Aug 20 17:32:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:32:12 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace StgStartup.cmm (1a6a610) Message-ID: <20140820173212.19EAF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1a6a6103f59619c94f2d2818874d1a738f8fac50/ghc >--------------------------------------------------------------- commit 1a6a6103f59619c94f2d2818874d1a738f8fac50 Author: Austin Seipp Date: Wed Aug 20 12:26:04 2014 -0500 rts: detabify/dewhitespace StgStartup.cmm Signed-off-by: Austin Seipp >--------------------------------------------------------------- 1a6a6103f59619c94f2d2818874d1a738f8fac50 rts/StgStartup.cmm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/rts/StgStartup.cmm b/rts/StgStartup.cmm index dcc0383..2a245b0 100644 --- a/rts/StgStartup.cmm +++ b/rts/StgStartup.cmm @@ -51,11 +51,11 @@ INFO_TABLE_RET(stg_stop_thread, STOP_FRAME, We Leave the stack looking like this: - +----------------+ + +----------------+ | -------------------> return value - +----------------+ - | stg_enter_info | - +----------------+ + +----------------+ + | stg_enter_info | + +----------------+ The stg_enter_info is just a dummy info table so that the garbage collector can understand the stack (there must always From git at git.haskell.org Wed Aug 20 17:32:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:32:14 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace StgPrimFloat.c (2f34ab2) Message-ID: <20140820173214.8774424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f34ab2a91d2356286c7e20ab786e04f30e43fe6/ghc >--------------------------------------------------------------- commit 2f34ab2a91d2356286c7e20ab786e04f30e43fe6 Author: Austin Seipp Date: Wed Aug 20 12:26:29 2014 -0500 rts: detabify/dewhitespace StgPrimFloat.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2f34ab2a91d2356286c7e20ab786e04f30e43fe6 rts/StgPrimFloat.c | 96 +++++++++++++++++++++++++++--------------------------- 1 file changed, 48 insertions(+), 48 deletions(-) diff --git a/rts/StgPrimFloat.c b/rts/StgPrimFloat.c index 63fe52e..123e77b 100644 --- a/rts/StgPrimFloat.c +++ b/rts/StgPrimFloat.c @@ -41,7 +41,7 @@ #define H 1 #endif -#define __abs(a) (( (a) >= 0 ) ? (a) : (-(a))) +#define __abs(a) (( (a) >= 0 ) ? (a) : (-(a))) /* Special version for words */ StgDouble @@ -117,44 +117,44 @@ void __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble dbl) { /* Do some bit fiddling on IEEE */ - unsigned int low, high; /* assuming 32 bit ints */ + unsigned int low, high; /* assuming 32 bit ints */ int sign, iexp; - union { double d; unsigned int i[2]; } u; /* assuming 32 bit ints, 64 bit double */ + union { double d; unsigned int i[2]; } u; /* assuming 32 bit ints, 64 bit double */ ASSERT(sizeof(unsigned int ) == 4 ); ASSERT(sizeof(dbl ) == 8 ); ASSERT(sizeof(dbl ) == SIZEOF_DOUBLE); - u.d = dbl; /* grab chunks of the double */ + u.d = dbl; /* grab chunks of the double */ low = u.i[L]; high = u.i[H]; if (low == 0 && (high & ~DMSBIT) == 0) { - *man_low = 0; - *man_high = 0; - *exp = 0L; + *man_low = 0; + *man_high = 0; + *exp = 0L; } else { - iexp = ((high >> 20) & 0x7ff) + MY_DMINEXP; - sign = high; - - high &= DHIGHBIT-1; - if (iexp != MY_DMINEXP) /* don't add hidden bit to denorms */ - high |= DHIGHBIT; - else { - iexp++; - /* A denorm, normalize the mantissa */ - while (! (high & DHIGHBIT)) { - high <<= 1; - if (low & DMSBIT) - high++; - low <<= 1; - iexp--; - } - } + iexp = ((high >> 20) & 0x7ff) + MY_DMINEXP; + sign = high; + + high &= DHIGHBIT-1; + if (iexp != MY_DMINEXP) /* don't add hidden bit to denorms */ + high |= DHIGHBIT; + else { + iexp++; + /* A denorm, normalize the mantissa */ + while (! (high & DHIGHBIT)) { + high <<= 1; + if (low & DMSBIT) + high++; + low <<= 1; + iexp--; + } + } *exp = (I_) iexp; - *man_low = low; - *man_high = high; - *man_sign = (sign < 0) ? -1 : 1; + *man_low = low; + *man_high = high; + *man_sign = (sign < 0) ? -1 : 1; } } @@ -166,37 +166,37 @@ void __decodeFloat_Int (I_ *man, I_ *exp, StgFloat flt) { /* Do some bit fiddling on IEEE */ - int high, sign; /* assuming 32 bit ints */ + int high, sign; /* assuming 32 bit ints */ union { float f; int i; } u; /* assuming 32 bit float and int */ ASSERT(sizeof(int ) == 4 ); ASSERT(sizeof(flt ) == 4 ); ASSERT(sizeof(flt ) == SIZEOF_FLOAT ); - u.f = flt; /* grab the float */ + u.f = flt; /* grab the float */ high = u.i; if ((high & ~FMSBIT) == 0) { - *man = 0; - *exp = 0; + *man = 0; + *exp = 0; } else { - *exp = ((high >> 23) & 0xff) + MY_FMINEXP; - sign = high; - - high &= FHIGHBIT-1; - if (*exp != MY_FMINEXP) /* don't add hidden bit to denorms */ - high |= FHIGHBIT; - else { - (*exp)++; - /* A denorm, normalize the mantissa */ - while (! (high & FHIGHBIT)) { - high <<= 1; - (*exp)--; - } - } - *man = high; - if (sign < 0) - *man = - *man; + *exp = ((high >> 23) & 0xff) + MY_FMINEXP; + sign = high; + + high &= FHIGHBIT-1; + if (*exp != MY_FMINEXP) /* don't add hidden bit to denorms */ + high |= FHIGHBIT; + else { + (*exp)++; + /* A denorm, normalize the mantissa */ + while (! (high & FHIGHBIT)) { + high <<= 1; + (*exp)--; + } + } + *man = high; + if (sign < 0) + *man = - *man; } } From git at git.haskell.org Wed Aug 20 17:32:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:32:16 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace StgPrimFloat.h (584d459) Message-ID: <20140820173217.0B97324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/584d459a2fa1e836ace6e8c5f77debe894d9b549/ghc >--------------------------------------------------------------- commit 584d459a2fa1e836ace6e8c5f77debe894d9b549 Author: Austin Seipp Date: Wed Aug 20 12:26:37 2014 -0500 rts: detabify/dewhitespace StgPrimFloat.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 584d459a2fa1e836ace6e8c5f77debe894d9b549 rts/StgPrimFloat.h | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Wed Aug 20 17:32:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:32:19 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace Sparks.c (7d48356) Message-ID: <20140820173219.713BE24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7d4835603ef2e1f2c65e4c0f4c664fca50d74591/ghc >--------------------------------------------------------------- commit 7d4835603ef2e1f2c65e4c0f4c664fca50d74591 Author: Austin Seipp Date: Wed Aug 20 12:26:59 2014 -0500 rts: detabify/dewhitespace Sparks.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 7d4835603ef2e1f2c65e4c0f4c664fca50d74591 rts/Sparks.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/rts/Sparks.c b/rts/Sparks.c index d54a1f1..14b70c5 100644 --- a/rts/Sparks.c +++ b/rts/Sparks.c @@ -67,7 +67,7 @@ newSpark (StgRegTable *reg, StgClosure *p) /* overflowing the spark pool */ cap->spark_stats.overflowed++; traceEventSparkOverflow(cap); - } + } } else { cap->spark_stats.dud++; traceEventSparkDud(cap); @@ -158,11 +158,11 @@ pruneSparkQueue (Capability *cap) while (currInd != oldBotInd ) { /* must use != here, wrap-around at size - subtle: loop not entered if queue empty + subtle: loop not entered if queue empty */ /* check element at currInd. if valuable, evacuate and move to - botInd, otherwise move on */ + botInd, otherwise move on */ spark = elements[currInd]; // We have to be careful here: in the parallel GC, another From git at git.haskell.org Wed Aug 20 17:32:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:32:21 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace RtsMain.c (8f3611e) Message-ID: <20140820173221.C495A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8f3611ef222caf3bc2da4c7b3a1ca6e857e0bcee/ghc >--------------------------------------------------------------- commit 8f3611ef222caf3bc2da4c7b3a1ca6e857e0bcee Author: Austin Seipp Date: Wed Aug 20 12:27:18 2014 -0500 rts: detabify/dewhitespace RtsMain.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 8f3611ef222caf3bc2da4c7b3a1ca6e857e0bcee rts/RtsMain.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/RtsMain.c b/rts/RtsMain.c index ea45d6f..fd5dd25 100644 --- a/rts/RtsMain.c +++ b/rts/RtsMain.c @@ -59,9 +59,9 @@ static void real_main(void) /* ToDo: want to start with a larger stack size */ { - Capability *cap = rts_lock(); + Capability *cap = rts_lock(); rts_evalLazyIO(&cap,progmain_closure, NULL); - status = rts_getSchedStatus(cap); + status = rts_getSchedStatus(cap); rts_unlock(cap); } From git at git.haskell.org Wed Aug 20 17:32:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:32:24 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace RtsAPI.c (b9ee7e8) Message-ID: <20140820173224.62E5E24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b9ee7e8af95e7eda306b5bbff7370c8e1438c1e4/ghc >--------------------------------------------------------------- commit b9ee7e8af95e7eda306b5bbff7370c8e1438c1e4 Author: Austin Seipp Date: Wed Aug 20 12:27:28 2014 -0500 rts: detabify/dewhitespace RtsAPI.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- b9ee7e8af95e7eda306b5bbff7370c8e1438c1e4 rts/RtsAPI.c | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c index 7062306..1672253 100644 --- a/rts/RtsAPI.c +++ b/rts/RtsAPI.c @@ -367,9 +367,9 @@ rts_getBool (HaskellObj p) info = get_itbl((StgClosure *)UNTAG_CLOSURE(p)); if (info->srt_bitmap == 0) { // srt_bitmap is the constructor tag - return 0; + return 0; } else { - return 1; + return 1; } } @@ -482,8 +482,8 @@ void rts_evalStableIO (/* inout */ Capability **cap, stat = rts_getSchedStatus(*cap); if (stat == Success && ret != NULL) { - ASSERT(r != NULL); - *ret = getStablePtr((StgPtr)r); + ASSERT(r != NULL); + *ret = getStablePtr((StgPtr)r); } } @@ -519,12 +519,12 @@ rts_checkSchedStatus (char* site, Capability *cap) SchedulerStatus rc = cap->running_task->incall->stat; switch (rc) { case Success: - return; + return; case Killed: - errorBelch("%s: uncaught exception",site); - stg_exit(EXIT_FAILURE); + errorBelch("%s: uncaught exception",site); + stg_exit(EXIT_FAILURE); case Interrupted: - errorBelch("%s: interrupted", site); + errorBelch("%s: interrupted", site); #ifdef THREADED_RTS // The RTS is shutting down, and the process will probably // soon exit. We don't want to preempt the shutdown @@ -536,8 +536,8 @@ rts_checkSchedStatus (char* site, Capability *cap) stg_exit(EXIT_FAILURE); #endif default: - errorBelch("%s: Return code (%d) not ok",(site),(rc)); - stg_exit(EXIT_FAILURE); + errorBelch("%s: Return code (%d) not ok",(site),(rc)); + stg_exit(EXIT_FAILURE); } } From git at git.haskell.org Wed Aug 20 17:32:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:32:27 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace RtsStartup.c (00878c5) Message-ID: <20140820173227.3012024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/00878c53dd3a15f7903872b963c8c80cb030f792/ghc >--------------------------------------------------------------- commit 00878c53dd3a15f7903872b963c8c80cb030f792 Author: Austin Seipp Date: Wed Aug 20 12:27:39 2014 -0500 rts: detabify/dewhitespace RtsStartup.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 00878c53dd3a15f7903872b963c8c80cb030f792 rts/RtsStartup.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index 36ac269..9a3925f 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -26,7 +26,7 @@ #include "Weak.h" #include "Ticky.h" #include "StgRun.h" -#include "Prelude.h" /* fixupRTStoPreludeRefs */ +#include "Prelude.h" /* fixupRTStoPreludeRefs */ #include "ThreadLabels.h" #include "sm/BlockAlloc.h" #include "Trace.h" @@ -36,7 +36,7 @@ #include "Timer.h" #include "Globals.h" #include "FileLock.h" -void exitLinker( void ); // there is no Linker.h file to include +void exitLinker( void ); // there is no Linker.h file to include #if defined(PROFILING) # include "ProfHeap.h" @@ -124,8 +124,8 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) { hs_init_count++; if (hs_init_count > 1) { - // second and subsequent inits are ignored - return; + // second and subsequent inits are ignored + return; } setlocale(LC_CTYPE,""); @@ -308,13 +308,13 @@ hs_exit_(rtsBool wait_foreign) nat g, i; if (hs_init_count <= 0) { - errorBelch("warning: too many hs_exit()s"); - return; + errorBelch("warning: too many hs_exit()s"); + return; } hs_init_count--; if (hs_init_count > 0) { - // ignore until it's the last one - return; + // ignore until it's the last one + return; } /* start timing the shutdown */ From git at git.haskell.org Wed Aug 20 17:32:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:32:29 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace RtsUtils.c (646f214) Message-ID: <20140820173229.B1EDF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/646f214ab3420372b2584741e98c3dc8fe350694/ghc >--------------------------------------------------------------- commit 646f214ab3420372b2584741e98c3dc8fe350694 Author: Austin Seipp Date: Wed Aug 20 12:28:01 2014 -0500 rts: detabify/dewhitespace RtsUtils.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 646f214ab3420372b2584741e98c3dc8fe350694 rts/RtsUtils.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c index 811dcf1..aff82af 100644 --- a/rts/RtsUtils.c +++ b/rts/RtsUtils.c @@ -147,14 +147,14 @@ time_str(void) static char nowstr[26]; if (now == 0) { - time(&now); + time(&now); #if HAVE_CTIME_R - ctime_r(&now, nowstr); + ctime_r(&now, nowstr); #else - strcpy(nowstr, ctime(&now)); + strcpy(nowstr, ctime(&now)); #endif - memmove(nowstr+16,nowstr+19,7); - nowstr[21] = '\0'; // removes the \n + memmove(nowstr+16,nowstr+19,7); + nowstr[21] = '\0'; // removes the \n } return nowstr; } From git at git.haskell.org Wed Aug 20 17:32:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:32:32 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace Disassembler.c (f2864e9) Message-ID: <20140820173232.3C1B724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f2864e9621b7f35b6524545799da429a6b422143/ghc >--------------------------------------------------------------- commit f2864e9621b7f35b6524545799da429a6b422143 Author: Austin Seipp Date: Wed Aug 20 12:29:22 2014 -0500 rts: detabify/dewhitespace Disassembler.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- f2864e9621b7f35b6524545799da429a6b422143 rts/Disassembler.c | 60 +++++++++++++++++++++++++++--------------------------- 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/rts/Disassembler.c b/rts/Disassembler.c index 36cd7b5..b84e43f 100644 --- a/rts/Disassembler.c +++ b/rts/Disassembler.c @@ -134,38 +134,38 @@ disInstr ( StgBCO *bco, int pc ) debugBelch("\n"); pc += 2; break; case bci_PUSH_APPLY_N: - debugBelch("PUSH_APPLY_N\n"); - break; + debugBelch("PUSH_APPLY_N\n"); + break; case bci_PUSH_APPLY_V: - debugBelch("PUSH_APPLY_V\n"); - break; + debugBelch("PUSH_APPLY_V\n"); + break; case bci_PUSH_APPLY_F: - debugBelch("PUSH_APPLY_F\n"); - break; + debugBelch("PUSH_APPLY_F\n"); + break; case bci_PUSH_APPLY_D: - debugBelch("PUSH_APPLY_D\n"); - break; + debugBelch("PUSH_APPLY_D\n"); + break; case bci_PUSH_APPLY_L: - debugBelch("PUSH_APPLY_L\n"); - break; + debugBelch("PUSH_APPLY_L\n"); + break; case bci_PUSH_APPLY_P: - debugBelch("PUSH_APPLY_P\n"); - break; + debugBelch("PUSH_APPLY_P\n"); + break; case bci_PUSH_APPLY_PP: - debugBelch("PUSH_APPLY_PP\n"); - break; + debugBelch("PUSH_APPLY_PP\n"); + break; case bci_PUSH_APPLY_PPP: - debugBelch("PUSH_APPLY_PPP\n"); - break; + debugBelch("PUSH_APPLY_PPP\n"); + break; case bci_PUSH_APPLY_PPPP: - debugBelch("PUSH_APPLY_PPPP\n"); - break; + debugBelch("PUSH_APPLY_PPPP\n"); + break; case bci_PUSH_APPLY_PPPPP: - debugBelch("PUSH_APPLY_PPPPP\n"); - break; + debugBelch("PUSH_APPLY_PPPPP\n"); + break; case bci_PUSH_APPLY_PPPPPP: - debugBelch("PUSH_APPLY_PPPPPP\n"); - break; + debugBelch("PUSH_APPLY_PPPPPP\n"); + break; case bci_SLIDE: debugBelch("SLIDE %d down by %d\n", instrs[pc], instrs[pc+1] ); pc += 2; break; @@ -177,7 +177,7 @@ disInstr ( StgBCO *bco, int pc ) pc += 1; break; case bci_ALLOC_PAP: debugBelch("ALLOC_PAP %d arity, %d words\n", - instrs[pc], instrs[pc+1] ); + instrs[pc], instrs[pc+1] ); pc += 2; break; case bci_MKAP: debugBelch("MKAP %d words, %d stkoff\n", instrs[pc+1], @@ -246,25 +246,25 @@ disInstr ( StgBCO *bco, int pc ) case bci_RETURN: debugBelch("RETURN\n" ); - break; + break; case bci_RETURN_P: debugBelch("RETURN_P\n" ); - break; + break; case bci_RETURN_N: debugBelch("RETURN_N\n" ); - break; + break; case bci_RETURN_F: debugBelch("RETURN_F\n" ); - break; + break; case bci_RETURN_D: debugBelch("RETURN_D\n" ); - break; + break; case bci_RETURN_L: debugBelch("RETURN_L\n" ); - break; + break; case bci_RETURN_V: debugBelch("RETURN_V\n" ); - break; + break; default: barf("disInstr: unknown opcode %u", (unsigned int) instr); From git at git.haskell.org Wed Aug 20 17:32:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:32:35 +0000 (UTC) Subject: [commit: ghc] master: rts: detabify/dewhitespace LdvProfile.c (7200edf) Message-ID: <20140820173235.5688624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7200edff2b1786fccc766c9ce51461e339563fbe/ghc >--------------------------------------------------------------- commit 7200edff2b1786fccc766c9ce51461e339563fbe Author: Austin Seipp Date: Wed Aug 20 12:30:49 2014 -0500 rts: detabify/dewhitespace LdvProfile.c Signed-off-by: Austin Seipp >--------------------------------------------------------------- 7200edff2b1786fccc766c9ce51461e339563fbe rts/LdvProfile.c | 92 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 46 insertions(+), 46 deletions(-) diff --git a/rts/LdvProfile.c b/rts/LdvProfile.c index 677263e..3b56149 100644 --- a/rts/LdvProfile.c +++ b/rts/LdvProfile.c @@ -37,10 +37,10 @@ processHeapClosureForDead( StgClosure *c ) info = c->header.info; if (IS_FORWARDING_PTR(info)) { - // The size of the evacuated closure is currently stored in - // the LDV field. See SET_EVACUAEE_FOR_LDV() in - // includes/StgLdvProf.h. - return LDVW(c); + // The size of the evacuated closure is currently stored in + // the LDV field. See SET_EVACUAEE_FOR_LDV() in + // includes/StgLdvProf.h. + return LDVW(c); } info = INFO_PTR_TO_STRUCT(info); @@ -56,9 +56,9 @@ processHeapClosureForDead( StgClosure *c ) size = closure_sizeW(c); switch (info->type) { - /* - 'inherently used' cases: do nothing. - */ + /* + 'inherently used' cases: do nothing. + */ case TSO: case STACK: case MVAR_CLEAN: @@ -80,11 +80,11 @@ processHeapClosureForDead( StgClosure *c ) case PRIM: case MUT_PRIM: case TREC_CHUNK: - return size; + return size; - /* - ordinary cases: call LDV_recordDead(). - */ + /* + ordinary cases: call LDV_recordDead(). + */ case THUNK: case THUNK_1_0: case THUNK_0_1: @@ -110,30 +110,30 @@ processHeapClosureForDead( StgClosure *c ) case BLACKHOLE: case BLOCKING_QUEUE: case IND_PERM: - /* - 'Ingore' cases - */ - // Why can we ignore IND closures? We assume that - // any census is preceded by a major garbage collection, which - // IND closures cannot survive. Therefore, it is no - // use considering IND closures in the meanwhile - // because they will perish before the next census at any - // rate. + /* + 'Ingore' cases + */ + // Why can we ignore IND closures? We assume that + // any census is preceded by a major garbage collection, which + // IND closures cannot survive. Therefore, it is no + // use considering IND closures in the meanwhile + // because they will perish before the next census at any + // rate. case IND: - // Found a dead closure: record its size - LDV_recordDead(c, size); - return size; + // Found a dead closure: record its size + LDV_recordDead(c, size); + return size; - /* - Error case - */ - // static objects + /* + Error case + */ + // static objects case IND_STATIC: case CONSTR_STATIC: case FUN_STATIC: case THUNK_STATIC: case CONSTR_NOCAF_STATIC: - // stack objects + // stack objects case UPDATE_FRAME: case CATCH_FRAME: case UNDERFLOW_FRAME: @@ -141,11 +141,11 @@ processHeapClosureForDead( StgClosure *c ) case RET_BCO: case RET_SMALL: case RET_BIG: - // others + // others case INVALID_OBJECT: default: - barf("Invalid object in processHeapClosureForDead(): %d", info->type); - return 0; + barf("Invalid object in processHeapClosureForDead(): %d", info->type); + return 0; } } @@ -159,14 +159,14 @@ processHeapForDead( bdescr *bd ) StgPtr p; while (bd != NULL) { - p = bd->start; - while (p < bd->free) { - p += processHeapClosureForDead((StgClosure *)p); - while (p < bd->free && !*p) // skip slop - p++; - } - ASSERT(p == bd->free); - bd = bd->link; + p = bd->start; + while (p < bd->free) { + p += processHeapClosureForDead((StgClosure *)p); + while (p < bd->free && !*p) // skip slop + p++; + } + ASSERT(p == bd->free); + bd = bd->link; } } @@ -201,7 +201,7 @@ processChainForDead( bdescr *bd ) if (!(bd->flags & BF_PINNED)) { processHeapClosureForDead((StgClosure *)bd->start); } - bd = bd->link; + bd = bd->link; } } @@ -220,16 +220,16 @@ LdvCensusForDead( nat N ) // ldvTime == 0 means that LDV profiling is currently turned off. if (era == 0) - return; + return; if (RtsFlags.GcFlags.generations == 1) { - // - // Todo: support LDV for two-space garbage collection. - // - barf("Lag/Drag/Void profiling not supported with -G1"); + // + // Todo: support LDV for two-space garbage collection. + // + barf("Lag/Drag/Void profiling not supported with -G1"); } else { processNurseryForDead(); - for (g = 0; g <= N; g++) { + for (g = 0; g <= N; g++) { processHeapForDead(generations[g].old_blocks); processChainForDead(generations[g].large_objects); } From git at git.haskell.org Wed Aug 20 17:47:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:47:44 +0000 (UTC) Subject: [commit: ghc] master: Comment why the include is necessary (15df6d9) Message-ID: <20140820174744.EB8DD24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/15df6d98afb8c3813013c5b97efffe0ba8020d32/ghc >--------------------------------------------------------------- commit 15df6d98afb8c3813013c5b97efffe0ba8020d32 Author: Gabor Greif Date: Wed Aug 20 19:39:56 2014 +0200 Comment why the include is necessary >--------------------------------------------------------------- 15df6d98afb8c3813013c5b97efffe0ba8020d32 rts/Capability.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/Capability.c b/rts/Capability.c index 14c99d0..04f3a61 100644 --- a/rts/Capability.c +++ b/rts/Capability.c @@ -26,7 +26,7 @@ #include "sm/GC.h" // for gcWorkerThread() #include "STM.h" #include "RtsUtils.h" -#include "rts/IOManager.h" +#include "rts/IOManager.h" // for setIOManagerControlFd() #include From git at git.haskell.org Wed Aug 20 17:51:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:51:45 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace Rts.h (6f3dd98) Message-ID: <20140820175145.A59DF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f3dd986e05f764b0c036840cfa9624b1e8c48f2/ghc >--------------------------------------------------------------- commit 6f3dd986e05f764b0c036840cfa9624b1e8c48f2 Author: Austin Seipp Date: Wed Aug 20 12:40:58 2014 -0500 [ci skip] includes: detabify/dewhitespace Rts.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 6f3dd986e05f764b0c036840cfa9624b1e8c48f2 includes/Rts.h | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/includes/Rts.h b/includes/Rts.h index aca6c49..6bf7650 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -99,16 +99,16 @@ extern "C" { void _assertFail(const char *filename, unsigned int linenum) GNUC3_ATTRIBUTE(__noreturn__); -#define CHECK(predicate) \ - if (predicate) \ - /*null*/; \ - else \ - _assertFail(__FILE__, __LINE__) +#define CHECK(predicate) \ + if (predicate) \ + /*null*/; \ + else \ + _assertFail(__FILE__, __LINE__) #define CHECKM(predicate, msg, ...) \ - if (predicate) \ - /*null*/; \ - else \ + if (predicate) \ + /*null*/; \ + else \ barf(msg, ##__VA_ARGS__) #ifndef DEBUG @@ -240,7 +240,7 @@ INLINE_HEADER Time fsecondsToTime (double t) #include "rts/Main.h" /* Misc stuff without a home */ -DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell */ +DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell */ DLL_IMPORT_RTS extern int prog_argc; DLL_IMPORT_RTS extern char *prog_name; From git at git.haskell.org Wed Aug 20 17:51:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:51:48 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace HsFFI.h (a784afc) Message-ID: <20140820175148.2CE5A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a784afcba03fac7f3f428a15b632792d2e404898/ghc >--------------------------------------------------------------- commit a784afcba03fac7f3f428a15b632792d2e404898 Author: Austin Seipp Date: Wed Aug 20 12:41:46 2014 -0500 [ci skip] includes: detabify/dewhitespace HsFFI.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- a784afcba03fac7f3f428a15b632792d2e404898 includes/HsFFI.h | 168 +++++++++++++++++++++++++++---------------------------- 1 file changed, 84 insertions(+), 84 deletions(-) diff --git a/includes/HsFFI.h b/includes/HsFFI.h index ab3b3eb..d51ee04 100644 --- a/includes/HsFFI.h +++ b/includes/HsFFI.h @@ -36,58 +36,58 @@ extern "C" { #endif #ifdef INT8_MIN -#define __INT8_MIN INT8_MIN -#define __INT16_MIN INT16_MIN -#define __INT32_MIN INT32_MIN -#define __INT64_MIN INT64_MIN -#define __INT8_MAX INT8_MAX -#define __INT16_MAX INT16_MAX -#define __INT32_MAX INT32_MAX -#define __INT64_MAX INT64_MAX -#define __UINT8_MAX UINT8_MAX -#define __UINT16_MAX UINT16_MAX -#define __UINT32_MAX UINT32_MAX -#define __UINT64_MAX UINT64_MAX +#define __INT8_MIN INT8_MIN +#define __INT16_MIN INT16_MIN +#define __INT32_MIN INT32_MIN +#define __INT64_MIN INT64_MIN +#define __INT8_MAX INT8_MAX +#define __INT16_MAX INT16_MAX +#define __INT32_MAX INT32_MAX +#define __INT64_MAX INT64_MAX +#define __UINT8_MAX UINT8_MAX +#define __UINT16_MAX UINT16_MAX +#define __UINT32_MAX UINT32_MAX +#define __UINT64_MAX UINT64_MAX #else /* if we had no luck, let's do it for ourselves (assuming 64bit long longs) */ -#define __INT8_MIN (-128) -#define __INT16_MIN (-32767-1) -#define __INT32_MIN (-2147483647-1) -#define __INT64_MIN (-9223372036854775807LL-1) -#define __INT8_MAX (127) -#define __INT16_MAX (32767) -#define __INT32_MAX (2147483647) -#define __INT64_MAX (9223372036854775807LL) -#define __UINT8_MAX (255U) -#define __UINT16_MAX (65535U) -#define __UINT32_MAX (4294967295U) -#define __UINT64_MAX (18446744073709551615ULL) +#define __INT8_MIN (-128) +#define __INT16_MIN (-32767-1) +#define __INT32_MIN (-2147483647-1) +#define __INT64_MIN (-9223372036854775807LL-1) +#define __INT8_MAX (127) +#define __INT16_MAX (32767) +#define __INT32_MAX (2147483647) +#define __INT64_MAX (9223372036854775807LL) +#define __UINT8_MAX (255U) +#define __UINT16_MAX (65535U) +#define __UINT32_MAX (4294967295U) +#define __UINT64_MAX (18446744073709551615ULL) #endif /* get limits for floating point types */ #include -typedef StgChar HsChar; -typedef StgInt HsInt; -typedef StgInt8 HsInt8; -typedef StgInt16 HsInt16; -typedef StgInt32 HsInt32; -typedef StgInt64 HsInt64; +typedef StgChar HsChar; +typedef StgInt HsInt; +typedef StgInt8 HsInt8; +typedef StgInt16 HsInt16; +typedef StgInt32 HsInt32; +typedef StgInt64 HsInt64; typedef StgWord HsWord; -typedef StgWord8 HsWord8; -typedef StgWord16 HsWord16; -typedef StgWord32 HsWord32; -typedef StgWord64 HsWord64; -typedef StgFloat HsFloat; -typedef StgDouble HsDouble; -typedef StgInt HsBool; -typedef void* HsPtr; /* this should better match StgAddr */ -typedef void (*HsFunPtr)(void); /* this should better match StgAddr */ -typedef void* HsStablePtr; +typedef StgWord8 HsWord8; +typedef StgWord16 HsWord16; +typedef StgWord32 HsWord32; +typedef StgWord64 HsWord64; +typedef StgFloat HsFloat; +typedef StgDouble HsDouble; +typedef StgInt HsBool; +typedef void* HsPtr; /* this should better match StgAddr */ +typedef void (*HsFunPtr)(void); /* this should better match StgAddr */ +typedef void* HsStablePtr; /* this should correspond to the type of StgChar in StgTypes.h */ -#define HS_CHAR_MIN 0 -#define HS_CHAR_MAX 0x10FFFF +#define HS_CHAR_MIN 0 +#define HS_CHAR_MAX 0x10FFFF /* is it true or not? */ #define HS_BOOL_FALSE 0 @@ -98,53 +98,53 @@ typedef void* HsStablePtr; /* this mirrors the distinction of cases in StgTypes.h */ #if SIZEOF_VOID_P == 8 -#define HS_INT_MIN __INT64_MIN -#define HS_INT_MAX __INT64_MAX -#define HS_WORD_MAX __UINT64_MAX +#define HS_INT_MIN __INT64_MIN +#define HS_INT_MAX __INT64_MAX +#define HS_WORD_MAX __UINT64_MAX #elif SIZEOF_VOID_P == 4 -#define HS_INT_MIN __INT32_MIN -#define HS_INT_MAX __INT32_MAX -#define HS_WORD_MAX __UINT32_MAX +#define HS_INT_MIN __INT32_MIN +#define HS_INT_MAX __INT32_MAX +#define HS_WORD_MAX __UINT32_MAX #else #error GHC untested on this architecture: sizeof(void *) != 4 or 8 #endif -#define HS_INT8_MIN __INT8_MIN -#define HS_INT8_MAX __INT8_MAX -#define HS_INT16_MIN __INT16_MIN -#define HS_INT16_MAX __INT16_MAX -#define HS_INT32_MIN __INT32_MIN -#define HS_INT32_MAX __INT32_MAX -#define HS_INT64_MIN __INT64_MIN -#define HS_INT64_MAX __INT64_MAX -#define HS_WORD8_MAX __UINT8_MAX -#define HS_WORD16_MAX __UINT16_MAX -#define HS_WORD32_MAX __UINT32_MAX -#define HS_WORD64_MAX __UINT64_MAX - -#define HS_FLOAT_RADIX FLT_RADIX -#define HS_FLOAT_ROUNDS FLT_ROUNDS -#define HS_FLOAT_EPSILON FLT_EPSILON -#define HS_FLOAT_DIG FLT_DIG -#define HS_FLOAT_MANT_DIG FLT_MANT_DIG -#define HS_FLOAT_MIN FLT_MIN -#define HS_FLOAT_MIN_EXP FLT_MIN_EXP -#define HS_FLOAT_MIN_10_EXP FLT_MIN_10_EXP -#define HS_FLOAT_MAX FLT_MAX -#define HS_FLOAT_MAX_EXP FLT_MAX_EXP -#define HS_FLOAT_MAX_10_EXP FLT_MAX_10_EXP - -#define HS_DOUBLE_RADIX DBL_RADIX -#define HS_DOUBLE_ROUNDS DBL_ROUNDS -#define HS_DOUBLE_EPSILON DBL_EPSILON -#define HS_DOUBLE_DIG DBL_DIG -#define HS_DOUBLE_MANT_DIG DBL_MANT_DIG -#define HS_DOUBLE_MIN DBL_MIN -#define HS_DOUBLE_MIN_EXP DBL_MIN_EXP -#define HS_DOUBLE_MIN_10_EXP DBL_MIN_10_EXP -#define HS_DOUBLE_MAX DBL_MAX -#define HS_DOUBLE_MAX_EXP DBL_MAX_EXP -#define HS_DOUBLE_MAX_10_EXP DBL_MAX_10_EXP +#define HS_INT8_MIN __INT8_MIN +#define HS_INT8_MAX __INT8_MAX +#define HS_INT16_MIN __INT16_MIN +#define HS_INT16_MAX __INT16_MAX +#define HS_INT32_MIN __INT32_MIN +#define HS_INT32_MAX __INT32_MAX +#define HS_INT64_MIN __INT64_MIN +#define HS_INT64_MAX __INT64_MAX +#define HS_WORD8_MAX __UINT8_MAX +#define HS_WORD16_MAX __UINT16_MAX +#define HS_WORD32_MAX __UINT32_MAX +#define HS_WORD64_MAX __UINT64_MAX + +#define HS_FLOAT_RADIX FLT_RADIX +#define HS_FLOAT_ROUNDS FLT_ROUNDS +#define HS_FLOAT_EPSILON FLT_EPSILON +#define HS_FLOAT_DIG FLT_DIG +#define HS_FLOAT_MANT_DIG FLT_MANT_DIG +#define HS_FLOAT_MIN FLT_MIN +#define HS_FLOAT_MIN_EXP FLT_MIN_EXP +#define HS_FLOAT_MIN_10_EXP FLT_MIN_10_EXP +#define HS_FLOAT_MAX FLT_MAX +#define HS_FLOAT_MAX_EXP FLT_MAX_EXP +#define HS_FLOAT_MAX_10_EXP FLT_MAX_10_EXP + +#define HS_DOUBLE_RADIX DBL_RADIX +#define HS_DOUBLE_ROUNDS DBL_ROUNDS +#define HS_DOUBLE_EPSILON DBL_EPSILON +#define HS_DOUBLE_DIG DBL_DIG +#define HS_DOUBLE_MANT_DIG DBL_MANT_DIG +#define HS_DOUBLE_MIN DBL_MIN +#define HS_DOUBLE_MIN_EXP DBL_MIN_EXP +#define HS_DOUBLE_MIN_10_EXP DBL_MIN_10_EXP +#define HS_DOUBLE_MAX DBL_MAX +#define HS_DOUBLE_MAX_EXP DBL_MAX_EXP +#define HS_DOUBLE_MAX_10_EXP DBL_MAX_10_EXP extern void hs_init (int *argc, char **argv[]); extern void hs_exit (void); From git at git.haskell.org Wed Aug 20 17:51:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:51:50 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace RtsAPI.h (772ffbe) Message-ID: <20140820175150.A3F8F24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/772ffbe77e81b680124c41ba6b3119ca4d7ac2c1/ghc >--------------------------------------------------------------- commit 772ffbe77e81b680124c41ba6b3119ca4d7ac2c1 Author: Austin Seipp Date: Wed Aug 20 12:40:48 2014 -0500 [ci skip] includes: detabify/dewhitespace RtsAPI.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 772ffbe77e81b680124c41ba6b3119ca4d7ac2c1 includes/RtsAPI.h | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h index 6e4decb..0ba1671 100644 --- a/includes/RtsAPI.h +++ b/includes/RtsAPI.h @@ -23,8 +23,8 @@ extern "C" { */ typedef enum { NoStatus, /* not finished yet */ - Success, /* completed successfully */ - Killed, /* uncaught exception */ + Success, /* completed successfully */ + Killed, /* uncaught exception */ Interrupted, /* stopped in response to a call to interruptStgRts */ HeapExhausted /* out of memory */ } SchedulerStatus; @@ -76,7 +76,7 @@ extern const RtsConfig defaultRtsConfig; /* DEPRECATED, use hs_init() or hs_init_ghc() instead */ extern void startupHaskell ( int argc, char *argv[], - void (*init_root)(void) ); + void (*init_root)(void) ); /* DEPRECATED, use hs_exit() instead */ extern void shutdownHaskell ( void ); @@ -243,10 +243,10 @@ void rts_done (void); ----------------------------------------------------------------------- */ // When producing Windows DLLs the we need to know which symbols are in the -// local package/DLL vs external ones. +// local package/DLL vs external ones. // -// Note that RtsAPI.h is also included by foreign export stubs in -// the base package itself. +// Note that RtsAPI.h is also included by foreign export stubs in +// the base package itself. // #if defined(COMPILING_WINDOWS_DLL) && !defined(COMPILING_BASE_PACKAGE) __declspec(dllimport) extern StgWord base_GHCziTopHandler_runIO_closure[]; From git at git.haskell.org Wed Aug 20 17:51:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:51:54 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace Stg.h (c867cbc) Message-ID: <20140820175154.27DEC24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c867cbc8df1cb2d50e1f8d59c30f09ec7612a50a/ghc >--------------------------------------------------------------- commit c867cbc8df1cb2d50e1f8d59c30f09ec7612a50a Author: Austin Seipp Date: Wed Aug 20 12:40:24 2014 -0500 [ci skip] includes: detabify/dewhitespace Stg.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- c867cbc8df1cb2d50e1f8d59c30f09ec7612a50a includes/Stg.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/includes/Stg.h b/includes/Stg.h index 9edb6a0..1f3e18a 100644 --- a/includes/Stg.h +++ b/includes/Stg.h @@ -53,7 +53,7 @@ // C compilers that use an LLVM back end (clang or llvm-gcc) do not // correctly support global register variables so we make sure that // we do not declare them for these compilers. -# define NO_GLOBAL_REG_DECLS /* don't define fixed registers */ +# define NO_GLOBAL_REG_DECLS /* don't define fixed registers */ #endif /* Configuration */ From git at git.haskell.org Wed Aug 20 17:51:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:51:56 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace rts/OSThreads.h (7d26398) Message-ID: <20140820175156.9FD0A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7d26398be9502aa774231f0257631f74893fa1ca/ghc >--------------------------------------------------------------- commit 7d26398be9502aa774231f0257631f74893fa1ca Author: Austin Seipp Date: Wed Aug 20 12:44:28 2014 -0500 [ci skip] includes: detabify/dewhitespace rts/OSThreads.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 7d26398be9502aa774231f0257631f74893fa1ca includes/rts/OSThreads.h | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/includes/rts/OSThreads.h b/includes/rts/OSThreads.h index 0d2404c..e99be8a 100644 --- a/includes/rts/OSThreads.h +++ b/includes/rts/OSThreads.h @@ -141,14 +141,14 @@ typedef HANDLE Mutex; // casting to (Mutex *) here required due to use in .cmm files where // the argument has (void *) type. -#define ACQUIRE_LOCK(mutex) \ +#define ACQUIRE_LOCK(mutex) \ if (WaitForSingleObject(*((Mutex *)mutex),INFINITE) == WAIT_FAILED) { \ - barf("WaitForSingleObject: %d", GetLastError()); \ + barf("WaitForSingleObject: %d", GetLastError()); \ } -#define RELEASE_LOCK(mutex) \ - if (ReleaseMutex(*((Mutex *)mutex)) == 0) { \ - barf("ReleaseMutex: %d", GetLastError()); \ +#define RELEASE_LOCK(mutex) \ + if (ReleaseMutex(*((Mutex *)mutex)) == 0) { \ + barf("ReleaseMutex: %d", GetLastError()); \ } #define ASSERT_LOCK_HELD(mutex) /* nothing */ @@ -172,7 +172,7 @@ extern void yieldThread ( void ); typedef void OSThreadProcAttr OSThreadProc(void *); extern int createOSThread ( OSThreadId* tid, - OSThreadProc *startProc, void *param); + OSThreadProc *startProc, void *param); extern rtsBool osThreadIsAlive ( OSThreadId id ); extern void interruptOSThread (OSThreadId id); From git at git.haskell.org Wed Aug 20 17:51:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:51:59 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace stg/Regs.h (e232967) Message-ID: <20140820175159.D5AFE24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e23296739fd5b9336bc1a49fe4407e8e02059ea3/ghc >--------------------------------------------------------------- commit e23296739fd5b9336bc1a49fe4407e8e02059ea3 Author: Austin Seipp Date: Wed Aug 20 12:43:14 2014 -0500 [ci skip] includes: detabify/dewhitespace stg/Regs.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- e23296739fd5b9336bc1a49fe4407e8e02059ea3 includes/stg/Regs.h | 90 ++++++++++++++++++++++++++--------------------------- 1 file changed, 45 insertions(+), 45 deletions(-) diff --git a/includes/stg/Regs.h b/includes/stg/Regs.h index c548212..3632463 100644 --- a/includes/stg/Regs.h +++ b/includes/stg/Regs.h @@ -59,57 +59,57 @@ typedef union { * 2) caller-saves registers are saved across a CCall */ typedef struct { - StgUnion rR1; - StgUnion rR2; - StgUnion rR3; - StgUnion rR4; - StgUnion rR5; - StgUnion rR6; - StgUnion rR7; - StgUnion rR8; - StgUnion rR9; /* used occasionally by heap/stack checks */ - StgUnion rR10; /* used occasionally by heap/stack checks */ - StgFloat rF1; - StgFloat rF2; - StgFloat rF3; - StgFloat rF4; - StgFloat rF5; - StgFloat rF6; - StgDouble rD1; - StgDouble rD2; - StgDouble rD3; - StgDouble rD4; - StgDouble rD5; - StgDouble rD6; - StgWord128 rXMM1; - StgWord128 rXMM2; - StgWord128 rXMM3; - StgWord128 rXMM4; - StgWord128 rXMM5; - StgWord128 rXMM6; - StgWord256 rYMM1; - StgWord256 rYMM2; - StgWord256 rYMM3; - StgWord256 rYMM4; - StgWord256 rYMM5; - StgWord256 rYMM6; - StgWord512 rZMM1; - StgWord512 rZMM2; - StgWord512 rZMM3; - StgWord512 rZMM4; - StgWord512 rZMM5; - StgWord512 rZMM6; + StgUnion rR1; + StgUnion rR2; + StgUnion rR3; + StgUnion rR4; + StgUnion rR5; + StgUnion rR6; + StgUnion rR7; + StgUnion rR8; + StgUnion rR9; /* used occasionally by heap/stack checks */ + StgUnion rR10; /* used occasionally by heap/stack checks */ + StgFloat rF1; + StgFloat rF2; + StgFloat rF3; + StgFloat rF4; + StgFloat rF5; + StgFloat rF6; + StgDouble rD1; + StgDouble rD2; + StgDouble rD3; + StgDouble rD4; + StgDouble rD5; + StgDouble rD6; + StgWord128 rXMM1; + StgWord128 rXMM2; + StgWord128 rXMM3; + StgWord128 rXMM4; + StgWord128 rXMM5; + StgWord128 rXMM6; + StgWord256 rYMM1; + StgWord256 rYMM2; + StgWord256 rYMM3; + StgWord256 rYMM4; + StgWord256 rYMM5; + StgWord256 rYMM6; + StgWord512 rZMM1; + StgWord512 rZMM2; + StgWord512 rZMM3; + StgWord512 rZMM4; + StgWord512 rZMM5; + StgWord512 rZMM6; StgWord64 rL1; - StgPtr rSp; - StgPtr rSpLim; - StgPtr rHp; - StgPtr rHpLim; + StgPtr rSp; + StgPtr rSpLim; + StgPtr rHp; + StgPtr rHpLim; struct CostCentreStack_ * rCCCS; /* current cost-centre-stack */ struct StgTSO_ * rCurrentTSO; struct nursery_ * rNursery; struct bdescr_ * rCurrentNursery; /* Hp/HpLim point into this block */ struct bdescr_ * rCurrentAlloc; /* for allocation using allocate() */ - StgWord rHpAlloc; /* number of *bytes* being allocated in heap */ + StgWord rHpAlloc; /* number of *bytes* being allocated in heap */ StgWord rRet; /* holds the return code of the thread */ } StgRegTable; From git at git.haskell.org Wed Aug 20 17:52:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:02 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace Cmm.h (e183e35) Message-ID: <20140820175202.D9B8124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e183e35b48cac0c7cbfc3359665607ba2938a833/ghc >--------------------------------------------------------------- commit e183e35b48cac0c7cbfc3359665607ba2938a833 Author: Austin Seipp Date: Wed Aug 20 12:42:08 2014 -0500 [ci skip] includes: detabify/dewhitespace Cmm.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- e183e35b48cac0c7cbfc3359665607ba2938a833 includes/Cmm.h | 212 ++++++++++++++++++++++++++++----------------------------- 1 file changed, 106 insertions(+), 106 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e183e35b48cac0c7cbfc3359665607ba2938a833 From git at git.haskell.org Wed Aug 20 17:52:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:06 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace rts/Ticky.h (c607500) Message-ID: <20140820175206.6BC9824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c607500d1b5f7696eaf8fec6fa889aa1fde21822/ghc >--------------------------------------------------------------- commit c607500d1b5f7696eaf8fec6fa889aa1fde21822 Author: Austin Seipp Date: Wed Aug 20 12:44:03 2014 -0500 [ci skip] includes: detabify/dewhitespace rts/Ticky.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- c607500d1b5f7696eaf8fec6fa889aa1fde21822 includes/rts/Ticky.h | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/includes/rts/Ticky.h b/includes/rts/Ticky.h index 31d8095..ff4d44a 100644 --- a/includes/rts/Ticky.h +++ b/includes/rts/Ticky.h @@ -21,16 +21,15 @@ typedef struct _StgEntCounter { /* Using StgWord for everything, because both the C and asm code generators make trouble if you try to pack things tighter */ - StgWord registeredp; /* 0 == no, 1 == yes */ - StgInt arity; /* arity (static info) */ - StgInt allocd; /* # allocation of this closure */ - /* (rest of args are in registers) */ - char *str; /* name of the thing */ - char *arg_kinds; /* info about the args types */ - StgInt entry_count; /* Trips to fast entry code */ + StgWord registeredp; /* 0 == no, 1 == yes */ + StgInt arity; /* arity (static info) */ + StgInt allocd; /* # allocation of this closure */ + /* (rest of args are in registers) */ + char *str; /* name of the thing */ + char *arg_kinds; /* info about the args types */ + StgInt entry_count; /* Trips to fast entry code */ StgInt allocs; /* number of allocations by this fun */ struct _StgEntCounter *link;/* link to chain them all together */ } StgEntCounter; #endif /* RTS_TICKY_H */ - From git at git.haskell.org Wed Aug 20 17:52:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:08 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace rts/Threads.h (a739416) Message-ID: <20140820175208.E9E5424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a739416f115a9870e062b74db38609248ed3ebd6/ghc >--------------------------------------------------------------- commit a739416f115a9870e062b74db38609248ed3ebd6 Author: Austin Seipp Date: Wed Aug 20 12:44:10 2014 -0500 [ci skip] includes: detabify/dewhitespace rts/Threads.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- a739416f115a9870e062b74db38609248ed3ebd6 includes/rts/Threads.h | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/includes/rts/Threads.h b/includes/rts/Threads.h index da6f7a4..941f6da 100644 --- a/includes/rts/Threads.h +++ b/includes/rts/Threads.h @@ -29,11 +29,11 @@ void scheduleWaitThread (/* in */ StgTSO *tso, /* inout */ Capability **cap); StgTSO *createGenThread (Capability *cap, W_ stack_size, - StgClosure *closure); + StgClosure *closure); StgTSO *createIOThread (Capability *cap, W_ stack_size, - StgClosure *closure); + StgClosure *closure); StgTSO *createStrictIOThread (Capability *cap, W_ stack_size, - StgClosure *closure); + StgClosure *closure); // Suspending/resuming threads around foreign calls void * suspendThread (StgRegTable *, rtsBool interruptible); From git at git.haskell.org Wed Aug 20 17:52:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:12 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace rts/Hpc.h (bb70e33) Message-ID: <20140820175212.A2A1524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bb70e33a954414f71a274eb5558fba28734688c1/ghc >--------------------------------------------------------------- commit bb70e33a954414f71a274eb5558fba28734688c1 Author: Austin Seipp Date: Wed Aug 20 12:45:21 2014 -0500 [ci skip] includes: detabify/dewhitespace rts/Hpc.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- bb70e33a954414f71a274eb5558fba28734688c1 includes/rts/Hpc.h | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/includes/rts/Hpc.h b/includes/rts/Hpc.h index 40082d0..80ad47e 100644 --- a/includes/rts/Hpc.h +++ b/includes/rts/Hpc.h @@ -16,10 +16,10 @@ // Simple linked list of modules typedef struct _HpcModuleInfo { - char *modName; // name of module - StgWord32 tickCount; // number of ticks + char *modName; // name of module + StgWord32 tickCount; // number of ticks StgWord32 hashNo; // Hash number for this module's mix info - StgWord64 *tixArr; // tix Array; local for this module + StgWord64 *tixArr; // tix Array; local for this module rtsBool from_file; // data was read from the .tix file struct _HpcModuleInfo *next; } HpcModuleInfo; From git at git.haskell.org Wed Aug 20 17:52:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:15 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace rts/Stable.h (2957736) Message-ID: <20140820175216.2EA2B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2957736820c6a836d24a7098112d40ae1bb32d65/ghc >--------------------------------------------------------------- commit 2957736820c6a836d24a7098112d40ae1bb32d65 Author: Austin Seipp Date: Wed Aug 20 12:44:19 2014 -0500 [ci skip] includes: detabify/dewhitespace rts/Stable.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2957736820c6a836d24a7098112d40ae1bb32d65 includes/rts/Stable.h | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/includes/rts/Stable.h b/includes/rts/Stable.h index bc3b01a..f75b9ab 100644 --- a/includes/rts/Stable.h +++ b/includes/rts/Stable.h @@ -22,9 +22,9 @@ StgStablePtr getStablePtr (StgPtr p); -------------------------------------------------------------------------- */ typedef struct { - StgPtr addr; /* Haskell object, free list, or NULL */ - StgPtr old; /* old Haskell object, used during GC */ - StgClosure *sn_obj; /* the StableName object (or NULL) */ + StgPtr addr; /* Haskell object, free list, or NULL */ + StgPtr old; /* old Haskell object, used during GC */ + StgClosure *sn_obj; /* the StableName object (or NULL) */ } snEntry; typedef struct { From git at git.haskell.org Wed Aug 20 17:52:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:18 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace stg/Types.h (e7dd073) Message-ID: <20140820175218.73A5C24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e7dd07345fbfe7623823ebd0442dbdab7f4b81c2/ghc >--------------------------------------------------------------- commit e7dd07345fbfe7623823ebd0442dbdab7f4b81c2 Author: Austin Seipp Date: Wed Aug 20 12:43:32 2014 -0500 [ci skip] includes: detabify/dewhitespace stg/Types.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- e7dd07345fbfe7623823ebd0442dbdab7f4b81c2 includes/stg/Types.h | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/includes/stg/Types.h b/includes/stg/Types.h index bdd3860..b27430f 100644 --- a/includes/stg/Types.h +++ b/includes/stg/Types.h @@ -26,19 +26,19 @@ * * Specifically: - StgInt8, 16, 32, 64 - StgWord8, 16, 32, 64 - StgChar, StgFloat, StgDouble - - ***** All the same size (i.e. sizeof(void *)): ***** - StgPtr Basic pointer type - StgWord Unit of heap allocation - StgInt Signed version of StgWord - StgAddr Generic address type - - StgBool, StgVoid, StgPtr, StgOffset, - StgCode, StgStablePtr, StgFunPtr, - StgUnion. + StgInt8, 16, 32, 64 + StgWord8, 16, 32, 64 + StgChar, StgFloat, StgDouble + + ***** All the same size (i.e. sizeof(void *)): ***** + StgPtr Basic pointer type + StgWord Unit of heap allocation + StgInt Signed version of StgWord + StgAddr Generic address type + + StgBool, StgVoid, StgPtr, StgOffset, + StgCode, StgStablePtr, StgFunPtr, + StgUnion. */ /* @@ -125,13 +125,13 @@ typedef StgWord16 StgHalfWord; typedef void* StgAddr; typedef StgWord32 StgChar; typedef int StgBool; -typedef float StgFloat; -typedef double StgDouble; +typedef float StgFloat; +typedef double StgDouble; typedef StgWord* StgPtr; /* heap or stack pointer */ typedef StgWord volatile* StgVolatilePtr; /* pointer to volatile word */ typedef StgWord StgOffset; /* byte offset within closure */ -typedef StgWord8 StgCode; /* close enough */ -typedef void* StgStablePtr; +typedef StgWord8 StgCode; /* close enough */ +typedef void* StgStablePtr; typedef StgWord8* StgByteArray; /* From git at git.haskell.org Wed Aug 20 17:52:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:20 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace rts/prof/CCS.h (1c43f62) Message-ID: <20140820175221.8E27F24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1c43f620eeb65552614c6392e25f1404de291d6c/ghc >--------------------------------------------------------------- commit 1c43f620eeb65552614c6392e25f1404de291d6c Author: Austin Seipp Date: Wed Aug 20 12:46:24 2014 -0500 [ci skip] includes: detabify/dewhitespace rts/prof/CCS.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 1c43f620eeb65552614c6392e25f1404de291d6c includes/rts/prof/CCS.h | 47 +++++++++++++++++++++++------------------------ 1 file changed, 23 insertions(+), 24 deletions(-) diff --git a/includes/rts/prof/CCS.h b/includes/rts/prof/CCS.h index b121b03..85b03f3 100644 --- a/includes/rts/prof/CCS.h +++ b/includes/rts/prof/CCS.h @@ -190,21 +190,21 @@ void enterFunCCS (StgRegTable *reg, CostCentreStack *); extern CostCentre * RTS_VAR(CC_LIST); // registered CC list extern CostCentreStack * RTS_VAR(CCS_LIST); // registered CCS list -#define REGISTER_CC(cc) \ - do { \ - if ((cc)->link == (CostCentre *)0) { \ - (cc)->link = CC_LIST; \ - CC_LIST = (cc); \ - (cc)->ccID = CC_ID++; \ - }} while(0) - -#define REGISTER_CCS(ccs) \ - do { \ - if ((ccs)->prevStack == (CostCentreStack *)0) { \ - (ccs)->prevStack = CCS_LIST; \ - CCS_LIST = (ccs); \ - (ccs)->ccsID = CCS_ID++; \ - }} while(0) +#define REGISTER_CC(cc) \ + do { \ + if ((cc)->link == (CostCentre *)0) { \ + (cc)->link = CC_LIST; \ + CC_LIST = (cc); \ + (cc)->ccID = CC_ID++; \ + }} while(0) + +#define REGISTER_CCS(ccs) \ + do { \ + if ((ccs)->prevStack == (CostCentreStack *)0) { \ + (ccs)->prevStack = CCS_LIST; \ + CCS_LIST = (ccs); \ + (ccs)->ccsID = CCS_ID++; \ + }} while(0) /* ----------------------------------------------------------------------------- * Declaring Cost Centres & Cost Centre Stacks. @@ -224,17 +224,17 @@ extern CostCentreStack * RTS_VAR(CCS_LIST); // registered CCS list # define CCS_DECLARE(ccs_ident,cc_ident,is_local) \ is_local CostCentreStack ccs_ident[1] \ - = {{ ccsID : 0, \ - cc : cc_ident, \ - prevStack : NULL, \ - indexTable : NULL, \ + = {{ ccsID : 0, \ + cc : cc_ident, \ + prevStack : NULL, \ + indexTable : NULL, \ root : NULL, \ depth : 0, \ selected : 0, \ - scc_count : 0, \ - time_ticks : 0, \ - mem_alloc : 0, \ - inherited_ticks : 0, \ + scc_count : 0, \ + time_ticks : 0, \ + mem_alloc : 0, \ + inherited_ticks : 0, \ inherited_alloc : 0 \ }}; @@ -252,4 +252,3 @@ extern CostCentreStack * RTS_VAR(CCS_LIST); // registered CCS list #endif /* PROFILING */ #endif /* RTS_PROF_CCS_H */ - From git at git.haskell.org Wed Aug 20 17:52:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:24 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace stg/SMP.h (efcf0ab) Message-ID: <20140820175224.B5A9C24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/efcf0ab2a5efc37c4c17cb31957c1fc37d924e50/ghc >--------------------------------------------------------------- commit efcf0ab2a5efc37c4c17cb31957c1fc37d924e50 Author: Austin Seipp Date: Wed Aug 20 12:43:21 2014 -0500 [ci skip] includes: detabify/dewhitespace stg/SMP.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- efcf0ab2a5efc37c4c17cb31957c1fc37d924e50 includes/stg/SMP.h | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/includes/stg/SMP.h b/includes/stg/SMP.h index 00608c7..76dadde 100644 --- a/includes/stg/SMP.h +++ b/includes/stg/SMP.h @@ -115,10 +115,10 @@ xchg(StgPtr p, StgWord w) __asm__ __volatile__ ( // NB: the xchg instruction is implicitly locked, so we do not // need a lock prefix here. - "xchg %1,%0" + "xchg %1,%0" :"+r" (result), "+m" (*p) : /* no input-only operands */ - ); + ); #elif powerpc_HOST_ARCH __asm__ __volatile__ ( "1: lwarx %0, 0, %2\n" @@ -131,8 +131,8 @@ xchg(StgPtr p, StgWord w) result = w; __asm__ __volatile__ ( "swap %1,%0" - : "+r" (result), "+m" (*p) - : /* no input-only operands */ + : "+r" (result), "+m" (*p) + : /* no input-only operands */ ); #elif arm_HOST_ARCH && defined(arm_HOST_ARCH_PRE_ARMv6) __asm__ __volatile__ ("swp %0, %1, [%2]" @@ -179,7 +179,7 @@ cas(StgVolatilePtr p, StgWord o, StgWord n) return result; #elif i386_HOST_ARCH || x86_64_HOST_ARCH __asm__ __volatile__ ( - "lock\ncmpxchg %3,%1" + "lock\ncmpxchg %3,%1" :"=a"(o), "+m" (*(volatile unsigned int *)p) :"0" (o), "r" (n)); return o; @@ -199,10 +199,10 @@ cas(StgVolatilePtr p, StgWord o, StgWord n) return result; #elif sparc_HOST_ARCH __asm__ __volatile__ ( - "cas [%1], %2, %0" - : "+r" (n) - : "r" (p), "r" (o) - : "memory" + "cas [%1], %2, %0" + : "+r" (n) + : "r" (p), "r" (o) + : "memory" ); return n; #elif arm_HOST_ARCH && defined(arm_HOST_ARCH_PRE_ARMv6) From git at git.haskell.org Wed Aug 20 17:52:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:27 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace rts/prof/LDV.h (f20c663) Message-ID: <20140820175227.C2F7224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f20c6636b18079769a10e7a93a80e34393673347/ghc >--------------------------------------------------------------- commit f20c6636b18079769a10e7a93a80e34393673347 Author: Austin Seipp Date: Wed Aug 20 12:46:33 2014 -0500 [ci skip] includes: detabify/dewhitespace rts/prof/LDV.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- f20c6636b18079769a10e7a93a80e34393673347 includes/rts/prof/LDV.h | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Wed Aug 20 17:52:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:30 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace rts/storage/Closures.h (f6cdf04) Message-ID: <20140820175230.C1BBB24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f6cdf04c892c5c0e88a9b0eab72f09df67ed08d1/ghc >--------------------------------------------------------------- commit f6cdf04c892c5c0e88a9b0eab72f09df67ed08d1 Author: Austin Seipp Date: Wed Aug 20 12:47:21 2014 -0500 [ci skip] includes: detabify/dewhitespace rts/storage/Closures.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- f6cdf04c892c5c0e88a9b0eab72f09df67ed08d1 includes/rts/storage/Closures.h | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/includes/rts/storage/Closures.h b/includes/rts/storage/Closures.h index 8aed04e..d872868 100644 --- a/includes/rts/storage/Closures.h +++ b/includes/rts/storage/Closures.h @@ -94,17 +94,17 @@ typedef struct { typedef struct { StgHeader header; - StgHalfWord arity; /* zero if it is an AP */ + StgHalfWord arity; /* zero if it is an AP */ StgHalfWord n_args; - StgClosure *fun; /* really points to a fun */ + StgClosure *fun; /* really points to a fun */ StgClosure *payload[FLEXIBLE_ARRAY]; } StgPAP; typedef struct { StgThunkHeader header; - StgHalfWord arity; /* zero if it is an AP */ + StgHalfWord arity; /* zero if it is an AP */ StgHalfWord n_args; - StgClosure *fun; /* really points to a fun */ + StgClosure *fun; /* really points to a fun */ StgClosure *payload[FLEXIBLE_ARRAY]; } StgAP; @@ -202,11 +202,11 @@ typedef struct _StgStableName { StgWord sn; } StgStableName; -typedef struct _StgWeak { /* Weak v */ +typedef struct _StgWeak { /* Weak v */ StgHeader header; StgClosure *cfinalizers; StgClosure *key; - StgClosure *value; /* v */ + StgClosure *value; /* v */ StgClosure *finalizer; struct _StgWeak *link; } StgWeak; @@ -243,9 +243,9 @@ typedef struct _StgCFinalizerList { typedef struct { StgHeader header; - StgArrWords *instrs; /* a pointer to an ArrWords */ - StgArrWords *literals; /* a pointer to an ArrWords */ - StgMutArrPtrs *ptrs; /* a pointer to a MutArrPtrs */ + StgArrWords *instrs; /* a pointer to an ArrWords */ + StgArrWords *literals; /* a pointer to an ArrWords */ + StgMutArrPtrs *ptrs; /* a pointer to a MutArrPtrs */ StgHalfWord arity; /* arity of this BCO */ StgHalfWord size; /* size of this BCO (in words) */ StgWord bitmap[FLEXIBLE_ARRAY]; /* an StgLargeBitmap */ @@ -255,7 +255,7 @@ typedef struct { #define BCO_BITMAP_SIZE(bco) (BCO_BITMAP(bco)->size) #define BCO_BITMAP_BITS(bco) (BCO_BITMAP(bco)->bitmap) #define BCO_BITMAP_SIZEW(bco) ((BCO_BITMAP_SIZE(bco) + BITS_IN(StgWord) - 1) \ - / BITS_IN(StgWord)) + / BITS_IN(StgWord)) /* A function return stack frame: used when saving the state for a * garbage collection at a function entry point. The function From git at git.haskell.org Wed Aug 20 17:52:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:33 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace rts/storage/MBlock.h (aa045e5) Message-ID: <20140820175233.D941C24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aa045e59ff32dac4e6cb055b202da23fb306b256/ghc >--------------------------------------------------------------- commit aa045e59ff32dac4e6cb055b202da23fb306b256 Author: Austin Seipp Date: Wed Aug 20 12:46:58 2014 -0500 [ci skip] includes: detabify/dewhitespace rts/storage/MBlock.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- aa045e59ff32dac4e6cb055b202da23fb306b256 includes/rts/storage/MBlock.h | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/includes/rts/storage/MBlock.h b/includes/rts/storage/MBlock.h index 1b02b3c..29105ca 100644 --- a/includes/rts/storage/MBlock.h +++ b/includes/rts/storage/MBlock.h @@ -61,9 +61,9 @@ extern SpinLock gc_alloc_block_sync; extern StgWord8 mblock_map[]; /* On a 32-bit machine a 4KB table is always sufficient */ -# define MBLOCK_MAP_SIZE 4096 -# define MBLOCK_MAP_ENTRY(p) ((StgWord)(p) >> MBLOCK_SHIFT) -# define HEAP_ALLOCED(p) mblock_map[MBLOCK_MAP_ENTRY(p)] +# define MBLOCK_MAP_SIZE 4096 +# define MBLOCK_MAP_ENTRY(p) ((StgWord)(p) >> MBLOCK_SHIFT) +# define HEAP_ALLOCED(p) mblock_map[MBLOCK_MAP_ENTRY(p)] # define HEAP_ALLOCED_GC(p) HEAP_ALLOCED(p) /* ----------------------------------------------------------------------------- From git at git.haskell.org Wed Aug 20 17:52:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:37 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace rts/storage/GC.h (b4ec067) Message-ID: <20140820175238.2837924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b4ec06789886ed5e21d50dc38cabc48cf9ad9cfb/ghc >--------------------------------------------------------------- commit b4ec06789886ed5e21d50dc38cabc48cf9ad9cfb Author: Austin Seipp Date: Wed Aug 20 12:47:32 2014 -0500 [ci skip] includes: detabify/dewhitespace rts/storage/GC.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- b4ec06789886ed5e21d50dc38cabc48cf9ad9cfb includes/rts/storage/GC.h | 48 +++++++++++++++++++++++------------------------ 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h index 63a9594..c171b67 100644 --- a/includes/rts/storage/GC.h +++ b/includes/rts/storage/GC.h @@ -67,13 +67,13 @@ typedef struct nursery_ { } nursery; typedef struct generation_ { - nat no; // generation number + nat no; // generation number - bdescr * blocks; // blocks in this gen + bdescr * blocks; // blocks in this gen memcount n_blocks; // number of blocks memcount n_words; // number of used words - bdescr * large_objects; // large objects (doubly linked) + bdescr * large_objects; // large objects (doubly linked) memcount n_large_blocks; // no. of blocks used by large objs memcount n_large_words; // no. of words used by large objs memcount n_new_large_words; // words of new large objects @@ -85,7 +85,7 @@ typedef struct generation_ { // linked via global_link StgWeak * weak_ptr_list; // weak pointers in this gen - struct generation_ *to; // destination gen for live objects + struct generation_ *to; // destination gen for live objects // stats information nat collections; @@ -102,20 +102,20 @@ typedef struct generation_ { // and scavenged_large_objects #endif - int mark; // mark (not copy)? (old gen only) - int compact; // compact (not sweep)? (old gen only) + int mark; // mark (not copy)? (old gen only) + int compact; // compact (not sweep)? (old gen only) // During GC, if we are collecting this gen, blocks and n_blocks // are copied into the following two fields. After GC, these blocks // are freed. - bdescr * old_blocks; // bdescr of first from-space block + bdescr * old_blocks; // bdescr of first from-space block memcount n_old_blocks; // number of blocks in from-space memcount live_estimate; // for sweeping: estimate of live data bdescr * scavenged_large_objects; // live large objs after GC (d-link) memcount n_scavenged_large_blocks; // size (not count) of above - bdescr * bitmap; // bitmap for compacting collection + bdescr * bitmap; // bitmap for compacting collection StgTSO * old_threads; StgWeak * old_weak_ptr_list; @@ -130,26 +130,26 @@ extern generation * oldest_gen; StgPtr allocate(Capability *cap, W_ n) Allocates memory from the nursery in - the current Capability. This can be - done without taking a global lock, + the current Capability. This can be + done without taking a global lock, unlike allocate(). StgPtr allocatePinned(Capability *cap, W_ n) Allocates a chunk of contiguous store - n words long, which is at a fixed - address (won't be moved by GC). - Returns a pointer to the first word. - Always succeeds. - - NOTE: the GC can't in general handle - pinned objects, so allocatePinned() - can only be used for ByteArrays at the - moment. - - Don't forget to TICK_ALLOC_XXX(...) - after calling allocate or - allocatePinned, for the - benefit of the ticky-ticky profiler. + n words long, which is at a fixed + address (won't be moved by GC). + Returns a pointer to the first word. + Always succeeds. + + NOTE: the GC can't in general handle + pinned objects, so allocatePinned() + can only be used for ByteArrays at the + moment. + + Don't forget to TICK_ALLOC_XXX(...) + after calling allocate or + allocatePinned, for the + benefit of the ticky-ticky profiler. -------------------------------------------------------------------------- */ From git at git.haskell.org Wed Aug 20 17:52:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:40 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace rts/storage/TSO.h (e57a29a) Message-ID: <20140820175241.58FDA24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e57a29a4699dc80f967f3190f7e98833502ce184/ghc >--------------------------------------------------------------- commit e57a29a4699dc80f967f3190f7e98833502ce184 Author: Austin Seipp Date: Wed Aug 20 12:47:07 2014 -0500 [ci skip] includes: detabify/dewhitespace rts/storage/TSO.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- e57a29a4699dc80f967f3190f7e98833502ce184 includes/rts/storage/TSO.h | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/includes/rts/storage/TSO.h b/includes/rts/storage/TSO.h index 187b668..6dbcec2 100644 --- a/includes/rts/storage/TSO.h +++ b/includes/rts/storage/TSO.h @@ -50,7 +50,7 @@ typedef union { struct MessageBlackHole_ *bh; struct MessageThrowTo_ *throwto; struct MessageWakeup_ *wakeup; - StgInt fd; /* StgInt instead of int, so that it's the same size as the ptrs */ + StgInt fd; /* StgInt instead of int, so that it's the same size as the ptrs */ #if defined(mingw32_HOST_OS) StgAsyncIOResult *async_result; #endif @@ -208,11 +208,11 @@ void dirty_STACK (Capability *cap, StgStack *stack); The size of the TSO struct plus the stack is either (a) smaller than a block, or - (b) a multiple of BLOCK_SIZE + (b) a multiple of BLOCK_SIZE - tso->why_blocked tso->block_info location + tso->why_blocked tso->block_info location ---------------------------------------------------------------------- - NotBlocked END_TSO_QUEUE runnable_queue, or running + NotBlocked END_TSO_QUEUE runnable_queue, or running BlockedOnBlackHole the BLACKHOLE blackhole_queue @@ -224,10 +224,10 @@ void dirty_STACK (Capability *cap, StgStack *stack); BlockedOnMsgThrowTo MessageThrowTo * TSO->blocked_exception BlockedOnRead NULL blocked_queue - BlockedOnWrite NULL blocked_queue + BlockedOnWrite NULL blocked_queue BlockedOnDelay NULL blocked_queue - BlockedOnGA closure TSO blocks on BQ of that closure - BlockedOnGA_NoSend closure TSO blocks on BQ of that closure + BlockedOnGA closure TSO blocks on BQ of that closure + BlockedOnGA_NoSend closure TSO blocks on BQ of that closure tso->link == END_TSO_QUEUE, if the thread is currently running. From git at git.haskell.org Wed Aug 20 17:52:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:42 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace rts/storage/Block.h (e9e3cf5) Message-ID: <20140820175243.106AA24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e9e3cf54c4fcc3f2cb4e01f2721b40bea7bb9117/ghc >--------------------------------------------------------------- commit e9e3cf54c4fcc3f2cb4e01f2721b40bea7bb9117 Author: Austin Seipp Date: Wed Aug 20 12:49:27 2014 -0500 [ci skip] includes: detabify/dewhitespace rts/storage/Block.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- e9e3cf54c4fcc3f2cb4e01f2721b40bea7bb9117 includes/rts/storage/Block.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/includes/rts/storage/Block.h b/includes/rts/storage/Block.h index 29c081b..755c817 100644 --- a/includes/rts/storage/Block.h +++ b/includes/rts/storage/Block.h @@ -146,7 +146,7 @@ typedef struct bdescr_ { /* Block is free, and on the free list (TODO: is this used?) */ #define BF_FREE 16 /* Block is executable */ -#define BF_EXEC 32 +#define BF_EXEC 32 /* Block contains only a small amount of live data */ #define BF_FRAGMENTED 64 /* we know about this block (for finding leaks) */ From git at git.haskell.org Wed Aug 20 17:52:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:46 +0000 (UTC) Subject: [commit: ghc] master: includes: detabify/dewhitespace rts/storage/ClosureMacros.h (840a1cb) Message-ID: <20140820175246.3711524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/840a1cb07b447e9314550d930b52ededaad89b3a/ghc >--------------------------------------------------------------- commit 840a1cb07b447e9314550d930b52ededaad89b3a Author: Austin Seipp Date: Wed Aug 20 12:50:14 2014 -0500 includes: detabify/dewhitespace rts/storage/ClosureMacros.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 840a1cb07b447e9314550d930b52ededaad89b3a includes/rts/storage/ClosureMacros.h | 74 ++++++++++++++++++------------------ 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/includes/rts/storage/ClosureMacros.h b/includes/rts/storage/ClosureMacros.h index 2a0f197..64e549a 100644 --- a/includes/rts/storage/ClosureMacros.h +++ b/includes/rts/storage/ClosureMacros.h @@ -25,16 +25,16 @@ "info pointer" The first word of the closure. Might point to either the end or the beginning of the - info table, depending on whether we're using - the mini interpreter or not. GET_INFO(c) - retrieves the info pointer of a closure. + info table, depending on whether we're using + the mini interpreter or not. GET_INFO(c) + retrieves the info pointer of a closure. "info table" The info table structure associated with a closure. This is always a pointer to the - beginning of the structure, so we can - use standard C structure indexing to pull out - the fields. get_itbl(c) returns a pointer to - the info table for closure c. + beginning of the structure, so we can + use standard C structure indexing to pull out + the fields. get_itbl(c) returns a pointer to + the info table for closure c. An address of the form xxxx_info points to the end of the info table or the beginning of the info table depending on whether we're @@ -136,14 +136,14 @@ INLINE_HEADER StgHalfWord GET_TAG(const StgClosure *con) { #define SET_PROF_HDR(c,ccs) #endif -#define SET_HDR(c,_info,ccs) \ - { \ - (c)->header.info = _info; \ - SET_PROF_HDR((StgClosure *)(c),ccs); \ +#define SET_HDR(c,_info,ccs) \ + { \ + (c)->header.info = _info; \ + SET_PROF_HDR((StgClosure *)(c),ccs); \ } -#define SET_ARR_HDR(c,info,costCentreStack,n_bytes) \ - SET_HDR(c,info,costCentreStack); \ +#define SET_ARR_HDR(c,info,costCentreStack,n_bytes) \ + SET_HDR(c,info,costCentreStack); \ (c)->bytes = n_bytes; // Use when changing a closure from one kind to another @@ -166,14 +166,14 @@ STATIC_LINK(const StgInfoTable *info, StgClosure *p) { switch (info->type) { case THUNK_STATIC: - return THUNK_STATIC_LINK(p); + return THUNK_STATIC_LINK(p); case FUN_STATIC: - return FUN_STATIC_LINK(p); + return FUN_STATIC_LINK(p); case IND_STATIC: - return IND_STATIC_LINK(p); + return IND_STATIC_LINK(p); default: - return &(p)->payload[info->layout.payload.ptrs + - info->layout.payload.nptrs]; + return &(p)->payload[info->layout.payload.ptrs + + info->layout.payload.nptrs]; } } @@ -350,58 +350,58 @@ closure_sizeW_ (StgClosure *p, StgInfoTable *info) switch (info->type) { case THUNK_0_1: case THUNK_1_0: - return sizeofW(StgThunk) + 1; + return sizeofW(StgThunk) + 1; case FUN_0_1: case CONSTR_0_1: case FUN_1_0: case CONSTR_1_0: - return sizeofW(StgHeader) + 1; + return sizeofW(StgHeader) + 1; case THUNK_0_2: case THUNK_1_1: case THUNK_2_0: - return sizeofW(StgThunk) + 2; + return sizeofW(StgThunk) + 2; case FUN_0_2: case CONSTR_0_2: case FUN_1_1: case CONSTR_1_1: case FUN_2_0: case CONSTR_2_0: - return sizeofW(StgHeader) + 2; + return sizeofW(StgHeader) + 2; case THUNK: - return thunk_sizeW_fromITBL(info); + return thunk_sizeW_fromITBL(info); case THUNK_SELECTOR: - return THUNK_SELECTOR_sizeW(); + return THUNK_SELECTOR_sizeW(); case AP_STACK: - return ap_stack_sizeW((StgAP_STACK *)p); + return ap_stack_sizeW((StgAP_STACK *)p); case AP: - return ap_sizeW((StgAP *)p); + return ap_sizeW((StgAP *)p); case PAP: - return pap_sizeW((StgPAP *)p); + return pap_sizeW((StgPAP *)p); case IND: case IND_PERM: - return sizeofW(StgInd); + return sizeofW(StgInd); case ARR_WORDS: - return arr_words_sizeW((StgArrWords *)p); + return arr_words_sizeW((StgArrWords *)p); case MUT_ARR_PTRS_CLEAN: case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN: case MUT_ARR_PTRS_FROZEN0: - return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); + return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); case SMALL_MUT_ARR_PTRS_CLEAN: case SMALL_MUT_ARR_PTRS_DIRTY: case SMALL_MUT_ARR_PTRS_FROZEN: case SMALL_MUT_ARR_PTRS_FROZEN0: - return small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p); + return small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p); case TSO: return sizeofW(StgTSO); case STACK: return stack_sizeW((StgStack*)p); case BCO: - return bco_sizeW((StgBCO *)p); + return bco_sizeW((StgBCO *)p); case TREC_CHUNK: return sizeofW(StgTRecChunk); default: - return sizeW_fromITBL(info); + return sizeW_fromITBL(info); } } @@ -425,16 +425,16 @@ EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame ) switch (info->i.type) { case RET_FUN: - return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size; + return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size; case RET_BIG: - return 1 + GET_LARGE_BITMAP(&info->i)->size; + return 1 + GET_LARGE_BITMAP(&info->i)->size; case RET_BCO: - return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]); + return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]); default: - return 1 + BITMAP_SIZE(info->i.layout.bitmap); + return 1 + BITMAP_SIZE(info->i.layout.bitmap); } } From git at git.haskell.org Wed Aug 20 17:52:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Aug 2014 17:52:48 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] includes: detabify/dewhitespace rts/storage/InfoTables.h (98b1b13) Message-ID: <20140820175248.C568624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/98b1b13f6894a55e0278fad9379fe74614774577/ghc >--------------------------------------------------------------- commit 98b1b13f6894a55e0278fad9379fe74614774577 Author: Austin Seipp Date: Wed Aug 20 12:49:33 2014 -0500 [ci skip] includes: detabify/dewhitespace rts/storage/InfoTables.h Signed-off-by: Austin Seipp >--------------------------------------------------------------- 98b1b13f6894a55e0278fad9379fe74614774577 includes/rts/storage/InfoTables.h | 52 +++++++++++++++++++-------------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/includes/rts/storage/InfoTables.h b/includes/rts/storage/InfoTables.h index 3fbeed2..3890d49 100644 --- a/includes/rts/storage/InfoTables.h +++ b/includes/rts/storage/InfoTables.h @@ -61,7 +61,7 @@ typedef struct { #ifdef DEBUG_CLOSURE typedef struct { - ... whatever ... + ... whatever ... } StgDebugInfo; #else /* !DEBUG_CLOSURE */ @@ -112,14 +112,14 @@ extern StgWord16 closure_flags[]; #define ipFlags(ip) (closure_flags[ip->type]) #define ip_HNF(ip) ( ipFlags(ip) & _HNF) -#define ip_BITMAP(ip) ( ipFlags(ip) & _BTM) -#define ip_SHOULD_SPARK(ip) (!(ipFlags(ip) & _NS)) -#define ip_STATIC(ip) ( ipFlags(ip) & _STA) -#define ip_THUNK(ip) ( ipFlags(ip) & _THU) -#define ip_MUTABLE(ip) ( ipFlags(ip) & _MUT) -#define ip_UNPOINTED(ip) ( ipFlags(ip) & _UPT) -#define ip_SRT(ip) ( ipFlags(ip) & _SRT) -#define ip_IND(ip) ( ipFlags(ip) & _IND) +#define ip_BITMAP(ip) ( ipFlags(ip) & _BTM) +#define ip_SHOULD_SPARK(ip) (!(ipFlags(ip) & _NS)) +#define ip_STATIC(ip) ( ipFlags(ip) & _STA) +#define ip_THUNK(ip) ( ipFlags(ip) & _THU) +#define ip_MUTABLE(ip) ( ipFlags(ip) & _MUT) +#define ip_UNPOINTED(ip) ( ipFlags(ip) & _UPT) +#define ip_SRT(ip) ( ipFlags(ip) & _SRT) +#define ip_IND(ip) ( ipFlags(ip) & _IND) /* ----------------------------------------------------------------------------- Bitmaps @@ -185,13 +185,13 @@ typedef struct StgLargeSRT_ { * word long. */ typedef union { - struct { /* Heap closure payload layout: */ - StgHalfWord ptrs; /* number of pointers */ - StgHalfWord nptrs; /* number of non-pointers */ + struct { /* Heap closure payload layout: */ + StgHalfWord ptrs; /* number of pointers */ + StgHalfWord nptrs; /* number of non-pointers */ } payload; - StgWord bitmap; /* word-sized bit pattern describing */ - /* a stack frame: see below */ + StgWord bitmap; /* word-sized bit pattern describing */ + /* a stack frame: see below */ #ifndef TABLES_NEXT_TO_CODE StgLargeBitmap* large_bitmap; /* pointer to large bitmap structure */ @@ -199,7 +199,7 @@ typedef union { OFFSET_FIELD(large_bitmap_offset); /* offset from info table to large bitmap structure */ #endif - StgWord selector_offset; /* used in THUNK_SELECTORs */ + StgWord selector_offset; /* used in THUNK_SELECTORs */ } StgClosureInfo; @@ -210,7 +210,7 @@ typedef union { typedef struct StgInfoTable_ { #if !defined(TABLES_NEXT_TO_CODE) - StgFunPtr entry; /* pointer to the entry code */ + StgFunPtr entry; /* pointer to the entry code */ #endif #ifdef PROFILING @@ -223,9 +223,9 @@ typedef struct StgInfoTable_ { /* Debug-specific stuff would go here. */ #endif - StgClosureInfo layout; /* closure layout info (one word) */ + StgClosureInfo layout; /* closure layout info (one word) */ - StgHalfWord type; /* closure type */ + StgHalfWord type; /* closure type */ StgHalfWord srt_bitmap; /* In a CONSTR: - the constructor tag @@ -257,8 +257,8 @@ typedef struct StgInfoTable_ { typedef struct StgFunInfoExtraRev_ { OFFSET_FIELD(slow_apply_offset); /* apply to args on the stack */ union { - StgWord bitmap; - OFFSET_FIELD(bitmap_offset); /* arg ptr/nonptr bitmap */ + StgWord bitmap; + OFFSET_FIELD(bitmap_offset); /* arg ptr/nonptr bitmap */ } b; OFFSET_FIELD(srt_offset); /* pointer to the SRT table */ StgHalfWord fun_type; /* function type */ @@ -268,9 +268,9 @@ typedef struct StgFunInfoExtraRev_ { typedef struct StgFunInfoExtraFwd_ { StgHalfWord fun_type; /* function type */ StgHalfWord arity; /* function arity */ - StgSRT *srt; /* pointer to the SRT table */ + StgSRT *srt; /* pointer to the SRT table */ union { /* union for compat. with TABLES_NEXT_TO_CODE version */ - StgWord bitmap; /* arg ptr/nonptr bitmap */ + StgWord bitmap; /* arg ptr/nonptr bitmap */ } b; StgFun *slow_apply; /* apply to args on the stack */ } StgFunInfoExtraFwd; @@ -299,11 +299,11 @@ extern StgWord stg_arg_bitmaps[]; typedef struct { #if defined(TABLES_NEXT_TO_CODE) - OFFSET_FIELD(srt_offset); /* offset to the SRT table */ + OFFSET_FIELD(srt_offset); /* offset to the SRT table */ StgInfoTable i; #else StgInfoTable i; - StgSRT *srt; /* pointer to the SRT table */ + StgSRT *srt; /* pointer to the SRT table */ #endif } StgRetInfoTable; @@ -321,9 +321,9 @@ typedef struct StgThunkInfoTable_ { StgInfoTable i; #endif #if defined(TABLES_NEXT_TO_CODE) - OFFSET_FIELD(srt_offset); /* offset to the SRT table */ + OFFSET_FIELD(srt_offset); /* offset to the SRT table */ #else - StgSRT *srt; /* pointer to the SRT table */ + StgSRT *srt; /* pointer to the SRT table */ #endif #if defined(TABLES_NEXT_TO_CODE) StgInfoTable i; From git at git.haskell.org Thu Aug 21 07:00:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Aug 2014 07:00:37 +0000 (UTC) Subject: [commit: ghc] master: T8832: fix no newline at end of file warning (955db0d) Message-ID: <20140821070037.CEC1824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/955db0d1e2ec23dfe3b48140a9193a8ef74e956a/ghc >--------------------------------------------------------------- commit 955db0d1e2ec23dfe3b48140a9193a8ef74e956a Author: Karel Gardas Date: Thu Aug 21 09:00:15 2014 +0200 T8832: fix no newline at end of file warning >--------------------------------------------------------------- 955db0d1e2ec23dfe3b48140a9193a8ef74e956a testsuite/tests/simplCore/should_compile/T8832.hs | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Fri Aug 22 07:10:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 07:10:52 +0000 (UTC) Subject: [commit: ghc] master: Fix #9465. (030549a) Message-ID: <20140822071053.EA57124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/030549a1e263f352814e982fd9dba77755326a03/ghc >--------------------------------------------------------------- commit 030549a1e263f352814e982fd9dba77755326a03 Author: Gabor Pali Date: Fri Aug 22 09:03:09 2014 +0200 Fix #9465. It turned out the sed(1) expressions are not fully portable. So revist my earlier attempt for getting GHC_LDFLAGS in the configure script and rewrite it in Perl instead. >--------------------------------------------------------------- 030549a1e263f352814e982fd9dba77755326a03 aclocal.m4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aclocal.m4 b/aclocal.m4 index 7fcf67e..bdc6c5d 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1832,7 +1832,7 @@ AC_MSG_NOTICE(Building in-tree ghc-pwd) dnl If special linker flags are needed to build things, then allow dnl the user to pass them in via LDFLAGS. changequote(, )dnl - GHC_LDFLAGS=`echo $LDFLAGS | sed -r 's/(^| )([^ ])/\1-optl\2/g'` + GHC_LDFLAGS=`perl -e 'foreach (@ARGV) { print "-optl$_ " }' -- $LDFLAGS` changequote([, ])dnl if ! "$WithGhc" $GHC_LDFLAGS -v0 -no-user-$GHC_PACKAGE_DB_FLAG -hidir utils/ghc-pwd/dist-boot -odir utils/ghc-pwd/dist-boot -stubdir utils/ghc-pwd/dist-boot --make utils/ghc-pwd/Main.hs -o utils/ghc-pwd/dist-boot/ghc-pwd then From git at git.haskell.org Fri Aug 22 13:22:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 13:22:21 +0000 (UTC) Subject: [commit: packages/stm] master: Ignore GHC test suite generated files. (f456ac3) Message-ID: <20140822132221.E016924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/stm On branch : master Link : http://git.haskell.org/packages/stm.git/commitdiff/f456ac3d651ec2f7257df875bf0779fd0ca73161 >--------------------------------------------------------------- commit f456ac3d651ec2f7257df875bf0779fd0ca73161 Author: Edward Z. Yang Date: Fri Aug 22 14:21:21 2014 +0100 Ignore GHC test suite generated files. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- f456ac3d651ec2f7257df875bf0779fd0ca73161 .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 242131b..a08034b 100644 --- a/.gitignore +++ b/.gitignore @@ -9,6 +9,7 @@ *.run.stdout *.eventlog *.genscript +*.normalised # Backup files *~ From git at git.haskell.org Fri Aug 22 13:23:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 13:23:42 +0000 (UTC) Subject: [commit: packages/hpc] master: Ignore GHC test suite output. (fb14d34) Message-ID: <20140822132342.4BCDB24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/fb14d3428ba24d36e779736989dae3092a50a957 >--------------------------------------------------------------- commit fb14d3428ba24d36e779736989dae3092a50a957 Author: Edward Z. Yang Date: Fri Aug 22 14:23:09 2014 +0100 Ignore GHC test suite output. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- fb14d3428ba24d36e779736989dae3092a50a957 .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index b4d9cab..d44666c 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ GNUmakefile dist-install dist-boot ghc.mk +*.normalised From git at git.haskell.org Fri Aug 22 13:25:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 13:25:13 +0000 (UTC) Subject: [commit: ghc] master: gitignore: Ignore tests/rts/rdynamic (f9e9e71) Message-ID: <20140822132513.651FC24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f9e9e71610b9bc7c409400d9e7a3406f40cb5bd8/ghc >--------------------------------------------------------------- commit f9e9e71610b9bc7c409400d9e7a3406f40cb5bd8 Author: Edward Z. Yang Date: Fri Aug 22 01:40:55 2014 +0100 gitignore: Ignore tests/rts/rdynamic Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- f9e9e71610b9bc7c409400d9e7a3406f40cb5bd8 testsuite/.gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 5631eeb..591545c 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1305,6 +1305,7 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/rts/bug1010 /tests/rts/derefnull /tests/rts/divbyzero +/tests/rts/rdynamic /tests/rts/exec_signals /tests/rts/exec_signals_child /tests/rts/exec_signals_prepare From git at git.haskell.org Fri Aug 22 13:25:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 13:25:15 +0000 (UTC) Subject: [commit: ghc] master: submodule update hpc/stm with gitignore. (bf1b117) Message-ID: <20140822132515.CCCAB24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bf1b117b6ab87a915bf24bcc85e216e5d51cb012/ghc >--------------------------------------------------------------- commit bf1b117b6ab87a915bf24bcc85e216e5d51cb012 Author: Edward Z. Yang Date: Fri Aug 22 14:23:56 2014 +0100 submodule update hpc/stm with gitignore. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- bf1b117b6ab87a915bf24bcc85e216e5d51cb012 libraries/hpc | 2 +- libraries/stm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/hpc b/libraries/hpc index 5a1ee4e..fb14d34 160000 --- a/libraries/hpc +++ b/libraries/hpc @@ -1 +1 @@ -Subproject commit 5a1ee4e8a2056beff16f0a3cac2c4da61b96f317 +Subproject commit fb14d3428ba24d36e779736989dae3092a50a957 diff --git a/libraries/stm b/libraries/stm index e8a901f..f456ac3 160000 --- a/libraries/stm +++ b/libraries/stm @@ -1 +1 @@ -Subproject commit e8a901fddc88c6560af34e18a5201deeb8d51557 +Subproject commit f456ac3d651ec2f7257df875bf0779fd0ca73161 From git at git.haskell.org Fri Aug 22 13:50:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 13:50:34 +0000 (UTC) Subject: [commit: ghc] master: Do not zero out version number when processing wired-in packages. (22520cd) Message-ID: <20140822135034.ABAB024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/22520cd7071e624cb3cbde6fdd65e872855dd6ff/ghc >--------------------------------------------------------------- commit 22520cd7071e624cb3cbde6fdd65e872855dd6ff Author: Edward Z. Yang Date: Fri Aug 22 01:29:28 2014 +0100 Do not zero out version number when processing wired-in packages. Summary: Previously, GHC would look for instances of wired-in packages in the in-memory package database and null out the version number. This was necessary when the sourcePackageId was used to determine the linker symbols; however, we now use a package key, so only that needs to be updated. Long-term, we can remove this hack by ensuring that Cabal actually records the proper package key in the database. This will also fix an unrelated hack elsewhere. Keeping version numbers means that wired in packages get rendered differently when output by GHC. This is the source of all the test-case output changes. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: hvr, austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D170 >--------------------------------------------------------------- 22520cd7071e624cb3cbde6fdd65e872855dd6ff compiler/main/Packages.lhs | 3 +-- testsuite/tests/ghci/scripts/ghci025.stdout | 5 +++-- testsuite/tests/indexed-types/should_compile/T3017.stderr | 3 ++- testsuite/tests/indexed-types/should_fail/T9160.stderr | 8 ++++---- testsuite/tests/package/package06e.stderr | 4 ++-- testsuite/tests/package/package07e.stderr | 9 +++++---- testsuite/tests/package/package08e.stderr | 9 +++++---- testsuite/tests/roles/should_compile/Roles1.stderr | 3 ++- testsuite/tests/roles/should_compile/Roles14.stderr | 3 ++- testsuite/tests/roles/should_compile/Roles2.stderr | 3 ++- testsuite/tests/roles/should_compile/Roles3.stderr | 3 ++- testsuite/tests/roles/should_compile/Roles4.stderr | 3 ++- testsuite/tests/roles/should_compile/T8958.stderr | 3 ++- testsuite/tests/safeHaskell/check/Check01.stderr | 2 +- testsuite/tests/safeHaskell/check/Check06.stderr | 2 +- testsuite/tests/safeHaskell/check/Check08.stderr | 2 +- testsuite/tests/safeHaskell/check/Check09.stderr | 4 ++-- testsuite/tests/safeHaskell/check/pkg01/ImpSafe01.stderr | 2 +- testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly07.stderr | 2 +- testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly08.stderr | 2 +- testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout | 10 +++++----- testsuite/tests/safeHaskell/flags/SafeFlags17.stderr | 2 +- testsuite/tests/simplCore/should_compile/T5550.stderr | 6 +++--- testsuite/tests/th/TH_Roles2.stderr | 4 ++-- testsuite/tests/typecheck/should_compile/tc231.stderr | 3 ++- testsuite/tests/typecheck/should_fail/T5095.stderr | 3 ++- testsuite/tests/typecheck/should_fail/tcfail182.stderr | 3 ++- 27 files changed, 59 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 22520cd7071e624cb3cbde6fdd65e872855dd6ff From git at git.haskell.org Fri Aug 22 13:52:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 13:52:30 +0000 (UTC) Subject: [commit: ghc] master: Revert "rts/base: Fix #9423" (4748f59) Message-ID: <20140822135231.40A6C24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4748f5936fe72d96edfa17b153dbfd84f2c4c053/ghc >--------------------------------------------------------------- commit 4748f5936fe72d96edfa17b153dbfd84f2c4c053 Author: Austin Seipp Date: Fri Aug 22 08:51:38 2014 -0500 Revert "rts/base: Fix #9423" This should fix the Windows fallout, and hopefully this will be fixed once that's sorted out. This reverts commit f9f89b7884ccc8ee5047cf4fffdf2b36df6832df. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 4748f5936fe72d96edfa17b153dbfd84f2c4c053 includes/rts/IOManager.h | 3 +- libraries/base/GHC/Event/Control.hs | 8 +++- libraries/base/GHC/Event/Manager.hs | 1 - libraries/base/GHC/Event/Thread.hs | 35 ++++++-------- libraries/base/GHC/Event/TimerManager.hs | 1 - rts/Capability.c | 11 ----- rts/Capability.h | 3 -- rts/Linker.c | 1 - rts/posix/Signals.c | 80 ++++++++++++-------------------- 9 files changed, 51 insertions(+), 92 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4748f5936fe72d96edfa17b153dbfd84f2c4c053 From git at git.haskell.org Fri Aug 22 14:06:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 14:06:40 +0000 (UTC) Subject: [commit: ghc] master: Normalise GHC version number to make tests less fragile. (2719526) Message-ID: <20140822140641.22D0024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/27195265e2a9fc4451dffa44da3e2641561e74b3/ghc >--------------------------------------------------------------- commit 27195265e2a9fc4451dffa44da3e2641561e74b3 Author: Edward Z. Yang Date: Fri Aug 22 15:05:29 2014 +0100 Normalise GHC version number to make tests less fragile. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 27195265e2a9fc4451dffa44da3e2641561e74b3 testsuite/tests/package/all.T | 9 ++++++--- testsuite/tests/package/package06e.stderr | 4 ++-- testsuite/tests/package/package07e.stderr | 8 ++++---- testsuite/tests/package/package08e.stderr | 8 ++++---- 4 files changed, 16 insertions(+), 13 deletions(-) diff --git a/testsuite/tests/package/all.T b/testsuite/tests/package/all.T index cb30949..f2dc9dc 100644 --- a/testsuite/tests/package/all.T +++ b/testsuite/tests/package/all.T @@ -7,6 +7,9 @@ incr_ghc = '-package "ghc (HsTypes as MyHsTypes, HsUtils)" ' inc_ghc = '-package ghc ' hide_ghc = '-hide-package ghc ' +def normaliseGhcVersion(str): + return re.sub('ghc-[0-9.]+', 'ghc-', str) + test('package01', normal, compile, [hide_all + incr_containers]) test('package01e', normal, compile_fail, [hide_all + incr_containers]) test('package02', normal, compile, [hide_all + inc_containers + incr_containers]) @@ -14,8 +17,8 @@ test('package03', normal, compile, [hide_all + incr_containers + inc_conta test('package04', normal, compile, [incr_containers]) test('package05', normal, compile, [incr_ghc + inc_ghc]) test('package06', normal, compile, [incr_ghc]) -test('package06e', normal, compile_fail, [incr_ghc]) -test('package07e', normal, compile_fail, [incr_ghc + inc_ghc + hide_ghc]) -test('package08e', normal, compile_fail, [incr_ghc + hide_ghc]) +test('package06e', normalise_errmsg_fun(normaliseGhcVersion), compile_fail, [incr_ghc]) +test('package07e', normalise_errmsg_fun(normaliseGhcVersion), compile_fail, [incr_ghc + inc_ghc + hide_ghc]) +test('package08e', normalise_errmsg_fun(normaliseGhcVersion), compile_fail, [incr_ghc + hide_ghc]) test('package09e', normal, compile_fail, ['-package "containers (Data.Map as M, Data.Set as M)"']) test('package10', normal, compile, ['-hide-all-packages -package "ghc (UniqFM as Prelude)" ']) diff --git a/testsuite/tests/package/package06e.stderr b/testsuite/tests/package/package06e.stderr index 05894ee..1cb27e3 100644 --- a/testsuite/tests/package/package06e.stderr +++ b/testsuite/tests/package/package06e.stderr @@ -1,10 +1,10 @@ package06e.hs:2:1: Failed to load interface for ?HsTypes? - It is a member of the hidden package ?ghc-7.9.20140821?. + It is a member of the hidden package ?ghc-?. Use -v to see a list of the files searched for. package06e.hs:3:1: Failed to load interface for ?UniqFM? - It is a member of the hidden package ?ghc-7.9.20140821?. + It is a member of the hidden package ?ghc-?. Use -v to see a list of the files searched for. diff --git a/testsuite/tests/package/package07e.stderr b/testsuite/tests/package/package07e.stderr index 40eaa06..0e4a040 100644 --- a/testsuite/tests/package/package07e.stderr +++ b/testsuite/tests/package/package07e.stderr @@ -2,20 +2,20 @@ package07e.hs:2:1: Failed to load interface for ?MyHsTypes? Perhaps you meant - HsTypes (needs flag -package-key ghc-7.9.20140821) + HsTypes (needs flag -package-key ghc-) Use -v to see a list of the files searched for. package07e.hs:3:1: Failed to load interface for ?HsTypes? - It is a member of the hidden package ?ghc-7.9.20140821?. + It is a member of the hidden package ?ghc-?. Use -v to see a list of the files searched for. package07e.hs:4:1: Failed to load interface for ?HsUtils? - It is a member of the hidden package ?ghc-7.9.20140821?. + It is a member of the hidden package ?ghc-?. Use -v to see a list of the files searched for. package07e.hs:5:1: Failed to load interface for ?UniqFM? - It is a member of the hidden package ?ghc-7.9.20140821?. + It is a member of the hidden package ?ghc-?. Use -v to see a list of the files searched for. diff --git a/testsuite/tests/package/package08e.stderr b/testsuite/tests/package/package08e.stderr index 7b5c2a8..975b4b9 100644 --- a/testsuite/tests/package/package08e.stderr +++ b/testsuite/tests/package/package08e.stderr @@ -2,20 +2,20 @@ package08e.hs:2:1: Failed to load interface for ?MyHsTypes? Perhaps you meant - HsTypes (needs flag -package-key ghc-7.9.20140821) + HsTypes (needs flag -package-key ghc-) Use -v to see a list of the files searched for. package08e.hs:3:1: Failed to load interface for ?HsTypes? - It is a member of the hidden package ?ghc-7.9.20140821?. + It is a member of the hidden package ?ghc-?. Use -v to see a list of the files searched for. package08e.hs:4:1: Failed to load interface for ?HsUtils? - It is a member of the hidden package ?ghc-7.9.20140821?. + It is a member of the hidden package ?ghc-?. Use -v to see a list of the files searched for. package08e.hs:5:1: Failed to load interface for ?UniqFM? - It is a member of the hidden package ?ghc-7.9.20140821?. + It is a member of the hidden package ?ghc-?. Use -v to see a list of the files searched for. From git at git.haskell.org Fri Aug 22 15:38:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 15:38:22 +0000 (UTC) Subject: [commit: ghc] branch 'wip/remove-cabal-dep' created Message-ID: <20140822153822.83A3C24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/remove-cabal-dep Referencing: 1af0780fc57b5248444f94eacc86df46acf20821 From git at git.haskell.org Fri Aug 22 15:38:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 15:38:25 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Improve the ghc-pkg warnings for missing and out of date package cache files (d1b224b) Message-ID: <20140822153825.7ADAE24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/d1b224b95fa7b0c64b279c86ab981795bdd077df/ghc >--------------------------------------------------------------- commit d1b224b95fa7b0c64b279c86ab981795bdd077df Author: Duncan Coutts Date: Tue Aug 19 16:10:04 2014 +0100 Improve the ghc-pkg warnings for missing and out of date package cache files In particular, report when it's missing, and also report it for ghc-pkg check. Also make the warning message more explicit, that ghc will not be able to read these dbs, even though ghc-pkg may be able to. >--------------------------------------------------------------- d1b224b95fa7b0c64b279c86ab981795bdd077df utils/ghc-pkg/Main.hs | 61 ++++++++++++++++++++++++++++++++------------------- 1 file changed, 38 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 d1b224b95fa7b0c64b279c86ab981795bdd077df From git at git.haskell.org Fri Aug 22 15:38:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 15:38:28 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Drop support for single-file style package databases (3bf9cd3) Message-ID: <20140822153828.6E8D124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/3bf9cd34565428ecf13079daf6a059defc961b84/ghc >--------------------------------------------------------------- commit 3bf9cd34565428ecf13079daf6a059defc961b84 Author: Duncan Coutts Date: Tue Aug 19 13:23:56 2014 +0100 Drop support for single-file style package databases Historically the package db format was a single text file in Read/Show format containing [InstalledPackageInfo]. For several years now the default format has been a directory with one file per package, plus a binary cache. The old format cannot be supported under the new scheme where the compiler will not depend on the Cabal library (because it will not have access to the InstalledPackageInfo type) so we must drop support. It would still technically be possible to support a single text file style db (but containing a different type), but there does not seem to be any compelling reason to do so. (Part of preparitory work for removing the compiler's dep on Cabal) >--------------------------------------------------------------- 3bf9cd34565428ecf13079daf6a059defc961b84 compiler/main/Packages.lhs | 18 +++++++----------- utils/ghc-pkg/Main.hs | 19 +++++++------------ 2 files changed, 14 insertions(+), 23 deletions(-) diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 702c049..8bb56fd 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -74,7 +74,6 @@ import System.Directory import System.FilePath as FilePath import qualified System.FilePath.Posix as FilePath.Posix import Control.Monad -import Data.Char (isSpace) import Data.List as List import Data.Map (Map) import Data.Monoid hiding ((<>)) @@ -391,16 +390,13 @@ readPackageConfig dflags conf_file = do else do isfile <- doesFileExist conf_file - when (not isfile) $ - throwGhcExceptionIO $ InstallationError $ - "can't find a package database at " ++ conf_file - debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file) - str <- readFile conf_file - case reads str of - [(configs, rest)] - | all isSpace rest -> return (map installedPackageInfoToPackageConfig configs) - _ -> throwGhcExceptionIO $ InstallationError $ - "invalid package database file " ++ conf_file + if isfile + then throwGhcExceptionIO $ InstallationError $ + "ghc no longer supports single-file style package databases (" ++ + conf_file ++ + ") use 'ghc-pkg init' to create the database with the correct format." + else throwGhcExceptionIO $ InstallationError $ + "can't find a package database at " ++ conf_file let top_dir = topDir dflags diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 554640e..a2239b2 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -46,6 +46,7 @@ import System.Exit ( exitWith, ExitCode(..) ) import System.Environment ( getArgs, getProgName, getEnv ) import System.IO import System.IO.Error +import GHC.IO.Exception (IOErrorType(InappropriateType)) import Data.List import Control.Concurrent @@ -672,9 +673,12 @@ readParseDatabase verbosity mb_user_conf use_cache path | otherwise = do e <- tryIO $ getDirectoryContents path case e of - Left _ -> do - pkgs <- parseMultiPackageConf verbosity path - mkPackageDB pkgs + Left err + | ioeGetErrorType err == InappropriateType -> + die ("ghc no longer supports single-file style package databases (" + ++ path ++ ") use 'ghc-pkg init' to create the database with " + ++ "the correct format.") + | otherwise -> ioError err Right fs | not use_cache -> ignore_cache (const $ return ()) | otherwise -> do @@ -742,15 +746,6 @@ myReadBinPackageDB filepath = do hClose h return $ Bin.runGet Bin.get b -parseMultiPackageConf :: Verbosity -> FilePath -> IO [InstalledPackageInfo] -parseMultiPackageConf verbosity file = do - when (verbosity > Normal) $ infoLn ("reading package database: " ++ file) - str <- readUTF8File file - let pkgs = map convertPackageInfoIn $ read str - Exception.evaluate pkgs - `catchError` \e-> - die ("error while parsing " ++ file ++ ": " ++ show e) - parseSingletonPackageConf :: Verbosity -> FilePath -> IO InstalledPackageInfo parseSingletonPackageConf verbosity file = do when (verbosity > Normal) $ infoLn ("reading package config: " ++ file) From git at git.haskell.org Fri Aug 22 15:38:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 15:38:30 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Simplify conversion in binary serialisation of ghc-pkg db (4feb990) Message-ID: <20140822153830.BD3B724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/4feb9902dbc7c7b6a285a1a9611b8e5073acd9c8/ghc >--------------------------------------------------------------- commit 4feb9902dbc7c7b6a285a1a9611b8e5073acd9c8 Author: Duncan Coutts Date: Tue Aug 19 01:00:54 2014 +0100 Simplify conversion in binary serialisation of ghc-pkg db We can serialise directly, without having to convert some fields to string first. (Part of preparitory work for removing the compiler's dep on Cabal) >--------------------------------------------------------------- 4feb9902dbc7c7b6a285a1a9611b8e5073acd9c8 .../bin-package-db/Distribution/InstalledPackageInfo/Binary.hs | 6 ++++++ utils/ghc-pkg/Main.hs | 7 +++---- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs b/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs index baf8a05..9fd27f6 100644 --- a/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs +++ b/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs @@ -22,8 +22,10 @@ module Distribution.InstalledPackageInfo.Binary ( import Distribution.Version import Distribution.Package hiding (depends) import Distribution.License +import Distribution.ModuleName as ModuleName import Distribution.ModuleExport import Distribution.InstalledPackageInfo as IPI +import Distribution.Text (display) import Data.Binary as Bin import Control.Exception as Exception @@ -164,6 +166,10 @@ instance Binary Version where deriving instance Binary PackageName deriving instance Binary InstalledPackageId +instance Binary ModuleName where + put = put . display + get = fmap ModuleName.fromString get + instance Binary m => Binary (ModuleExport m) where put (ModuleExport a b c d) = do put a; put b; put c; put d get = do a <- get; b <- get; c <- get; d <- get; diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index c88b814..554640e 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -706,8 +706,7 @@ readParseDatabase verbosity mb_user_conf use_cache path when (verbosity > Normal) $ infoLn ("using cache: " ++ cache) pkgs <- myReadBinPackageDB cache - let pkgs' = map convertPackageInfoIn pkgs - mkPackageDB pkgs' + mkPackageDB pkgs else do when (verbosity >= Normal) $ do warn ("WARNING: cache is out of date: " @@ -735,7 +734,7 @@ readParseDatabase verbosity mb_user_conf use_cache path -- bytestring 0.9.0.x (fixed in 0.9.1.x) where the file wasn't closed -- after it has been completely read, leading to a sharing violation -- later. -myReadBinPackageDB :: FilePath -> IO [InstalledPackageInfoString] +myReadBinPackageDB :: FilePath -> IO [InstalledPackageInfo] myReadBinPackageDB filepath = do h <- openBinaryFile filepath ReadMode sz <- hFileSize h @@ -1021,7 +1020,7 @@ updateDBCache verbosity db = do let filename = location db cachefilename when (verbosity > Normal) $ infoLn ("writing cache " ++ filename) - writeBinaryFileAtomic filename (map convertPackageInfoOut (packages db)) + writeBinaryFileAtomic filename (packages db) `catchIO` \e -> if isPermissionError e then die (filename ++ ": you don't have permission to modify this file") From git at git.haskell.org Fri Aug 22 15:38:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 15:38:33 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Introduce new file format for the package database binary cache (d1e7a79) Message-ID: <20140822153833.DC57F24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/d1e7a792ee4f4e7b07147f33c20b5d9a332cfa45/ghc >--------------------------------------------------------------- commit d1e7a792ee4f4e7b07147f33c20b5d9a332cfa45 Author: Duncan Coutts Date: Tue Aug 19 20:33:10 2014 +0100 Introduce new file format for the package database binary cache The purpose of the new format is to make it possible for the compiler to not depend on the Cabal library. The new cache file format contains more or less the same information duplicated in two different sections using different representations. One section is basically the same as what the package db contains now, a list of packages using the types defined in the Cabal library. This section is read back by ghc-pkg, and used for things like ghc-pkg dump which have to produce output using the Cabal InstalledPackageInfo text representation. The other section is a ghc-local type which contains a subset of the information from the Cabal InstalledPackageInfo -- just the bits that the compiler cares about. The trick is that the compiler can read this second section without needing to know the representation (or types) of the first part. The ghc-pkg tool knows about both representations and writes both. This patch introduces the new cache file format but does not yet use it properly. More patches to follow. (As of this patch, the compiler reads the part intended for ghc-pkg so it still depends on Cabal and the ghc-local package type is not yet fully defined.) >--------------------------------------------------------------- d1e7a792ee4f4e7b07147f33c20b5d9a332cfa45 compiler/main/Packages.lhs | 6 +- .../Distribution/InstalledPackageInfo/Binary.hs | 19 +- libraries/bin-package-db/GHC/PackageDb.hs | 206 +++++++++++++++++++++ libraries/bin-package-db/bin-package-db.cabal | 18 +- utils/ghc-pkg/Main.hs | 33 ++-- 5 files changed, 238 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 d1e7a792ee4f4e7b07147f33c20b5d9a332cfa45 From git at git.haskell.org Fri Aug 22 15:38:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 15:38:36 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Use ghc-local types for packages, rather than Cabal types (da03192) Message-ID: <20140822153837.0159C24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/da03192dd06b63c85124cefbaf1eee1d0b2133a8/ghc >--------------------------------------------------------------- commit da03192dd06b63c85124cefbaf1eee1d0b2133a8 Author: Duncan Coutts Date: Fri Aug 22 14:38:10 2014 +0100 Use ghc-local types for packages, rather than Cabal types Also start using the new package db file format properly, by using the ghc-specific section. This is the main patch in the series for removing the compiler's dep on the Cabal lib. >--------------------------------------------------------------- da03192dd06b63c85124cefbaf1eee1d0b2133a8 compiler/ghci/Linker.lhs | 8 +- compiler/main/Finder.lhs | 19 ++- compiler/main/PackageConfig.hs | 124 ++++++++++++------- compiler/main/Packages.lhs | 74 ++++++------ libraries/bin-package-db/GHC/PackageDb.hs | 195 +++++++++++++++++++++++++++--- utils/ghc-pkg/Main.hs | 60 ++++++++- 6 files changed, 360 insertions(+), 120 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc da03192dd06b63c85124cefbaf1eee1d0b2133a8 From git at git.haskell.org Fri Aug 22 15:38:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 15:38:39 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Move Cabal Binary instances from bin-package-db to ghc-pkg itself (ee6e4e4) Message-ID: <20140822153839.94F5024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/ee6e4e411d32992bb50a34d8ffb1a63ffb917eb9/ghc >--------------------------------------------------------------- commit ee6e4e411d32992bb50a34d8ffb1a63ffb917eb9 Author: Duncan Coutts Date: Fri Aug 22 15:08:24 2014 +0100 Move Cabal Binary instances from bin-package-db to ghc-pkg itself The ghc-pkg program of course still depends on Cabal, it's just the bin-package-db library (shared between ghc and ghc-pkg) that does not. >--------------------------------------------------------------- ee6e4e411d32992bb50a34d8ffb1a63ffb917eb9 .../Distribution/InstalledPackageInfo/Binary.hs | 168 --------------------- libraries/bin-package-db/bin-package-db.cabal | 10 +- utils/ghc-pkg/Main.hs | 152 ++++++++++++++++++- 3 files changed, 152 insertions(+), 178 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ee6e4e411d32992bb50a34d8ffb1a63ffb917eb9 From git at git.haskell.org Fri Aug 22 15:38:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 15:38:41 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Drop ghc library dep on Cabal (7cf35e2) Message-ID: <20140822153841.ED78824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/7cf35e277fd928bed249ff4cca6ef65c7395daac/ghc >--------------------------------------------------------------- commit 7cf35e277fd928bed249ff4cca6ef65c7395daac Author: Duncan Coutts Date: Fri Aug 22 15:09:55 2014 +0100 Drop ghc library dep on Cabal >--------------------------------------------------------------- 7cf35e277fd928bed249ff4cca6ef65c7395daac compiler/ghc.cabal.in | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index d449ada..31220e4 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -52,7 +52,6 @@ Library containers >= 0.1 && < 0.6, array >= 0.1 && < 0.6, filepath >= 1 && < 1.4, - Cabal, hpc, transformers, bin-package-db, From git at git.haskell.org Fri Aug 22 15:38:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 15:38:44 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Make binary a boot package (cbab3c9) Message-ID: <20140822153844.815E224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/cbab3c99f126afbe59de5faaa3bd77317a002eeb/ghc >--------------------------------------------------------------- commit cbab3c99f126afbe59de5faaa3bd77317a002eeb Author: Duncan Coutts Date: Fri Aug 22 15:10:47 2014 +0100 Make binary a boot package Since ghc-pkg needs a relatively recent version. >--------------------------------------------------------------- cbab3c99f126afbe59de5faaa3bd77317a002eeb ghc.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghc.mk b/ghc.mk index 8ba90fe..fb93ef0 100644 --- a/ghc.mk +++ b/ghc.mk @@ -383,7 +383,7 @@ else # 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 = Cabal/Cabal hpc bin-package-db hoopl transformers +PACKAGES_STAGE0 = Cabal/Cabal hpc binary bin-package-db hoopl transformers ifeq "$(Windows_Host)" "NO" ifneq "$(HostOS_CPP)" "ios" PACKAGES_STAGE0 += terminfo From git at git.haskell.org Fri Aug 22 15:38:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 15:38:46 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Fix warnings arising from the package db refactoring (e0805af) Message-ID: <20140822153846.BE52424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/e0805afa5ef2690bd357e4444be55d08e290e60f/ghc >--------------------------------------------------------------- commit e0805afa5ef2690bd357e4444be55d08e290e60f Author: Duncan Coutts Date: Fri Aug 22 15:57:07 2014 +0100 Fix warnings arising from the package db refactoring >--------------------------------------------------------------- e0805afa5ef2690bd357e4444be55d08e290e60f libraries/bin-package-db/GHC/PackageDb.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/libraries/bin-package-db/GHC/PackageDb.hs b/libraries/bin-package-db/GHC/PackageDb.hs index 08dabd2..b29d707 100644 --- a/libraries/bin-package-db/GHC/PackageDb.hs +++ b/libraries/bin-package-db/GHC/PackageDb.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} -- This module deliberately defines orphan instances for now (Binary Version). -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.PackageDb @@ -246,10 +246,10 @@ writeFileAtomic targetPath content = do let (targetDir, targetName) = splitFileName targetPath Exception.bracketOnError (openBinaryTempFileWithDefaultPermissions targetDir $ targetName <.> "tmp") - (\(tmpPath, handle) -> hClose handle >> removeFile tmpPath) - (\(tmpPath, handle) -> do - BS.Lazy.hPut handle content - hClose handle + (\(tmpPath, hnd) -> hClose hnd >> removeFile tmpPath) + (\(tmpPath, hnd) -> do + BS.Lazy.hPut hnd content + hClose hnd #if mingw32_HOST_OS || mingw32_TARGET_OS renameFile tmpPath targetPath -- If the targetPath exists then renameFile will fail From git at git.haskell.org Fri Aug 22 15:38:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 15:38:49 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Fix more warnings, remove now-dead code (1af0780) Message-ID: <20140822153849.E5C4624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/1af0780fc57b5248444f94eacc86df46acf20821/ghc >--------------------------------------------------------------- commit 1af0780fc57b5248444f94eacc86df46acf20821 Author: Duncan Coutts Date: Fri Aug 22 16:37:16 2014 +0100 Fix more warnings, remove now-dead code Also remove more of the old file style ghc-pkg dbs that I missed previously. >--------------------------------------------------------------- 1af0780fc57b5248444f94eacc86df46acf20821 compiler/main/PackageConfig.hs | 1 + utils/ghc-pkg/Main.hs | 54 +++--------------------------------------- 2 files changed, 4 insertions(+), 51 deletions(-) diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs index 09ff065..63b2903 100644 --- a/compiler/main/PackageConfig.hs +++ b/compiler/main/PackageConfig.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Package configuration information: essentially the interface to Cabal, with diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index b95a784..858797f 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, RecordWildCards, GeneralizedNewtypeDeriving, StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 2004-2009. @@ -13,7 +14,6 @@ module Main (main) where import Version ( version, targetOS, targetARCH ) import qualified GHC.PackageDb as GhcPkg import qualified Distribution.Simple.PackageIndex as PackageIndex -import qualified Distribution.Package as Cabal import qualified Distribution.ModuleName as ModuleName import Distribution.ModuleName (ModuleName) import Distribution.InstalledPackageInfo as Cabal @@ -976,12 +976,8 @@ data DBOp = RemovePackage InstalledPackageInfo changeDB :: Verbosity -> [DBOp] -> PackageDB -> IO () changeDB verbosity cmds db = do let db' = updateInternalDB db cmds - isfile <- doesFileExist (location db) - if isfile - then writeNewConfig verbosity (location db') (packages db') - else do - createDirectoryIfMissing True (location db) - changeDBDir verbosity cmds db' + createDirectoryIfMissing True (location db) + changeDBDir verbosity cmds db' updateInternalDB :: PackageDB -> [DBOp] -> PackageDB updateInternalDB db cmds = db{ packages = foldl do_cmd (packages db) cmds } @@ -1451,46 +1447,6 @@ closure pkgs db_stack = go pkgs db_stack brokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo] brokenPackages pkgs = snd (closure [] pkgs) --- ----------------------------------------------------------------------------- --- Manipulating package.conf files - -type InstalledPackageInfoString = InstalledPackageInfo_ String - -convertPackageInfoOut :: InstalledPackageInfo -> InstalledPackageInfoString -convertPackageInfoOut - (pkgconf@(InstalledPackageInfo { exposedModules = e, - reexportedModules = r, - hiddenModules = h })) = - pkgconf{ exposedModules = map display e, - reexportedModules = map (fmap display) r, - hiddenModules = map display h } - -convertPackageInfoIn :: InstalledPackageInfoString -> InstalledPackageInfo -convertPackageInfoIn - (pkgconf@(InstalledPackageInfo { exposedModules = e, - reexportedModules = r, - hiddenModules = h })) = - pkgconf{ exposedModules = map convert e, - reexportedModules = map (fmap convert) r, - hiddenModules = map convert h } - where convert = fromJust . simpleParse - -writeNewConfig :: Verbosity -> FilePath -> [InstalledPackageInfo] -> IO () -writeNewConfig verbosity filename ipis = do - when (verbosity >= Normal) $ - info "Writing new package config file... " - createDirectoryIfMissing True $ takeDirectory filename - let shown = concat $ intersperse ",\n " - $ map (show . convertPackageInfoOut) ipis - fileContents = "[" ++ shown ++ "\n]" - writeFileUtf8Atomic filename fileContents - `catchIO` \e -> - if isPermissionError e - then die (filename ++ ": you don't have permission to modify this file") - else ioError e - when (verbosity >= Normal) $ - infoLn "done." - ----------------------------------------------------------------------------- -- Sanity-check a new package config, and automatically build GHCi libs -- if requested. @@ -1943,10 +1899,6 @@ throwIOIO = Exception.throwIO catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a catchIO = Exception.catch -catchError :: IO a -> (String -> IO a) -> IO a -catchError io handler = io `Exception.catch` handler' - where handler' (Exception.ErrorCall err) = handler err - tryIO :: IO a -> IO (Either Exception.IOException a) tryIO = Exception.try From git at git.haskell.org Fri Aug 22 17:01:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 17:01:51 +0000 (UTC) Subject: [commit: ghc] master: Enable GHC API tests by default. (d333c03) Message-ID: <20140822170152.0990624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d333c0313f0ec31c79cc72657e05f995bd69e376/ghc >--------------------------------------------------------------- commit d333c0313f0ec31c79cc72657e05f995bd69e376 Author: Edward Z. Yang Date: Fri Aug 22 18:01:43 2014 +0100 Enable GHC API tests by default. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- d333c0313f0ec31c79cc72657e05f995bd69e376 testsuite/tests/ghc-api/T4891/all.T | 2 +- testsuite/tests/ghc-api/all.T | 6 +++--- testsuite/tests/ghc-api/apirecomp001/all.T | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/ghc-api/T4891/all.T b/testsuite/tests/ghc-api/T4891/all.T index 64c2591..b9c08c3 100644 --- a/testsuite/tests/ghc-api/T4891/all.T +++ b/testsuite/tests/ghc-api/T4891/all.T @@ -1,3 +1,3 @@ -test('T4891', [when(fast(), skip), extra_clean(['X.hi', 'X.o'])], +test('T4891', extra_clean(['X.hi', 'X.o']), run_command, ['$MAKE -s --no-print-directory T4891']) diff --git a/testsuite/tests/ghc-api/all.T b/testsuite/tests/ghc-api/all.T index 1f83dcd..489b3ed 100644 --- a/testsuite/tests/ghc-api/all.T +++ b/testsuite/tests/ghc-api/all.T @@ -1,10 +1,10 @@ test('ghcApi', normal, compile_and_run, ['-package ghc']) -test('T6145', when(fast(), skip), +test('T6145', normal, run_command, ['$MAKE -s --no-print-directory T6145']) -test('T8639_api', when(fast(), skip), +test('T8639_api', normal, run_command, ['$MAKE -s --no-print-directory T8639_api']) -test('T8628', when(fast(), skip), +test('T8628', normal, run_command, ['$MAKE -s --no-print-directory T8628']) diff --git a/testsuite/tests/ghc-api/apirecomp001/all.T b/testsuite/tests/ghc-api/apirecomp001/all.T index f8f5abd..f58352a 100644 --- a/testsuite/tests/ghc-api/apirecomp001/all.T +++ b/testsuite/tests/ghc-api/apirecomp001/all.T @@ -1,4 +1,4 @@ test('apirecomp001', - when(fast(), skip), + normal, run_command, ['$MAKE -s --no-print-directory apirecomp001']) From git at git.haskell.org Fri Aug 22 22:23:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Aug 2014 22:23:26 +0000 (UTC) Subject: [commit: ghc] master: testsuite: T7815 requires SMP support from ghc (ff9f4ad) Message-ID: <20140822222326.7173924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ff9f4ad38521e54c5284f9bf4599c3baaefeb228/ghc >--------------------------------------------------------------- commit ff9f4ad38521e54c5284f9bf4599c3baaefeb228 Author: Sergei Trofimovich Date: Sat Aug 23 01:20:11 2014 +0300 testsuite: T7815 requires SMP support from ghc Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- ff9f4ad38521e54c5284f9bf4599c3baaefeb228 testsuite/tests/rts/all.T | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 59114bd..1549fe2 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -191,6 +191,7 @@ test('stablename001', expect_fail_for(['hpc']), compile_and_run, ['']) test('T7815', [ multi_cpu_race, extra_run_opts('50000 +RTS -N2 -RTS'), + req_smp, only_ways(['threaded1', 'threaded2']) ], compile_and_run, [''] ) # ignore_output because it contains a unique: From git at git.haskell.org Sat Aug 23 08:59:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 23 Aug 2014 08:59:52 +0000 (UTC) Subject: [commit: ghc] master: testsuite: disable memcpy asm comparison tests on UNREG (eb64be7) Message-ID: <20140823085953.0B36224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eb64be7b40b7f29144ebbf9c947e729535a8fd3d/ghc >--------------------------------------------------------------- commit eb64be7b40b7f29144ebbf9c947e729535a8fd3d Author: Sergei Trofimovich Date: Sat Aug 23 11:22:59 2014 +0300 testsuite: disable memcpy asm comparison tests on UNREG Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- eb64be7b40b7f29144ebbf9c947e729535a8fd3d testsuite/tests/codeGen/should_gen_asm/all.T | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/testsuite/tests/codeGen/should_gen_asm/all.T b/testsuite/tests/codeGen/should_gen_asm/all.T index 9cd3b45..db5fdaf 100644 --- a/testsuite/tests/codeGen/should_gen_asm/all.T +++ b/testsuite/tests/codeGen/should_gen_asm/all.T @@ -1,8 +1,9 @@ -test('memcpy', - unless(platform('x86_64-unknown-linux'),skip), compile_cmp_asm, ['']) -test('memcpy-unroll', - unless(platform('x86_64-unknown-linux'),skip), compile_cmp_asm, ['']) -test('memcpy-unroll-conprop', - unless(platform('x86_64-unknown-linux'),skip), compile_cmp_asm, ['']) -test('memset-unroll', - unless(platform('x86_64-unknown-linux'),skip), compile_cmp_asm, ['']) +is_amd64_codegen = [ + unless(platform('x86_64-unknown-linux'),skip), + when(unregisterised, skip), +] + +test('memcpy', is_amd64_codegen, compile_cmp_asm, ['']) +test('memcpy-unroll', is_amd64_codegen, compile_cmp_asm, ['']) +test('memcpy-unroll-conprop', is_amd64_codegen, compile_cmp_asm, ['']) +test('memset-unroll', is_amd64_codegen, compile_cmp_asm, ['']) From git at git.haskell.org Sat Aug 23 08:59:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 23 Aug 2014 08:59:55 +0000 (UTC) Subject: [commit: ghc] master: testsuite: disable gcc's warnings about casts of incompatible prototypes in UNREG (fcdd58d) Message-ID: <20140823085955.5E76024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fcdd58d2ddcfd8d420adbcb3f20c1d666bc834e6/ghc >--------------------------------------------------------------- commit fcdd58d2ddcfd8d420adbcb3f20c1d666bc834e6 Author: Sergei Trofimovich Date: Sat Aug 23 11:01:16 2014 +0300 testsuite: disable gcc's warnings about casts of incompatible prototypes in UNREG Haskell's 'foreign import' declaraion does not have a way to extress exact C prototypes (it ignores 'const' modifiers, exact pointer types, etc.) which leads to warnings when C backend generates calls to such functions: /tmp/ghc32698_0/ghc32698_10.hc:52:5: warning: conflicting types for built-in function ?strlen? [enabled by default] EF_(strlen); ^ Patch disables builtin functions for UNREG build to workaround test failures due to stderr mismatch. Fixes the following test failures: TEST="safePkg01 T5423 T7574 T3736" Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- fcdd58d2ddcfd8d420adbcb3f20c1d666bc834e6 testsuite/mk/test.mk | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index d6e550f..2ff8616 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -25,6 +25,13 @@ COMPILER = ghc CONFIGDIR = $(TOP)/config CONFIG = $(CONFIGDIR)/$(COMPILER) +ifeq "$(GhcUnregisterised)" "YES" + # Otherwise C backend generates many warnings about + # imcompatible proto casts for GCC's buitins: + # memcpy, printf, strlen. + EXTRA_HC_OPTS += -optc-fno-builtin +endif + # TEST_HC_OPTS is passed to every invocation of TEST_HC # in nested Makefiles TEST_HC_OPTS = -fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -no-user-$(GhcPackageDbFlag) -rtsopts $(EXTRA_HC_OPTS) From git at git.haskell.org Sat Aug 23 08:59:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 23 Aug 2014 08:59:57 +0000 (UTC) Subject: [commit: ghc] master: testsuite: mark testwsdeque mark as faulty on NOSMP builds (2fcb36e) Message-ID: <20140823085957.E01B824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2fcb36e41f46f80f75e2f245a1a45457f0f7d6d2/ghc >--------------------------------------------------------------- commit 2fcb36e41f46f80f75e2f245a1a45457f0f7d6d2 Author: Sergei Trofimovich Date: Sat Aug 23 11:32:05 2014 +0300 testsuite: mark testwsdeque mark as faulty on NOSMP builds Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 2fcb36e41f46f80f75e2f245a1a45457f0f7d6d2 testsuite/tests/rts/all.T | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 1549fe2..0eb54ba 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -49,6 +49,7 @@ test('T2783', [ omit_ways(['ghci']), exit_code(1) ], compile_and_run, ['']) # Test the work-stealing deque implementation. We run this test in # both threaded1 (-threaded -debug) and threaded2 (-threaded) ways. test('testwsdeque', [unless(in_tree_compiler(), skip), + req_smp, # needs atomic 'cas' c_src, only_ways(['threaded1', 'threaded2'])], compile_and_run, ['-I../../../rts']) From git at git.haskell.org Sat Aug 23 11:39:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 23 Aug 2014 11:39:26 +0000 (UTC) Subject: [commit: ghc] master: rts/Linker.c: declare 'deRefStablePtr' as an exported 'rts' symbol (104a66a) Message-ID: <20140823113926.26FB224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/104a66a461f4f89b8e5ad9c829923bb7ca8ceddb/ghc >--------------------------------------------------------------- commit 104a66a461f4f89b8e5ad9c829923bb7ca8ceddb Author: Sergei Trofimovich Date: Sat Aug 23 13:11:23 2014 +0300 rts/Linker.c: declare 'deRefStablePtr' as an exported 'rts' symbol $ inplace/bin/ghc-stage2 -fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -no-user-package-db -rtsopts -optc-fno-builtin -fno-ghci-history \ testsuite/tests/ffi/should_run/T4038.hs --interactive -v0 -ignore-dot-ghci +RTS -I0.1 -RTS *Main> main : /tmp/ghc16668_0/ghc16668_5.o: unknown symbol `deRefStablePtr' The reference to 'deRefStablePtr' is generated by 'compiler/deSugar/DsForeign.lhs': the_cfun = case maybe_target of Nothing -> text "(StgClosure*)deRefStablePtr(the_stableptr)" Just hs_fn -> char '&' <> ppr hs_fn <> text "_closure" Patch fixes all broken tests using 'import wrapper': TEST="ffi013 ffi010 ffi011 ffi005 ffi020 ffi006 ffi019 fed001 T1679 T4038" Tests manifested as broken only in DYNAMIC_GHC_PROGRAMS=NO builds, where GHCi's custom linker is used instead of system's linker. Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 104a66a461f4f89b8e5ad9c829923bb7ca8ceddb rts/Linker.c | 1 + 1 file changed, 1 insertion(+) diff --git a/rts/Linker.c b/rts/Linker.c index e97580d..b24be58 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1092,6 +1092,7 @@ typedef struct _RtsSymbolVal { SymI_HasProto(__word_encodeFloat) \ SymI_HasProto(stg_atomicallyzh) \ SymI_HasProto(barf) \ + SymI_HasProto(deRefStablePtr) \ SymI_HasProto(debugBelch) \ SymI_HasProto(errorBelch) \ SymI_HasProto(sysErrorBelch) \ From git at git.haskell.org Sat Aug 23 18:56:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 23 Aug 2014 18:56:14 +0000 (UTC) Subject: [commit: ghc] master: Add MO_AddIntC, MO_SubIntC MachOps and implement in X86 backend (cfd08a9) Message-ID: <20140823185614.65DDD24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cfd08a992c91c0a9c629912a5d7234610256121e/ghc >--------------------------------------------------------------- commit cfd08a992c91c0a9c629912a5d7234610256121e Author: Reid Barton Date: Fri Aug 22 18:57:50 2014 -0400 Add MO_AddIntC, MO_SubIntC MachOps and implement in X86 backend Summary: These MachOps are used by addIntC# and subIntC#, which in turn are used in integer-gmp when adding or subtracting small Integers. The following benchmark shows a ~6% speedup after this commit on x86_64 (building GHC with BuildFlavour=perf). {-# LANGUAGE MagicHash #-} import GHC.Exts import Criterion.Main count :: Int -> Integer count (I# n#) = go n# 0 where go :: Int# -> Integer -> Integer go 0# acc = acc go n# acc = go (n# -# 1#) $! acc + 1 main = defaultMain [bgroup "count" [bench "100" $ whnf count 100]] Differential Revision: https://phabricator.haskell.org/D140 >--------------------------------------------------------------- cfd08a992c91c0a9c629912a5d7234610256121e compiler/cmm/CmmMachOp.hs | 2 ++ compiler/cmm/PprC.hs | 2 ++ compiler/codeGen/StgCmmPrim.hs | 6 ++++-- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 2 ++ compiler/nativeGen/PPC/CodeGen.hs | 2 ++ compiler/nativeGen/SPARC/CodeGen.hs | 2 ++ compiler/nativeGen/X86/CodeGen.hs | 20 ++++++++++++++++++++ compiler/nativeGen/X86/Instr.hs | 3 +++ compiler/nativeGen/X86/Ppr.hs | 2 ++ 9 files changed, 39 insertions(+), 2 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc cfd08a992c91c0a9c629912a5d7234610256121e From git at git.haskell.org Sun Aug 24 18:58:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 18:58:03 +0000 (UTC) Subject: [commit: ghc] master: testsuite: added 'bytes allocated' for T9339 wordsize(32) (e1d77a1) Message-ID: <20140824185805.8DF4D24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e1d77a1ae619efc4bfe7ce30d7c6b2031ed86f2f/ghc >--------------------------------------------------------------- commit e1d77a1ae619efc4bfe7ce30d7c6b2031ed86f2f Author: Sergei Trofimovich Date: Sun Aug 24 20:46:44 2014 +0300 testsuite: added 'bytes allocated' for T9339 wordsize(32) Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- e1d77a1ae619efc4bfe7ce30d7c6b2031ed86f2f testsuite/tests/perf/should_run/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 8b8547e..1bf0143 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -382,7 +382,8 @@ test('T9203', test('T9339', [stats_num_field('bytes allocated', - [ (wordsize(64), 80050760, 5) ]), + [ (wordsize(32), 40046844, 5) + , (wordsize(64), 80050760, 5) ]), # w/o fusing last: 320005080 # 2014-07-22: 80050760 only_ways(['normal'])], From git at git.haskell.org Sun Aug 24 22:47:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:16 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Drop support for single-file style package databases (1b76455) Message-ID: <20140824224716.ED7BA24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/1b7645564c04a32adefecb14da2959aaa5409560/ghc >--------------------------------------------------------------- commit 1b7645564c04a32adefecb14da2959aaa5409560 Author: Duncan Coutts Date: Tue Aug 19 13:23:56 2014 +0100 Drop support for single-file style package databases Historically the package db format was a single text file in Read/Show format containing [InstalledPackageInfo]. For several years now the default format has been a directory with one file per package, plus a binary cache. The old format cannot be supported under the new scheme where the compiler will not depend on the Cabal library (because it will not have access to the InstalledPackageInfo type) so we must drop support. It would still technically be possible to support a single text file style db (but containing a different type), but there does not seem to be any compelling reason to do so. (Part of preparitory work for removing the compiler's dep on Cabal) >--------------------------------------------------------------- 1b7645564c04a32adefecb14da2959aaa5409560 compiler/main/Packages.lhs | 18 +++++-------- utils/ghc-pkg/Main.hs | 67 +++++++--------------------------------------- 2 files changed, 16 insertions(+), 69 deletions(-) diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 702c049..8bb56fd 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -74,7 +74,6 @@ import System.Directory import System.FilePath as FilePath import qualified System.FilePath.Posix as FilePath.Posix import Control.Monad -import Data.Char (isSpace) import Data.List as List import Data.Map (Map) import Data.Monoid hiding ((<>)) @@ -391,16 +390,13 @@ readPackageConfig dflags conf_file = do else do isfile <- doesFileExist conf_file - when (not isfile) $ - throwGhcExceptionIO $ InstallationError $ - "can't find a package database at " ++ conf_file - debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file) - str <- readFile conf_file - case reads str of - [(configs, rest)] - | all isSpace rest -> return (map installedPackageInfoToPackageConfig configs) - _ -> throwGhcExceptionIO $ InstallationError $ - "invalid package database file " ++ conf_file + if isfile + then throwGhcExceptionIO $ InstallationError $ + "ghc no longer supports single-file style package databases (" ++ + conf_file ++ + ") use 'ghc-pkg init' to create the database with the correct format." + else throwGhcExceptionIO $ InstallationError $ + "can't find a package database at " ++ conf_file let top_dir = topDir dflags diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 554640e..3825e4e 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -46,6 +46,7 @@ import System.Exit ( exitWith, ExitCode(..) ) import System.Environment ( getArgs, getProgName, getEnv ) import System.IO import System.IO.Error +import GHC.IO.Exception (IOErrorType(InappropriateType)) import Data.List import Control.Concurrent @@ -672,9 +673,12 @@ readParseDatabase verbosity mb_user_conf use_cache path | otherwise = do e <- tryIO $ getDirectoryContents path case e of - Left _ -> do - pkgs <- parseMultiPackageConf verbosity path - mkPackageDB pkgs + Left err + | ioeGetErrorType err == InappropriateType -> + die ("ghc no longer supports single-file style package databases (" + ++ path ++ ") use 'ghc-pkg init' to create the database with " + ++ "the correct format.") + | otherwise -> ioError err Right fs | not use_cache -> ignore_cache (const $ return ()) | otherwise -> do @@ -742,15 +746,6 @@ myReadBinPackageDB filepath = do hClose h return $ Bin.runGet Bin.get b -parseMultiPackageConf :: Verbosity -> FilePath -> IO [InstalledPackageInfo] -parseMultiPackageConf verbosity file = do - when (verbosity > Normal) $ infoLn ("reading package database: " ++ file) - str <- readUTF8File file - let pkgs = map convertPackageInfoIn $ read str - Exception.evaluate pkgs - `catchError` \e-> - die ("error while parsing " ++ file ++ ": " ++ show e) - parseSingletonPackageConf :: Verbosity -> FilePath -> IO InstalledPackageInfo parseSingletonPackageConf verbosity file = do when (verbosity > Normal) $ infoLn ("reading package config: " ++ file) @@ -982,12 +977,8 @@ data DBOp = RemovePackage InstalledPackageInfo changeDB :: Verbosity -> [DBOp] -> PackageDB -> IO () changeDB verbosity cmds db = do let db' = updateInternalDB db cmds - isfile <- doesFileExist (location db) - if isfile - then writeNewConfig verbosity (location db') (packages db') - else do - createDirectoryIfMissing True (location db) - changeDBDir verbosity cmds db' + createDirectoryIfMissing True (location db) + changeDBDir verbosity cmds db' updateInternalDB :: PackageDB -> [DBOp] -> PackageDB updateInternalDB db cmds = db{ packages = foldl do_cmd (packages db) cmds } @@ -1397,46 +1388,6 @@ closure pkgs db_stack = go pkgs db_stack brokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo] brokenPackages pkgs = snd (closure [] pkgs) --- ----------------------------------------------------------------------------- --- Manipulating package.conf files - -type InstalledPackageInfoString = InstalledPackageInfo_ String - -convertPackageInfoOut :: InstalledPackageInfo -> InstalledPackageInfoString -convertPackageInfoOut - (pkgconf@(InstalledPackageInfo { exposedModules = e, - reexportedModules = r, - hiddenModules = h })) = - pkgconf{ exposedModules = map display e, - reexportedModules = map (fmap display) r, - hiddenModules = map display h } - -convertPackageInfoIn :: InstalledPackageInfoString -> InstalledPackageInfo -convertPackageInfoIn - (pkgconf@(InstalledPackageInfo { exposedModules = e, - reexportedModules = r, - hiddenModules = h })) = - pkgconf{ exposedModules = map convert e, - reexportedModules = map (fmap convert) r, - hiddenModules = map convert h } - where convert = fromJust . simpleParse - -writeNewConfig :: Verbosity -> FilePath -> [InstalledPackageInfo] -> IO () -writeNewConfig verbosity filename ipis = do - when (verbosity >= Normal) $ - info "Writing new package config file... " - createDirectoryIfMissing True $ takeDirectory filename - let shown = concat $ intersperse ",\n " - $ map (show . convertPackageInfoOut) ipis - fileContents = "[" ++ shown ++ "\n]" - writeFileUtf8Atomic filename fileContents - `catchIO` \e -> - if isPermissionError e - then die (filename ++ ": you don't have permission to modify this file") - else ioError e - when (verbosity >= Normal) $ - infoLn "done." - ----------------------------------------------------------------------------- -- Sanity-check a new package config, and automatically build GHCi libs -- if requested. From git at git.haskell.org Sun Aug 24 22:47:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:19 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Improve the ghc-pkg warnings for missing and out of date package cache files (819e28f) Message-ID: <20140824224719.86F9D24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/819e28fad20c09ae2a0b448dda4e9bfbcdae4950/ghc >--------------------------------------------------------------- commit 819e28fad20c09ae2a0b448dda4e9bfbcdae4950 Author: Duncan Coutts Date: Tue Aug 19 16:10:04 2014 +0100 Improve the ghc-pkg warnings for missing and out of date package cache files In particular, report when it's missing, and also report it for ghc-pkg check. Also make the warning message more explicit, that ghc will not be able to read these dbs, even though ghc-pkg may be able to. >--------------------------------------------------------------- 819e28fad20c09ae2a0b448dda4e9bfbcdae4950 utils/ghc-pkg/Main.hs | 61 ++++++++++++++++++++++++++++++++------------------- 1 file changed, 38 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 819e28fad20c09ae2a0b448dda4e9bfbcdae4950 From git at git.haskell.org Sun Aug 24 22:47:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:22 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Introduce new file format for the package database binary cache (a54d9a9) Message-ID: <20140824224722.A7B5B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/a54d9a90c57241067f7f8740efea7d25c75c6318/ghc >--------------------------------------------------------------- commit a54d9a90c57241067f7f8740efea7d25c75c6318 Author: Duncan Coutts Date: Tue Aug 19 20:33:10 2014 +0100 Introduce new file format for the package database binary cache The purpose of the new format is to make it possible for the compiler to not depend on the Cabal library. The new cache file format contains more or less the same information duplicated in two different sections using different representations. One section is basically the same as what the package db contains now, a list of packages using the types defined in the Cabal library. This section is read back by ghc-pkg, and used for things like ghc-pkg dump which have to produce output using the Cabal InstalledPackageInfo text representation. The other section is a ghc-local type which contains a subset of the information from the Cabal InstalledPackageInfo -- just the bits that the compiler cares about. The trick is that the compiler can read this second section without needing to know the representation (or types) of the first part. The ghc-pkg tool knows about both representations and writes both. This patch introduces the new cache file format but does not yet use it properly. More patches to follow. (As of this patch, the compiler reads the part intended for ghc-pkg so it still depends on Cabal and the ghc-local package type is not yet fully defined.) >--------------------------------------------------------------- a54d9a90c57241067f7f8740efea7d25c75c6318 compiler/main/Packages.lhs | 6 +- .../Distribution/InstalledPackageInfo/Binary.hs | 19 +- libraries/bin-package-db/GHC/PackageDb.hs | 206 +++++++++++++++++++++ libraries/bin-package-db/bin-package-db.cabal | 18 +- utils/ghc-pkg/Main.hs | 33 ++-- 5 files changed, 238 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 a54d9a90c57241067f7f8740efea7d25c75c6318 From git at git.haskell.org Sun Aug 24 22:47:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:24 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Use ghc-local types for packages, rather than Cabal types (8e3fdcb) Message-ID: <20140824224724.9118A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/8e3fdcb6e406ebf9ff6cfd62350663923e6c6e79/ghc >--------------------------------------------------------------- commit 8e3fdcb6e406ebf9ff6cfd62350663923e6c6e79 Author: Duncan Coutts Date: Fri Aug 22 14:38:10 2014 +0100 Use ghc-local types for packages, rather than Cabal types Also start using the new package db file format properly, by using the ghc-specific section. This is the main patch in the series for removing the compiler's dep on the Cabal lib. >--------------------------------------------------------------- 8e3fdcb6e406ebf9ff6cfd62350663923e6c6e79 compiler/ghci/Linker.lhs | 8 +- compiler/main/Finder.lhs | 19 ++- compiler/main/PackageConfig.hs | 124 ++++++++++++------- compiler/main/Packages.lhs | 74 ++++++------ libraries/bin-package-db/GHC/PackageDb.hs | 195 +++++++++++++++++++++++++++--- utils/ghc-pkg/Main.hs | 60 ++++++++- 6 files changed, 360 insertions(+), 120 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8e3fdcb6e406ebf9ff6cfd62350663923e6c6e79 From git at git.haskell.org Sun Aug 24 22:47:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:26 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Move Cabal Binary instances from bin-package-db to ghc-pkg itself (00816ee) Message-ID: <20140824224727.08C9B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/00816eef3ac657bf84ed96638f030bcbfa395f9f/ghc >--------------------------------------------------------------- commit 00816eef3ac657bf84ed96638f030bcbfa395f9f Author: Duncan Coutts Date: Fri Aug 22 15:08:24 2014 +0100 Move Cabal Binary instances from bin-package-db to ghc-pkg itself The ghc-pkg program of course still depends on Cabal, it's just the bin-package-db library (shared between ghc and ghc-pkg) that does not. >--------------------------------------------------------------- 00816eef3ac657bf84ed96638f030bcbfa395f9f .../Distribution/InstalledPackageInfo/Binary.hs | 168 --------------------- libraries/bin-package-db/bin-package-db.cabal | 10 +- utils/ghc-pkg/Main.hs | 152 ++++++++++++++++++- 3 files changed, 152 insertions(+), 178 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 00816eef3ac657bf84ed96638f030bcbfa395f9f From git at git.haskell.org Sun Aug 24 22:47:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:29 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Make binary a boot package (692116f) Message-ID: <20140824224729.7290924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/692116f32408bf691431e19b31c456ae0df911b5/ghc >--------------------------------------------------------------- commit 692116f32408bf691431e19b31c456ae0df911b5 Author: Duncan Coutts Date: Fri Aug 22 15:10:47 2014 +0100 Make binary a boot package Since ghc-pkg needs a relatively recent version. >--------------------------------------------------------------- 692116f32408bf691431e19b31c456ae0df911b5 ghc.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghc.mk b/ghc.mk index 8ba90fe..fb93ef0 100644 --- a/ghc.mk +++ b/ghc.mk @@ -383,7 +383,7 @@ else # 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 = Cabal/Cabal hpc bin-package-db hoopl transformers +PACKAGES_STAGE0 = Cabal/Cabal hpc binary bin-package-db hoopl transformers ifeq "$(Windows_Host)" "NO" ifneq "$(HostOS_CPP)" "ios" PACKAGES_STAGE0 += terminfo From git at git.haskell.org Sun Aug 24 22:47:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:31 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Drop ghc library dep on Cabal (b87a05e) Message-ID: <20140824224731.F24FD24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/b87a05e3130fe55488cac3cfabd87abe05ababe0/ghc >--------------------------------------------------------------- commit b87a05e3130fe55488cac3cfabd87abe05ababe0 Author: Duncan Coutts Date: Fri Aug 22 15:09:55 2014 +0100 Drop ghc library dep on Cabal >--------------------------------------------------------------- b87a05e3130fe55488cac3cfabd87abe05ababe0 compiler/ghc.cabal.in | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index d449ada..31220e4 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -52,7 +52,6 @@ Library containers >= 0.1 && < 0.6, array >= 0.1 && < 0.6, filepath >= 1 && < 1.4, - Cabal, hpc, transformers, bin-package-db, From git at git.haskell.org Sun Aug 24 22:47:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:34 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Fix warnings arising from the package db refactoring (7925a43) Message-ID: <20140824224734.699C924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/7925a43240e7155274f723f0d9a7b5335aff7473/ghc >--------------------------------------------------------------- commit 7925a43240e7155274f723f0d9a7b5335aff7473 Author: Duncan Coutts Date: Fri Aug 22 15:57:07 2014 +0100 Fix warnings arising from the package db refactoring >--------------------------------------------------------------- 7925a43240e7155274f723f0d9a7b5335aff7473 libraries/bin-package-db/GHC/PackageDb.hs | 10 +++++----- utils/ghc-pkg/Main.hs | 6 +----- 2 files changed, 6 insertions(+), 10 deletions(-) diff --git a/libraries/bin-package-db/GHC/PackageDb.hs b/libraries/bin-package-db/GHC/PackageDb.hs index 08dabd2..b29d707 100644 --- a/libraries/bin-package-db/GHC/PackageDb.hs +++ b/libraries/bin-package-db/GHC/PackageDb.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} -- This module deliberately defines orphan instances for now (Binary Version). -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.PackageDb @@ -246,10 +246,10 @@ writeFileAtomic targetPath content = do let (targetDir, targetName) = splitFileName targetPath Exception.bracketOnError (openBinaryTempFileWithDefaultPermissions targetDir $ targetName <.> "tmp") - (\(tmpPath, handle) -> hClose handle >> removeFile tmpPath) - (\(tmpPath, handle) -> do - BS.Lazy.hPut handle content - hClose handle + (\(tmpPath, hnd) -> hClose hnd >> removeFile tmpPath) + (\(tmpPath, hnd) -> do + BS.Lazy.hPut hnd content + hClose hnd #if mingw32_HOST_OS || mingw32_TARGET_OS renameFile tmpPath targetPath -- If the targetPath exists then renameFile will fail diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index d9af8fb..858797f 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, RecordWildCards, GeneralizedNewtypeDeriving, StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 2004-2009. @@ -13,7 +14,6 @@ module Main (main) where import Version ( version, targetOS, targetARCH ) import qualified GHC.PackageDb as GhcPkg import qualified Distribution.Simple.PackageIndex as PackageIndex -import qualified Distribution.Package as Cabal import qualified Distribution.ModuleName as ModuleName import Distribution.ModuleName (ModuleName) import Distribution.InstalledPackageInfo as Cabal @@ -1899,10 +1899,6 @@ throwIOIO = Exception.throwIO catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a catchIO = Exception.catch -catchError :: IO a -> (String -> IO a) -> IO a -catchError io handler = io `Exception.catch` handler' - where handler' (Exception.ErrorCall err) = handler err - tryIO :: IO a -> IO (Either Exception.IOException a) tryIO = Exception.try From git at git.haskell.org Sun Aug 24 22:47:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:36 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Fix long lines and trailing whitespace (4f4dd1c) Message-ID: <20140824224736.D003324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/4f4dd1c312c16a43f964f2bdbb763d8fdd9191e2/ghc >--------------------------------------------------------------- commit 4f4dd1c312c16a43f964f2bdbb763d8fdd9191e2 Author: Duncan Coutts Date: Sat Aug 23 13:12:20 2014 +0100 Fix long lines and trailing whitespace in the previous patches in this series >--------------------------------------------------------------- 4f4dd1c312c16a43f964f2bdbb763d8fdd9191e2 compiler/ghci/Linker.lhs | 10 ++-- compiler/main/Finder.lhs | 5 +- compiler/main/PackageConfig.hs | 0 compiler/main/Packages.lhs | 14 ++++-- libraries/bin-package-db/GHC/PackageDb.hs | 21 ++++---- utils/ghc-pkg/Main.hs | 81 ++++++++++++++++++------------- 6 files changed, 78 insertions(+), 53 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4f4dd1c312c16a43f964f2bdbb763d8fdd9191e2 From git at git.haskell.org Sun Aug 24 22:47:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:39 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Remove a TODO that is now done (cd4edf2) Message-ID: <20140824224739.48EE724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/cd4edf2b20d606d87514836417f870c506a515d6/ghc >--------------------------------------------------------------- commit cd4edf2b20d606d87514836417f870c506a515d6 Author: Duncan Coutts Date: Sun Aug 24 03:41:45 2014 +0100 Remove a TODO that is now done >--------------------------------------------------------------- cd4edf2b20d606d87514836417f870c506a515d6 compiler/main/Packages.lhs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 9640f72..9b18a33 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -383,10 +383,6 @@ readPackageConfig dflags conf_file = do then do let filename = conf_file "package.cache" debugTraceMsg dflags 2 (text "Using binary package database:" <+> text filename) readPackageDbForGhc filename -{- - -- TODO readPackageDbForGhc ^^ instead - return (map installedPackageInfoToPackageConfig conf) --} else do isfile <- doesFileExist conf_file if isfile From git at git.haskell.org Sun Aug 24 22:47:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:41 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Add a ghc -show-packages mode to display ghc's view of the package env (22b2cf5) Message-ID: <20140824224742.ACA0E24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/22b2cf5b12fc3a48eb504c89688a9dbae8d43d0d/ghc >--------------------------------------------------------------- commit 22b2cf5b12fc3a48eb504c89688a9dbae8d43d0d Author: Duncan Coutts Date: Sun Aug 24 03:38:39 2014 +0100 Add a ghc -show-packages mode to display ghc's view of the package env You can use ghc -show-packages, in addition to any -package -package-conf -hide-package, etc flags and see just what ghc's package info looks like. The format is much like ghc-pkg show. Like the existing verbose tracing, but a specific mode. Re-introduce pretty printed package info (Cabal handled this previously). >--------------------------------------------------------------- 22b2cf5b12fc3a48eb504c89688a9dbae8d43d0d compiler/main/PackageConfig.hs | 41 +++++++++++++++++++++++++++++++---------- compiler/main/Packages.lhs | 27 +++++++++++++-------------- ghc/Main.hs | 16 +++++++++++++--- 3 files changed, 57 insertions(+), 27 deletions(-) diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs index 7cd2779..3124e29 100644 --- a/compiler/main/PackageConfig.hs +++ b/compiler/main/PackageConfig.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, RecordWildCards #-} -- | -- Package configuration information: essentially the interface to Cabal, with @@ -23,7 +23,7 @@ module PackageConfig ( installedPackageIdString, sourcePackageIdString, packageNameString, - showInstalledPackageInfo, + pprPackageConfig, ) where #include "HsVersions.h" @@ -97,14 +97,35 @@ packageNameString pkg = str where PackageName str = packageName pkg -showInstalledPackageInfo :: PackageConfig -> String -showInstalledPackageInfo = show - -instance Show ModuleName where - show = moduleNameString - -instance Show PackageKey where - show = packageKeyString +pprPackageConfig :: PackageConfig -> SDoc +pprPackageConfig InstalledPackageInfo {..} = + vcat [ + field "name" (ppr packageName), + field "version" (text (showVersion packageVersion)), + field "id" (ppr installedPackageId), + field "key" (ppr packageKey), + field "exposed" (ppr exposed), + field "exposed-modules" (fsep (map ppr exposedModules)), + field "hidden-modules" (fsep (map ppr hiddenModules)), + field "reexported-modules" (fsep (map ppr haddockHTMLs)), + field "trusted" (ppr trusted), + field "import-dirs" (fsep (map text importDirs)), + field "library-dirs" (fsep (map text libraryDirs)), + field "hs-libraries" (fsep (map text hsLibraries)), + field "extra-libraries" (fsep (map text extraLibraries)), + field "extra-ghci-libraries" (fsep (map text extraGHCiLibraries)), + field "include-dirs" (fsep (map text includeDirs)), + field "includes" (fsep (map text includes)), + field "depends" (fsep (map ppr depends)), + field "cc-options" (fsep (map text ccOptions)), + field "ld-options" (fsep (map text ldOptions)), + field "framework-dirs" (fsep (map text frameworkDirs)), + field "frameworks" (fsep (map text frameworks)), + field "haddock-interfaces" (fsep (map text haddockInterfaces)), + field "haddock-html" (fsep (map text haddockHTMLs)) + ] + where + field name body = text name <> colon <+> nest 4 body -- ----------------------------------------------------------------------------- diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 9b18a33..af2d3fe 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -16,8 +16,6 @@ module Packages ( lookupPackage, resolveInstalledPackageId, searchPackageId, - dumpPackages, - simpleDumpPackages, getPackageDetails, listVisibleModuleNames, lookupModuleInAllPackages, @@ -42,6 +40,8 @@ module Packages ( -- * Utils packageKeyPackageIdString, pprFlag, + pprPackages, + pprPackagesSimple, pprModuleMap, isDllName ) @@ -63,7 +63,7 @@ import Maybes import System.Environment ( getEnv ) import FastString -import ErrUtils ( debugTraceMsg, putMsg, MsgDoc ) +import ErrUtils ( debugTraceMsg, MsgDoc ) import Exception import Unique @@ -1422,21 +1422,20 @@ isDllName dflags _this_pkg this_mod name -- ----------------------------------------------------------------------------- -- Displaying packages --- | Show (very verbose) package info on console, if verbosity is >= 5 -dumpPackages :: DynFlags -> IO () -dumpPackages = dumpPackages' showInstalledPackageInfo +-- | Show (very verbose) package info +pprPackages :: DynFlags -> SDoc +pprPackages = pprPackagesWith pprPackageConfig -dumpPackages' :: (PackageConfig -> String) -> DynFlags -> IO () -dumpPackages' showIPI dflags - = do putMsg dflags $ - vcat (map (text . showIPI) - (listPackageConfigMap dflags)) +pprPackagesWith :: (PackageConfig -> SDoc) -> DynFlags -> SDoc +pprPackagesWith pprIPI dflags = + vcat (intersperse (text "---") (map pprIPI (listPackageConfigMap dflags))) --- | Show simplified package info on console, if verbosity == 4. +-- | Show simplified package info. +-- -- The idea is to only print package id, and any information that might -- be different from the package databases (exposure, trust) -simpleDumpPackages :: DynFlags -> IO () -simpleDumpPackages = dumpPackages' showIPI +pprPackagesSimple :: DynFlags -> SDoc +pprPackagesSimple = pprPackagesWith (text . showIPI) where showIPI ipi = let InstalledPackageId i = installedPackageId ipi e = if exposed ipi then "E" else " " t = if trusted ipi then "T" else " " diff --git a/ghc/Main.hs b/ghc/Main.hs index 70dde39..8746125 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -33,7 +33,7 @@ import InteractiveUI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings ) import Config import Constants import HscTypes -import Packages ( dumpPackages, simpleDumpPackages, pprModuleMap ) +import Packages ( pprPackages, pprPackagesSimple, pprModuleMap ) import DriverPhases import BasicTypes ( failed ) import StaticFlags @@ -210,7 +210,7 @@ main' postLoadMode dflags0 args flagWarnings = do ---------------- Display configuration ----------- case verbosity dflags6 of - v | v == 4 -> liftIO $ simpleDumpPackages dflags6 + v | v == 4 -> liftIO $ dumpPackagesSimple dflags6 | v >= 5 -> liftIO $ dumpPackages dflags6 | otherwise -> return () @@ -237,6 +237,7 @@ main' postLoadMode dflags0 args flagWarnings = do DoInteractive -> ghciUI srcs Nothing DoEval exprs -> ghciUI srcs $ Just $ reverse exprs DoAbiHash -> abiHash srcs + ShowPackages -> liftIO $ showPackages dflags6 liftIO $ dumpFinalStats dflags6 @@ -435,12 +436,15 @@ data PostLoadMode | DoInteractive -- ghc --interactive | DoEval [String] -- ghc -e foo -e bar => DoEval ["bar", "foo"] | DoAbiHash -- ghc --abi-hash + | ShowPackages -- ghc --show-packages -doMkDependHSMode, doMakeMode, doInteractiveMode, doAbiHashMode :: Mode +doMkDependHSMode, doMakeMode, doInteractiveMode, + doAbiHashMode, showPackagesMode :: Mode doMkDependHSMode = mkPostLoadMode DoMkDependHS doMakeMode = mkPostLoadMode DoMake doInteractiveMode = mkPostLoadMode DoInteractive doAbiHashMode = mkPostLoadMode DoAbiHash +showPackagesMode = mkPostLoadMode ShowPackages showInterfaceMode :: FilePath -> Mode showInterfaceMode fp = mkPostLoadMode (ShowInterface fp) @@ -533,6 +537,7 @@ mode_flags = , Flag "-show-options" (PassFlag (setMode showOptionsMode)) , Flag "-supported-languages" (PassFlag (setMode showSupportedExtensionsMode)) , Flag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode)) + , Flag "-show-packages" (PassFlag (setMode showPackagesMode)) ] ++ [ Flag k' (PassFlag (setMode (printSetting k))) | k <- ["Project version", @@ -772,6 +777,11 @@ countFS entries longest has_z (b:bs) = in countFS entries' longest' (has_z + has_zs) bs +showPackages, dumpPackages, dumpPackagesSimple :: DynFlags -> IO () +showPackages dflags = putStrLn (showSDoc dflags (pprPackages dflags)) +dumpPackages dflags = putMsg dflags (pprPackages dflags) +dumpPackagesSimple dflags = putMsg dflags (pprPackagesSimple dflags) + -- ----------------------------------------------------------------------------- -- ABI hash support From git at git.haskell.org Sun Aug 24 22:47:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:44 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Make mkFastStringByteString pure and fix up uses (025f626) Message-ID: <20140824224744.4FD3824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/025f626309d9b15476b3236deea7be8f72a7b4c8/ghc >--------------------------------------------------------------- commit 025f626309d9b15476b3236deea7be8f72a7b4c8 Author: Duncan Coutts Date: Sun Aug 24 21:46:17 2014 +0100 Make mkFastStringByteString pure and fix up uses It's morally pure, and we'll need it in a pure context. >--------------------------------------------------------------- 025f626309d9b15476b3236deea7be8f72a7b4c8 compiler/deSugar/MatchLit.lhs | 3 +-- compiler/utils/Binary.hs | 2 +- compiler/utils/FastString.lhs | 15 ++++++++------- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs index 71a5e10..38ed3af 100644 --- a/compiler/deSugar/MatchLit.lhs +++ b/compiler/deSugar/MatchLit.lhs @@ -38,7 +38,6 @@ import TysWiredIn import Literal import SrcLoc import Data.Ratio -import MonadUtils import Outputable import BasicTypes import DynFlags @@ -365,7 +364,7 @@ matchLiterals (var:vars) ty sub_groups wrap_str_guard eq_str (MachStr s, mr) = do { -- We now have to convert back to FastString. Perhaps there -- should be separate MachBytes and MachStr constructors? - s' <- liftIO $ mkFastStringByteString s + let s' = mkFastStringByteString s ; lit <- mkStringExprFS s' ; let pred = mkApps (Var eq_str) [Var var, lit] ; return (mkGuardedMatchResult pred mr) } diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 0aa8c64..53ee903 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -681,7 +681,7 @@ putFS bh fs = putBS bh $ fastStringToByteString fs getFS :: BinHandle -> IO FastString getFS bh = do bs <- getBS bh - mkFastStringByteString bs + return $! mkFastStringByteString bs putBS :: BinHandle -> ByteString -> IO () putBS bh bs = diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs index 157e5f0..a38d87e 100644 --- a/compiler/utils/FastString.lhs +++ b/compiler/utils/FastString.lhs @@ -380,10 +380,12 @@ mkFastStringForeignPtr ptr !fp len -- | Create a 'FastString' from an existing 'ForeignPtr'; the difference -- between this and 'mkFastStringBytes' is that we don't have to copy -- the bytes if the string is new to the table. -mkFastStringByteString :: ByteString -> IO FastString -mkFastStringByteString bs = BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> do - let ptr' = castPtr ptr - mkFastStringWith (mkNewFastStringByteString bs ptr' len) ptr' len +mkFastStringByteString :: ByteString -> FastString +mkFastStringByteString bs = + inlinePerformIO $ + BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> do + let ptr' = castPtr ptr + mkFastStringWith (mkNewFastStringByteString bs ptr' len) ptr' len -- | Creates a UTF-8 encoded 'FastString' from a 'String' mkFastString :: String -> FastString @@ -510,8 +512,7 @@ zEncodeFS fs@(FastString _ _ _ ref) = Just zfs -> (m', zfs) appendFS :: FastString -> FastString -> FastString -appendFS fs1 fs2 = inlinePerformIO - $ mkFastStringByteString +appendFS fs1 fs2 = mkFastStringByteString $ BS.append (fastStringToByteString fs1) (fastStringToByteString fs2) @@ -530,7 +531,7 @@ tailFS (FastString _ _ bs _) = inlinePerformIO $ BS.unsafeUseAsCString bs $ \ptr -> do let (_, ptr') = utf8DecodeChar (castPtr ptr) n = ptr' `minusPtr` ptr - mkFastStringByteString $ BS.drop n bs + return $! mkFastStringByteString (BS.drop n bs) consFS :: Char -> FastString -> FastString consFS c fs = mkFastString (c : unpackFS fs) From git at git.haskell.org Sun Aug 24 22:47:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:46 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Switch the package id types to use FastString (rather than String) (575a9e8) Message-ID: <20140824224746.D744A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/575a9e81c8e39496179588a5f93fd616cecc5265/ghc >--------------------------------------------------------------- commit 575a9e81c8e39496179588a5f93fd616cecc5265 Author: Duncan Coutts Date: Sun Aug 24 21:59:03 2014 +0100 Switch the package id types to use FastString (rather than String) The conversions should now be correct w.r.t Unicode. Also move a couple instances to avoid orphan instances. Strictly speaking there's no need for these types to use FastString as they do not need the unique feature. They could just use some other compact string type, but ghc's internal utils don't have much support for such a type, so we just use FastString. >--------------------------------------------------------------- 575a9e81c8e39496179588a5f93fd616cecc5265 compiler/basicTypes/Module.lhs | 9 +++++++++ compiler/main/PackageConfig.hs | 44 +++++++++++++++++++----------------------- compiler/main/Packages.lhs | 28 +++++++++++++-------------- 3 files changed, 43 insertions(+), 38 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 575a9e81c8e39496179588a5f93fd616cecc5265 From git at git.haskell.org Sun Aug 24 22:47:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:49 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Fix string conversions in ghc-pkg to be correct w.r.t. Unicode (85f8f20) Message-ID: <20140824224749.7E91824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/85f8f20ea7e19a5fc3c6225431a6ccbb4f0f64e6/ghc >--------------------------------------------------------------- commit 85f8f20ea7e19a5fc3c6225431a6ccbb4f0f64e6 Author: Duncan Coutts Date: Sun Aug 24 22:11:33 2014 +0100 Fix string conversions in ghc-pkg to be correct w.r.t. Unicode Similar change to that on the ghc library side in the previous patch. The BinaryStringRep class has to use a ByteString in UTF8 encoding. >--------------------------------------------------------------- 85f8f20ea7e19a5fc3c6225431a6ccbb4f0f64e6 utils/ghc-pkg/Main.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index cedc048..ec23eb4 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -24,6 +24,7 @@ import Distribution.ModuleExport import Distribution.Package hiding (depends) import Distribution.Text import Distribution.Version +import Distribution.Simple.Utils (fromUTF8, toUTF8) import System.FilePath as FilePath import qualified System.FilePath.Posix as FilePath.Posix import System.Process @@ -1075,12 +1076,12 @@ convertPackageInfoToCacheFormat pkg = } instance GhcPkg.BinaryStringRep ModuleName where - fromStringRep = ModuleName.fromString . BS.unpack - toStringRep = BS.pack . display + fromStringRep = ModuleName.fromString . fromUTF8 . BS.unpack + toStringRep = BS.pack . toUTF8 . display instance GhcPkg.BinaryStringRep String where - fromStringRep = BS.unpack - toStringRep = BS.pack + fromStringRep = fromUTF8 . BS.unpack + toStringRep = BS.pack . toUTF8 -- ----------------------------------------------------------------------------- From git at git.haskell.org Sun Aug 24 22:47:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Aug 2014 22:47:51 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Address a number of Edward's code review comments (e1d9fcd) Message-ID: <20140824224752.373C524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/e1d9fcdef97d4787b22870f7e876e655aa28d945/ghc >--------------------------------------------------------------- commit e1d9fcdef97d4787b22870f7e876e655aa28d945 Author: Duncan Coutts Date: Sun Aug 24 23:43:40 2014 +0100 Address a number of Edward's code review comments Some others addressed as part of other recent patches. >--------------------------------------------------------------- e1d9fcdef97d4787b22870f7e876e655aa28d945 compiler/main/Finder.lhs | 1 + libraries/bin-package-db/GHC/PackageDb.hs | 7 +++++++ utils/ghc-pkg/Main.hs | 17 +++++++++++------ 3 files changed, 19 insertions(+), 6 deletions(-) diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs index 65151d9..b5ad08b 100644 --- a/compiler/main/Finder.lhs +++ b/compiler/main/Finder.lhs @@ -615,6 +615,7 @@ cantFindErr cannot_find _ dflags mod_name find_result | otherwise = hang (ptext (sLit "Locations searched:")) 2 $ vcat (map text files) + pkg_hidden :: PackageKey -> SDoc pkg_hidden pkgid = ptext (sLit "It is a member of the hidden package") <+> quotes (ppr pkgid) diff --git a/libraries/bin-package-db/GHC/PackageDb.hs b/libraries/bin-package-db/GHC/PackageDb.hs index eea525c..5039a01 100644 --- a/libraries/bin-package-db/GHC/PackageDb.hs +++ b/libraries/bin-package-db/GHC/PackageDb.hs @@ -154,6 +154,10 @@ readPackageDbForGhc file = -- | Read the part of the package DB that ghc-pkg is interested in -- +-- Note that the Binary instance for ghc-pkg's representation of packages +-- is not defined in this package. This is because ghc-pkg uses Cabal types +-- (and Binary instances for these) which this package does not depend on. +-- readPackageDbForGhcPkg :: Binary pkgs => FilePath -> IO pkgs readPackageDbForGhcPkg file = decodeFromFile file getDbForGhcPkg @@ -224,6 +228,9 @@ headerMagic :: BS.ByteString headerMagic = BS.Char8.pack "\0ghcpkg\0" +-- TODO: we may be able to replace the following with utils from the binary +-- package in future. + -- | Feed a 'Get' decoder with data chunks from a file. -- decodeFromFile :: FilePath -> Get a -> IO a diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index ec23eb4..fdb255a 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -590,8 +590,9 @@ getPkgDatabases verbosity modify use_user use_cache expand_vars my_flags = do Just f -> return (Just (f, True)) fs -> return (Just (last fs, True)) - -- If the user database exists, and for "check" and all "modify" commands - -- we will attempt to use the user db. + -- If the user database exists, and for "use_user" commands (which includes + -- "ghc-pkg check" and all commands that modify the db) we will attempt to + -- use the user db. let sys_databases | Just (user_conf,user_exists) <- mb_user_conf, use_user || user_exists = [user_conf, global_conf] @@ -694,8 +695,7 @@ readParseDatabase verbosity mb_user_conf modify use_cache path e_tcache <- tryIO $ getModificationTime cache case e_tcache of Left ex -> do - when ( verbosity > Normal - || verbosity >= Normal && not modify) $ + whenReportCacheErrors $ if isDoesNotExistError ex then do warn ("WARNING: cache does not exist: " ++ cache) @@ -727,8 +727,7 @@ readParseDatabase verbosity mb_user_conf modify use_cache path pkgs <- GhcPkg.readPackageDbForGhcPkg cache mkPackageDB pkgs else do - when ( verbosity > Normal - || verbosity >= Normal && not modify) $ do + whenReportCacheErrors $ do warn ("WARNING: cache is out of date: " ++ cache) warn ("ghc will see an old view of this " ++ "package db. Use 'ghc-pkg recache' to fix.") @@ -741,6 +740,12 @@ readParseDatabase verbosity mb_user_conf modify use_cache path parseSingletonPackageConf verbosity f pkgs <- mapM doFile $ map (path ) confs mkPackageDB pkgs + + -- We normally report cache errors for read-only commands, + -- since modify commands because will usually fix the cache. + whenReportCacheErrors = + when ( verbosity > Normal + || verbosity >= Normal && not modify) where mkPackageDB pkgs = do path_abs <- absolutePath path From git at git.haskell.org Mon Aug 25 07:39:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Aug 2014 07:39:35 +0000 (UTC) Subject: [commit: ghc] master: Declare official GitHub home of libraries/{directory, process} (78ba9f0) Message-ID: <20140825073935.6752C24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/78ba9f0682246356fbd5ee35a992f97c590ee159/ghc >--------------------------------------------------------------- commit 78ba9f0682246356fbd5ee35a992f97c590ee159 Author: Herbert Valerio Riedel Date: Mon Aug 25 09:14:31 2014 +0200 Declare official GitHub home of libraries/{directory,process} Effective immediately, pushing to libraries/{directory,process} requires pushing to ssh://git at github.com/haskell/{directory.process}.git. This has been done now even though there's no scripted tooling yet as the GitHub repo was already getting issues filed. >--------------------------------------------------------------- 78ba9f0682246356fbd5ee35a992f97c590ee159 packages | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/packages b/packages index e3855c2..be29ca3 100644 --- a/packages +++ b/packages @@ -57,7 +57,7 @@ libraries/bytestring - - https:/ libraries/Cabal - - https://github.com/haskell/cabal.git libraries/containers - - https://github.com/haskell/containers.git libraries/deepseq - - - -libraries/directory - - - +libraries/directory - - ssh://git at github.com/haskell/directory.git libraries/filepath - - - libraries/haskeline - - https://github.com/judah/haskeline.git libraries/haskell98 - - - @@ -67,7 +67,7 @@ libraries/hpc - - - libraries/old-locale - - - libraries/old-time - - - libraries/pretty - - https://github.com/haskell/pretty.git -libraries/process - - - +libraries/process - - ssh://git at github.com/haskell/process.git libraries/terminfo - - https://github.com/judah/terminfo.git libraries/time - - https://github.com/haskell/time.git libraries/transformers - - http://git.haskell.org/darcs-mirrors/transformers.git From git at git.haskell.org Mon Aug 25 10:05:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Aug 2014 10:05:08 +0000 (UTC) Subject: [commit: ghc] master: testsuite: add 16-byte case for T9329 (5295cd2) Message-ID: <20140825100508.C9C9524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5295cd2b53cb2e9cf3df49274d25d3f72d618c2a/ghc >--------------------------------------------------------------- commit 5295cd2b53cb2e9cf3df49274d25d3f72d618c2a Author: Sergei Trofimovich Date: Mon Aug 25 13:00:24 2014 +0300 testsuite: add 16-byte case for T9329 Exposes Issue #9512 on amd64 Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 5295cd2b53cb2e9cf3df49274d25d3f72d618c2a testsuite/tests/codeGen/should_compile/T9329.cmm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/codeGen/should_compile/T9329.cmm b/testsuite/tests/codeGen/should_compile/T9329.cmm index da20069..cfdbb6e 100644 --- a/testsuite/tests/codeGen/should_compile/T9329.cmm +++ b/testsuite/tests/codeGen/should_compile/T9329.cmm @@ -1,5 +1,11 @@ foo () { - STK_CHK_GEN_N (8); /* panics */ + STK_CHK_GEN_N (8); /* panics on i386 */ + return (0); +} + +bar () +{ + STK_CHK_GEN_N (16); /* panics on amd64 */ return (0); } From git at git.haskell.org Mon Aug 25 13:12:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Aug 2014 13:12:26 +0000 (UTC) Subject: [commit: ghc] master: Use DumpStyle rather than UserStyle for pprTrace output (9f8754e) Message-ID: <20140825131226.4A87C24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9f8754eb46b59886ebc09dec2581ed31eea053dc/ghc >--------------------------------------------------------------- commit 9f8754eb46b59886ebc09dec2581ed31eea053dc Author: Simon Peyton Jones Date: Mon Aug 25 12:10:29 2014 +0100 Use DumpStyle rather than UserStyle for pprTrace output The main motivation is that user-style output assumes that everything has been tidied, not enough uniques are printed by default. The downside is that pprTrace output now has module prefixes which can be overwhelming, but -dsuppress-module-prefixes will suppress them. >--------------------------------------------------------------- 9f8754eb46b59886ebc09dec2581ed31eea053dc compiler/utils/Outputable.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index a65607a..953797e 100644 --- a/compiler/utils/Outputable.lhs +++ b/compiler/utils/Outputable.lhs @@ -324,7 +324,7 @@ sdocWithPlatform f = sdocWithDynFlags (f . targetPlatform) \begin{code} qualName :: PprStyle -> QueryQualifyName qualName (PprUser q _) mod occ = queryQualifyName q mod occ -qualName _other mod _ = NameQual (moduleName mod) +qualName _other mod _ = NameQual (moduleName mod) qualModule :: PprStyle -> QueryQualifyModule qualModule (PprUser q _) m = queryQualifyModule q m @@ -1029,7 +1029,7 @@ assertPprPanic file line msg pprDebugAndThen :: DynFlags -> (String -> a) -> String -> SDoc -> a pprDebugAndThen dflags cont heading pretty_msg - = cont (showSDoc dflags doc) + = cont (showSDocDump dflags doc) where doc = sep [text heading, nest 4 pretty_msg] \end{code} From git at git.haskell.org Mon Aug 25 13:12:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Aug 2014 13:12:28 +0000 (UTC) Subject: [commit: ghc] master: Introduce the Call data types (c0fe1d9) Message-ID: <20140825131228.DCE3424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c0fe1d9e7a9f23d050319c77f3a38264f3aa22f8/ghc >--------------------------------------------------------------- commit c0fe1d9e7a9f23d050319c77f3a38264f3aa22f8 Author: Simon Peyton Jones Date: Mon Aug 25 12:24:55 2014 +0100 Introduce the Call data types This is just a small refactoring that makes the code a bit clearer, using a data type instead of a triple. We get better pretty-printing too. >--------------------------------------------------------------- c0fe1d9e7a9f23d050319c77f3a38264f3aa22f8 compiler/specialise/SpecConstr.lhs | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs index 24820eb..a202ce5 100644 --- a/compiler/specialise/SpecConstr.lhs +++ b/compiler/specialise/SpecConstr.lhs @@ -35,6 +35,7 @@ import Rules import Type hiding ( substTy ) import TyCon ( isRecursiveTyCon, tyConName ) import Id +import PprCore ( pprParendExpr ) import MkCore ( mkImpossibleExpr ) import Var import VarEnv @@ -1019,15 +1020,27 @@ data ScUsage } -- The domain is OutIds type CallEnv = IdEnv [Call] -type Call = (ValueEnv, [CoreArg]) +data Call = Call Id [CoreArg] ValueEnv -- The arguments of the call, together with the -- env giving the constructor bindings at the call site + -- We keep the function mainly for debug output + +instance Outputable Call where + ppr (Call fn args _) = ppr fn <+> fsep (map pprParendExpr args) nullUsage :: ScUsage nullUsage = SCU { scu_calls = emptyVarEnv, scu_occs = emptyVarEnv } combineCalls :: CallEnv -> CallEnv -> CallEnv combineCalls = plusVarEnv_C (++) + where +-- plus cs ds | length res > 1 +-- = pprTrace "combineCalls" (vcat [ ptext (sLit "cs:") <+> ppr cs +-- , ptext (sLit "ds:") <+> ppr ds]) +-- res +-- | otherwise = res +-- where +-- res = cs ++ ds combineUsage :: ScUsage -> ScUsage -> ScUsage combineUsage u1 u2 = SCU { scu_calls = combineCalls (scu_calls u1) (scu_calls u2), @@ -1285,7 +1298,7 @@ scApp env (other_fn, args) mkVarUsage :: ScEnv -> Id -> [CoreExpr] -> ScUsage mkVarUsage env fn args = case lookupHowBound env fn of - Just RecFun -> SCU { scu_calls = unitVarEnv fn [(sc_vals env, args)] + Just RecFun -> SCU { scu_calls = unitVarEnv fn [Call fn args (sc_vals env)] , scu_occs = emptyVarEnv } Just RecArg -> SCU { scu_calls = emptyVarEnv , scu_occs = unitVarEnv fn arg_occ } @@ -1711,7 +1724,7 @@ callToPats :: ScEnv -> [ArgOcc] -> Call -> UniqSM (Maybe (CallPat, ValueEnv)) -- Type variables come first, since they may scope -- over the following term variables -- The [CoreExpr] are the argument patterns for the rule -callToPats env bndr_occs (con_env, args) +callToPats env bndr_occs (Call _ args con_env) | length args < length bndr_occs -- Check saturated = return Nothing | otherwise From git at git.haskell.org Mon Aug 25 13:12:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Aug 2014 13:12:31 +0000 (UTC) Subject: [commit: ghc] master: Do not duplicate call information in SpecConstr (Trac #8852) (af4bc31) Message-ID: <20140825131231.BE58324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/af4bc31c50c873344a2426d4be842f92edf17019/ghc >--------------------------------------------------------------- commit af4bc31c50c873344a2426d4be842f92edf17019 Author: Simon Peyton Jones Date: Mon Aug 25 12:28:44 2014 +0100 Do not duplicate call information in SpecConstr (Trac #8852) This long-standing and egregious bug meant that call information was being gratuitously copied, leading to an exponential blowup in the number of calls to be examined when function definitions are deeply nested. That is what has been causing the blowup in SpecConstr's running time, not (as I had previously supposed) generating very large code. See Note [spec_usg includes rhs_usg] >--------------------------------------------------------------- af4bc31c50c873344a2426d4be842f92edf17019 compiler/specialise/SpecConstr.lhs | 70 ++++++++++++++++++++++++++------------ 1 file changed, 48 insertions(+), 22 deletions(-) diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs index a202ce5..1a01f02 100644 --- a/compiler/specialise/SpecConstr.lhs +++ b/compiler/specialise/SpecConstr.lhs @@ -1211,7 +1211,7 @@ scExpr' env (Let (NonRec bndr rhs) body) (SI [] 0 (Just rhs_usg)) ; return (body_usg { scu_calls = scu_calls body_usg `delVarEnv` bndr' } - `combineUsage` rhs_usg `combineUsage` spec_usg, + `combineUsage` spec_usg, -- Note [spec_usg includes rhs_usg] mkLets [NonRec b r | (b,r) <- specInfoBinds rhs_info specs] body') } @@ -1235,8 +1235,7 @@ scExpr' env (Let (Rec prs) body) -- Instead use them only if we find an unspecialised call -- See Note [Local recursive groups] - ; let rhs_usg = combineUsages rhs_usgs - all_usg = spec_usg `combineUsage` rhs_usg `combineUsage` body_usg + ; let all_usg = spec_usg `combineUsage` body_usg -- Note [spec_usg includes rhs_usg] bind' = Rec (concat (zipWith specInfoBinds rhs_infos specs)) ; return (all_usg { scu_calls = scu_calls all_usg `delVarEnvList` bndrs' }, @@ -1333,34 +1332,35 @@ scTopBind _ usage _ = error "false" -} -scTopBind env usage (Rec prs) +scTopBind env body_usage (Rec prs) | Just threshold <- sc_size env , not force_spec , not (all (couldBeSmallEnoughToInline (sc_dflags env) threshold) rhss) -- No specialisation = do { (rhs_usgs, rhss') <- mapAndUnzipM (scExpr env) rhss - ; return (usage `combineUsage` (combineUsages rhs_usgs), Rec (bndrs `zip` rhss')) } + ; return (body_usage `combineUsage` combineUsages rhs_usgs, Rec (bndrs `zip` rhss')) } + | otherwise -- Do specialisation = do { (rhs_usgs, rhs_infos) <- mapAndUnzipM (scRecRhs env) prs - -- ; pprTrace "scTopBind" (ppr bndrs $$ ppr (map (lookupVarEnv (scu_calls usage)) bndrs)) (return ()) + -- ; pprTrace "scTopBind" (ppr bndrs $$ ppr (map (lookupVarEnv (scu_calls body_usage)) bndrs)) (return ()) -- Note [Top-level recursive groups] ; let (usg,rest) | any isExportedId bndrs -- Seed from RHSs = ( combineUsages rhs_usgs, [SI [] 0 Nothing | _ <- rhs_usgs] ) | otherwise -- Seed from body only - = ( usage, [SI [] 0 (Just us) | us <- rhs_usgs] ) + = ( body_usage, [SI [] 0 (Just us) | us <- rhs_usgs] ) - ; (usage', specs) <- specLoop (scForce env force_spec) - (scu_calls usg) rhs_infos nullUsage rest + ; (spec_usage, specs) <- specLoop (scForce env force_spec) + (scu_calls usg) rhs_infos nullUsage rest - ; return (usage `combineUsage` usage', + ; return (body_usage `combineUsage` spec_usage, Rec (concat (zipWith specInfoBinds rhs_infos specs))) } where (bndrs,rhss) = unzip prs force_spec = any (forceSpecBndr env) bndrs -- Note [Forcing specialisation] -scTopBind env usage (NonRec bndr rhs) +scTopBind env usage (NonRec bndr rhs) -- Oddly, we don't seem to specialise top-level non-rec functions = do { (rhs_usg', rhs') <- scExpr env rhs ; return (usage `combineUsage` rhs_usg', NonRec bndr rhs') } @@ -1417,6 +1417,7 @@ data SpecInfo = SI [OneSpec] -- The specialisations we have generated -- unleashed) -- Nothing => we have -- See Note [Local recursive groups] + -- See Note [spec_usg includes rhs_usg] -- One specialisation: Rule plus definition data OneSpec = OS CallPat -- Call pattern that generated this specialisation @@ -1443,10 +1444,12 @@ specLoop env all_calls rhs_infos usg_so_far specs_so_far specialise :: ScEnv - -> CallEnv -- Info on calls + -> CallEnv -- Info on newly-discovered calls to this function -> RhsInfo - -> SpecInfo -- Original RHS plus patterns dealt with - -> UniqSM (ScUsage, SpecInfo) -- New specialised versions and their usage + -> SpecInfo -- Original RHS plus patterns dealt with + -> UniqSM (ScUsage, SpecInfo) -- New specialised versions and their usage + +-- See Note [spec_usg includes rhs_usg] -- Note: this only generates *specialised* bindings -- The original binding is added by specInfoBinds @@ -1457,11 +1460,20 @@ specialise specialise env bind_calls (RI fn _ arg_bndrs body arg_occs) spec_info@(SI specs spec_count mb_unspec) - | not (isBottomingId fn) -- Note [Do not specialise diverging functions] - , not (isNeverActive (idInlineActivation fn)) -- See Note [Transfer activation] - , notNull arg_bndrs -- Only specialise functions - , Just all_calls <- lookupVarEnv bind_calls fn - = do { (boring_call, pats) <- callsToPats env specs arg_occs all_calls + | isBottomingId fn -- Note [Do not specialise diverging functions] + -- and do not generate specialisation seeds from its RHS + = return (nullUsage, spec_info) + + | isNeverActive (idInlineActivation fn) -- See Note [Transfer activation] + || null arg_bndrs -- Only specialise functions + = case mb_unspec of -- Behave as if there was a single, boring call + Just rhs_usg -> return (rhs_usg, SI specs spec_count Nothing) + -- See Note [spec_usg includes rhs_usg] + Nothing -> return (nullUsage, spec_info) + + | Just all_calls <- lookupVarEnv bind_calls fn + = -- pprTrace "specialise entry {" (ppr fn <+> ppr (length all_calls)) $ + do { (boring_call, pats) <- callsToPats env specs arg_occs all_calls -- Bale out if too many specialisations ; let n_pats = length pats @@ -1508,9 +1520,13 @@ specialise env bind_calls (RI fn _ arg_bndrs body arg_occs) Just rhs_usg | boring_call -> (spec_usg `combineUsage` rhs_usg, Nothing) _ -> (spec_usg, mb_unspec) - ; return (new_usg, SI (new_specs ++ specs) spec_count' mb_unspec') } } - | otherwise - = return (nullUsage, spec_info) -- The boring case +-- ; pprTrace "specialise return }" (ppr fn +-- <+> ppr (scu_calls new_usg)) + ; return (new_usg, SI (new_specs ++ specs) spec_count' mb_unspec') } } + + + | otherwise -- No new seeds, so return nullUsage + = return (nullUsage, spec_info) --------------------- @@ -1612,6 +1628,16 @@ calcSpecStrictness fn qvars pats go_one env _ _ = env \end{code} +Note [spec_usg includes rhs_usg] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In calls to 'specialise', the returned ScUsage must include the rhs_usg in +the passed-in SpecInfo, unless there are no calls at all to the function. + +The caller can, indeed must, assume this. He should not combine in rhs_usg +himself, or he'll get rhs_usg twice -- and that can lead to an exponential +blowup of duplicates in the CallEnv. This is what gave rise to the massive +performace loss in Trac #8852. + Note [Specialise original body] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The RhsInfo for a binding keeps the *original* body of the binding. We From git at git.haskell.org Mon Aug 25 13:12:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Aug 2014 13:12:34 +0000 (UTC) Subject: [commit: ghc] master: More refactoring in SpecConstr (5c4df28) Message-ID: <20140825131234.3B78924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5c4df28831fe40493f6b4d2577c255198774eeca/ghc >--------------------------------------------------------------- commit 5c4df28831fe40493f6b4d2577c255198774eeca Author: Simon Peyton Jones Date: Mon Aug 25 13:38:55 2014 +0100 More refactoring in SpecConstr This patch should make no change in behaviour. * Make RhsInfo into a record * Include ri_rhs_usg, which previously travelled around separately * Introduce specRec, specNonRec, and make them return [OneSpec] rather than SpecInfo >--------------------------------------------------------------- 5c4df28831fe40493f6b4d2577c255198774eeca compiler/specialise/SpecConstr.lhs | 122 ++++++++++++++++++++++--------------- 1 file changed, 73 insertions(+), 49 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5c4df28831fe40493f6b4d2577c255198774eeca From git at git.haskell.org Mon Aug 25 14:18:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Aug 2014 14:18:32 +0000 (UTC) Subject: [commit: ghc] master: Check for un-saturated type family applications (ee4501b) Message-ID: <20140825141832.F309424123@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ee4501bbad6480509e8a60b5ff89c0b0b228b66d/ghc >--------------------------------------------------------------- commit ee4501bbad6480509e8a60b5ff89c0b0b228b66d Author: Simon Peyton Jones Date: Mon Aug 25 15:13:02 2014 +0100 Check for un-saturated type family applications This patch corrects an egregious error introduced by: commit 022f8750edf6f413fba31293435dcc62600eab77 Author: Simon Peyton Jones Date: Thu May 15 16:07:04 2014 +0100 Refactoring around TyCon.isSynTyCon * Document isSynTyCon better * Add isTypeSyonymTyCon for regular H98 type synonyms * Use isTypeSynonymTyCon rather than isSynTyCon where the former is really intended At this particular spot in TcValidity we really do mean isSynTyCon and not isTypeSynonymTyCon. Fixes Trac #9433 >--------------------------------------------------------------- ee4501bbad6480509e8a60b5ff89c0b0b228b66d compiler/typecheck/TcValidity.lhs | 5 ++++- testsuite/tests/indexed-types/should_fail/T9433.hs | 15 +++++++++++++++ testsuite/tests/indexed-types/should_fail/T9433.stderr | 4 ++++ testsuite/tests/indexed-types/should_fail/all.T | 2 ++ 4 files changed, 25 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs index f835782..9e518c7 100644 --- a/compiler/typecheck/TcValidity.lhs +++ b/compiler/typecheck/TcValidity.lhs @@ -294,7 +294,7 @@ check_type ctxt rank (AppTy ty1 ty2) ; check_arg_type ctxt rank ty2 } check_type ctxt rank ty@(TyConApp tc tys) - | isTypeSynonymTyCon tc = check_syn_tc_app ctxt rank ty tc tys + | isSynTyCon tc = check_syn_tc_app ctxt rank ty tc tys | isUnboxedTupleTyCon tc = check_ubx_tuple ctxt ty tys | otherwise = mapM_ (check_arg_type ctxt rank) tys @@ -305,6 +305,9 @@ check_type _ _ ty = pprPanic "check_type" (ppr ty) ---------------------------------------- check_syn_tc_app :: UserTypeCtxt -> Rank -> KindOrType -> TyCon -> [KindOrType] -> TcM () +-- Used for type synonyms and type synonym families, +-- which must be saturated, +-- but not data families, which need not be saturated check_syn_tc_app ctxt rank ty tc tys | tc_arity <= n_args -- Saturated -- Check that the synonym has enough args diff --git a/testsuite/tests/indexed-types/should_fail/T9433.hs b/testsuite/tests/indexed-types/should_fail/T9433.hs new file mode 100644 index 0000000..c7b6161 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9433.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE + TypeFamilies + , KindSignatures + #-} + +module T9433 where + +type family Id x :: * +type instance Id a = a + +type family Map (f :: * -> *) x :: * +type instance Map f [a] = [f a] + +x :: Map Id [Bool] +x = [] diff --git a/testsuite/tests/indexed-types/should_fail/T9433.stderr b/testsuite/tests/indexed-types/should_fail/T9433.stderr new file mode 100644 index 0000000..0b17f57 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9433.stderr @@ -0,0 +1,4 @@ + +T9433.hs:14:6: + Type synonym ?Id? should have 1 argument, but has been given none + In the type signature for ?x?: x :: Map Id [Bool] diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 6d284cf..50eec86 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -126,3 +126,5 @@ test('T9097', normal, compile_fail, ['']) test('T9160', normal, compile_fail, ['']) test('T9357', normal, compile_fail, ['']) test('T9371', normal, compile_fail, ['']) +test('T9433', normal, compile_fail, ['']) + From git at git.haskell.org Mon Aug 25 14:18:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Aug 2014 14:18:30 +0000 (UTC) Subject: [commit: ghc] master: Make Core Lint check for un-saturated type applications (8ff4671) Message-ID: <20140825141830.21A0324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8ff4671422090acf9146e3a90dd38e2c6f72aebb/ghc >--------------------------------------------------------------- commit 8ff4671422090acf9146e3a90dd38e2c6f72aebb Author: Simon Peyton Jones Date: Mon Aug 25 15:10:19 2014 +0100 Make Core Lint check for un-saturated type applications Un-saturated type-family and type-synonym applications are detected in the front end, but for some reason Lint wasn't looking for them. I came across this when wondering why Trac #9433 didn't give a Core Lint error >--------------------------------------------------------------- 8ff4671422090acf9146e3a90dd38e2c6f72aebb compiler/coreSyn/CoreLint.lhs | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs index f460782..21e0b5f 100644 --- a/compiler/coreSyn/CoreLint.lhs +++ b/compiler/coreSyn/CoreLint.lhs @@ -726,13 +726,20 @@ lintType ty@(FunTy t1 t2) -- (->) has two different rules, for types and kind ; lintArrow (ptext (sLit "type or kind") <+> quotes (ppr ty)) k1 k2 } lintType ty@(TyConApp tc tys) - | not (isUnLiftedTyCon tc) || tys `lengthIs` tyConArity tc - -- Check that primitive types are saturated + | Just ty' <- coreView ty + = lintType ty' -- Expand type synonyms, so that we do not bogusly complain + -- about un-saturated type synonyms + -- + + | isUnLiftedTyCon tc || isSynTyCon tc -- See Note [The kind invariant] in TypeRep + -- Also type synonyms and type families + , length tys < tyConArity tc + = failWithL (hang (ptext (sLit "Un-saturated type application")) 2 (ppr ty)) + + | otherwise = do { ks <- mapM lintType tys ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } - | otherwise - = failWithL (hang (ptext (sLit "Malformed type:")) 2 (ppr ty)) lintType (ForAllTy tv ty) = do { lintTyBndrKind tv From git at git.haskell.org Mon Aug 25 14:18:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Aug 2014 14:18:35 +0000 (UTC) Subject: [commit: ghc] master: Two buglets in record wild-cards (Trac #9436 and #9437) (06600e7) Message-ID: <20140825141836.3C92124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/06600e74444d22caff1fa8c7eef0e4e2debd60b9/ghc >--------------------------------------------------------------- commit 06600e74444d22caff1fa8c7eef0e4e2debd60b9 Author: Simon Peyton Jones Date: Mon Aug 25 15:17:39 2014 +0100 Two buglets in record wild-cards (Trac #9436 and #9437) of named fields, whereas the code in RnPat.rnHsRecFields is much better set up to do so. Both easily fixed. >--------------------------------------------------------------- 06600e74444d22caff1fa8c7eef0e4e2debd60b9 compiler/parser/RdrHsSyn.lhs | 8 +++--- compiler/rename/RnExpr.lhs | 2 +- compiler/rename/RnPat.lhs | 33 ++++++++++++++++++------- testsuite/tests/rename/should_fail/T9436.hs | 8 ++++++ testsuite/tests/rename/should_fail/T9436.stderr | 4 +++ testsuite/tests/rename/should_fail/T9437.hs | 8 ++++++ testsuite/tests/rename/should_fail/T9437.stderr | 2 ++ testsuite/tests/rename/should_fail/all.T | 2 ++ 8 files changed, 53 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 06600e74444d22caff1fa8c7eef0e4e2debd60b9 From git at git.haskell.org Mon Aug 25 15:18:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Aug 2014 15:18:21 +0000 (UTC) Subject: [commit: ghc] master: Improve documentation of record wildcards (67a6ade) Message-ID: <20140825151822.2AA9124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/67a6ade91b77fb2252ebdad34a934d9fb54eb43d/ghc >--------------------------------------------------------------- commit 67a6ade91b77fb2252ebdad34a934d9fb54eb43d Author: Simon Peyton Jones Date: Mon Aug 25 16:18:03 2014 +0100 Improve documentation of record wildcards In particular mention that they aren't allowed for record updates. Triggered by Trac #9437 >--------------------------------------------------------------- 67a6ade91b77fb2252ebdad34a934d9fb54eb43d docs/users_guide/glasgow_exts.xml | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index a6c43b8..befaf4d 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -2325,7 +2325,7 @@ f (C {a = 1, ..}) = b + c + d More details: -Wildcards can be mixed with other patterns, including puns +Record wildcards in patterns can be mixed with other patterns, including puns (); for example, in a pattern C {a = 1, b, ..}). Additionally, record wildcards can be used wherever record patterns occur, including in let @@ -2338,7 +2338,7 @@ defines b, c, and -Record wildcards can also be used in expressions, writing, for example, +Record wildcards can also be used in an expression, when constructing a record. For example, let {a = 1; b = 2; c = 3; d = 4} in C {..} @@ -2352,7 +2352,15 @@ the same as the omitted field names. -The ".." expands to the missing +Record wildcards may not be used in record updates. For example this +is illegal: + +f r = r { x = 3, .. } + + + + +For both pattern and expression wildcards, the ".." expands to the missing in-scope record fields. Specifically the expansion of "C {..}" includes f if and only if: @@ -2369,6 +2377,8 @@ the variable f is in scope unqualified, apart from the binding of the record selector itself. +These rules restrict record wildcards to the situations in which the user +could have written the expanded version. For example module M where From git at git.haskell.org Tue Aug 26 10:11:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 Aug 2014 10:11:30 +0000 (UTC) Subject: [commit: ghc] master: UNREG: fix emission of large Integer literals in C codegen (43f1b2e) Message-ID: <20140826101130.C4AC924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/43f1b2ecd1960fa7377cf55a2b97c66059a701ef/ghc >--------------------------------------------------------------- commit 43f1b2ecd1960fa7377cf55a2b97c66059a701ef Author: Sergei Trofimovich Date: Tue Aug 26 13:07:14 2014 +0300 UNREG: fix emission of large Integer literals in C codegen Summary: On amd64/UNREG build there is many failing tests trying to deal with 'Integer' types. Looking at 'integerConversions' test I've observed invalid C code generated by GHC. Cmm code CInt a = -1; (a == -1) yields 'False' with optimisations enabled via the following C code: StgWord64 a = (StgWord32)0xFFFFffffFFFFffffu; (a == 0xFFFFffffFFFFffffu) The patch fixes it by shrinking emitted literals to required sizes: StgWord64 a = (StgWord32)0xFFFFffffu; (a == 0xFFFFffffu) Thanks to Reid Barton for tracking down and fixing the issue. Signed-off-by: Sergei Trofimovich Test Plan: validate on UNREG build (amd64, x86) Reviewers: simonmar, rwbarton, austin Subscribers: hvr, simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D173 >--------------------------------------------------------------- 43f1b2ecd1960fa7377cf55a2b97c66059a701ef compiler/cmm/PprC.hs | 30 +++++++++++++++++++++++++++--- 1 file changed, 27 insertions(+), 3 deletions(-) diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index 3b824f3..68b6bf7 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -1223,8 +1223,9 @@ commafy xs = hsep $ punctuate comma xs pprHexVal :: Integer -> Width -> SDoc pprHexVal 0 _ = ptext (sLit "0x0") pprHexVal w rep - | w < 0 = parens (char '-' <> ptext (sLit "0x") <> go (-w) <> repsuffix rep) - | otherwise = ptext (sLit "0x") <> go w <> repsuffix rep + | w < 0 = parens (char '-' <> + ptext (sLit "0x") <> intToDoc (-w) <> repsuffix rep) + | otherwise = ptext (sLit "0x") <> intToDoc w <> repsuffix rep where -- type suffix for literals: -- Integer literals are unsigned in Cmm/C. We explicitly cast to @@ -1239,10 +1240,33 @@ pprHexVal w rep else panic "pprHexVal: Can't find a 64-bit type" repsuffix _ = char 'U' + intToDoc :: Integer -> SDoc + intToDoc i = go (truncInt i) + + -- We need to truncate value as Cmm backend does not drop + -- redundant bits to ease handling of negative values. + -- Thus the following Cmm code on 64-bit arch, like amd64: + -- CInt v; + -- v = {something}; + -- if (v == %lobits32(-1)) { ... + -- leads to the following C code: + -- StgWord64 v = (StgWord32)({something}); + -- if (v == 0xFFFFffffFFFFffffU) { ... + -- Such code is incorrect as it promotes both operands to StgWord64 + -- and the whole condition is always false. + truncInt :: Integer -> Integer + truncInt i = + case rep of + W8 -> i `rem` (2^(8 :: Int)) + W16 -> i `rem` (2^(16 :: Int)) + W32 -> i `rem` (2^(32 :: Int)) + W64 -> i `rem` (2^(64 :: Int)) + _ -> panic ("pprHexVal/truncInt: C backend can't encode " + ++ show rep ++ " literals") + go 0 = empty go w' = go q <> dig where (q,r) = w' `quotRem` 16 dig | r < 10 = char (chr (fromInteger r + ord '0')) | otherwise = char (chr (fromInteger r - 10 + ord 'a')) - From git at git.haskell.org Tue Aug 26 13:31:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 Aug 2014 13:31:58 +0000 (UTC) Subject: [commit: ghc] wip/new-flatten-skolems-Aug14: More work in progress (8596f14) Message-ID: <20140826133158.CDF0124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/new-flatten-skolems-Aug14 Link : http://ghc.haskell.org/trac/ghc/changeset/8596f14f51a9da8d93599816e7af2222ffefd6eb/ghc >--------------------------------------------------------------- commit 8596f14f51a9da8d93599816e7af2222ffefd6eb Author: Simon Peyton Jones Date: Sat Aug 16 10:48:57 2014 +0100 More work in progress >--------------------------------------------------------------- 8596f14f51a9da8d93599816e7af2222ffefd6eb compiler/typecheck/TcCanonical.lhs | 14 +--- compiler/typecheck/TcErrors.lhs | 1 + compiler/typecheck/TcHsSyn.lhs | 1 + compiler/typecheck/TcInteract.lhs | 76 ++++++++++++++----- compiler/typecheck/TcMType.lhs | 1 + compiler/typecheck/TcRnTypes.lhs | 7 +- compiler/typecheck/TcSMonad.lhs | 150 +++++++++++++++++++------------------ compiler/typecheck/TcSimplify.lhs | 19 +++-- compiler/typecheck/TcType.lhs | 13 ++-- 9 files changed, 160 insertions(+), 122 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8596f14f51a9da8d93599816e7af2222ffefd6eb From git at git.haskell.org Tue Aug 26 13:55:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 Aug 2014 13:55:59 +0000 (UTC) Subject: [commit: ghc] wip/new-flatten-skolems-Aug14: Comment wibble (d6660a4) Message-ID: <20140826135559.D561124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/new-flatten-skolems-Aug14 Link : http://ghc.haskell.org/trac/ghc/changeset/d6660a4a4b61d8422227e315cc4b2f4b4d465e9a/ghc >--------------------------------------------------------------- commit d6660a4a4b61d8422227e315cc4b2f4b4d465e9a Author: Simon Peyton Jones Date: Tue Aug 26 14:32:27 2014 +0100 Comment wibble >--------------------------------------------------------------- d6660a4a4b61d8422227e315cc4b2f4b4d465e9a compiler/typecheck/TcSimplify.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index 09bf63f..f69d614 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -1222,7 +1222,7 @@ ones that don't mention the skolem-bound variables. But that is over-eager. Consider [2] forall a. F a beta[1] ~ gamma[2], G beta[1] gamma[2] ~ Int The second constraint doesn't mention 'a'. But if we float it -we'll promote gamma to gamma'[1]. Now suppose that we learn that +we'll promote gamma[2] to gamma'[1]. Now suppose that we learn that beta := Bool, and F a Bool = a, and G Bool _ = Int. Then we'll we left with the constraint [2] forall a. a ~ gamma'[1] From git at git.haskell.org Tue Aug 26 13:56:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 Aug 2014 13:56:02 +0000 (UTC) Subject: [commit: ghc] wip/new-flatten-skolems-Aug14: Add flattening notes (d4316a4) Message-ID: <20140826135603.1118024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/new-flatten-skolems-Aug14 Link : http://ghc.haskell.org/trac/ghc/changeset/d4316a4bc01b6cc9728534ea21d2fa20eb493f68/ghc >--------------------------------------------------------------- commit d4316a4bc01b6cc9728534ea21d2fa20eb493f68 Author: Simon Peyton Jones Date: Tue Aug 26 14:55:38 2014 +0100 Add flattening notes >--------------------------------------------------------------- d4316a4bc01b6cc9728534ea21d2fa20eb493f68 compiler/typecheck/Flattening-notes | 285 ++++++++++++++++++++++++++++++++++++ 1 file changed, 285 insertions(+) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d4316a4bc01b6cc9728534ea21d2fa20eb493f68 From git at git.haskell.org Wed Aug 27 13:01:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Aug 2014 13:01:02 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Fix validation error in Linker arising from package rep changes (ecdf536) Message-ID: <20140827130102.3B23024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/ecdf5363d7e83ebed531b8a8fc814315e17c6f48/ghc >--------------------------------------------------------------- commit ecdf5363d7e83ebed531b8a8fc814315e17c6f48 Author: Duncan Coutts Date: Wed Aug 27 13:26:24 2014 +0100 Fix validation error in Linker arising from package rep changes >--------------------------------------------------------------- ecdf5363d7e83ebed531b8a8fc814315e17c6f48 compiler/ghci/Linker.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index d4de513..3169858 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -1023,7 +1023,7 @@ data LibrarySpec partOfGHCi :: [PackageName] partOfGHCi | isWindowsHost || isDarwinHost = [] - | otherwise = map PackageName + | otherwise = map (PackageName . mkFastString) ["base", "template-haskell", "editline"] showLS :: LibrarySpec -> String From git at git.haskell.org Wed Aug 27 13:01:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Aug 2014 13:01:04 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Update Cabal and haddock to follow the Canal-dep removal changes (97d95b1) Message-ID: <20140827130104.D657424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/97d95b14acada7dc2d9b39dd4f65c6ffb288391f/ghc >--------------------------------------------------------------- commit 97d95b14acada7dc2d9b39dd4f65c6ffb288391f Author: Duncan Coutts Date: Wed Aug 27 13:57:46 2014 +0100 Update Cabal and haddock to follow the Canal-dep removal changes In particular, Cabal was still in one place using old file-style package databases. Haddock just needed simple changes to follow the change of representation of packages in the ghc library. >--------------------------------------------------------------- 97d95b14acada7dc2d9b39dd4f65c6ffb288391f libraries/Cabal | 2 +- utils/haddock | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 6cc4699..8d59dc9 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 6cc46998f0778c04b535c805416604995fe153b5 +Subproject commit 8d59dc9fba584a9fdb810f4d84f7f3ccb089dd08 diff --git a/utils/haddock b/utils/haddock index f32ad30..b2a807d 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit f32ad30e9b8c5d4ee54c60c9c3b282fef7d297a5 +Subproject commit b2a807da55d197c648fd2df1f156f9862711d92b From git at git.haskell.org Wed Aug 27 19:25:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Aug 2014 19:25:05 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Change testsuite to not use old-style file package databases (7273bf0) Message-ID: <20140827192506.3447324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/7273bf071d1b2cf433d249b9a2abee4a6c6aa653/ghc >--------------------------------------------------------------- commit 7273bf071d1b2cf433d249b9a2abee4a6c6aa653 Author: Duncan Coutts Date: Wed Aug 27 16:33:20 2014 +0100 Change testsuite to not use old-style file package databases Now uses ghc-pkg init. The file-style databases are no longer supported. >--------------------------------------------------------------- 7273bf071d1b2cf433d249b9a2abee4a6c6aa653 testsuite/tests/driver/T1372/Makefile | 4 ++-- testsuite/tests/driver/T3007/Makefile | 4 ++-- testsuite/tests/ghci/linking/Makefile | 6 +++--- testsuite/tests/plugins/simple-plugin/Makefile | 2 +- testsuite/tests/rename/prog006/Makefile | 3 ++- testsuite/tests/simplCore/should_compile/T7702plugin/Makefile | 2 +- testsuite/tests/typecheck/bug1465/Makefile | 4 ++-- 7 files changed, 13 insertions(+), 12 deletions(-) diff --git a/testsuite/tests/driver/T1372/Makefile b/testsuite/tests/driver/T1372/Makefile index 91ef6d5..acd6b66 100644 --- a/testsuite/tests/driver/T1372/Makefile +++ b/testsuite/tests/driver/T1372/Makefile @@ -15,7 +15,7 @@ clean: rm -f *.o *.hi rm -f clean.out prep.out rm -f p1/A.hs - rm -f $(LOCAL_PKGCONF) + rm -rf $(LOCAL_PKGCONF) T1372: $(MAKE) clean @@ -26,7 +26,7 @@ T1372: $(MAKE) clean prep: - echo "[]" >$(LOCAL_PKGCONF) + "$(GHC_PKG)" init $(LOCAL_PKGCONF) cp p1/A1.hs p1/A.hs $(MAKE) prep.p1 $(MAKE) prep.p2 diff --git a/testsuite/tests/driver/T3007/Makefile b/testsuite/tests/driver/T3007/Makefile index 7161225..8b78a49 100644 --- a/testsuite/tests/driver/T3007/Makefile +++ b/testsuite/tests/driver/T3007/Makefile @@ -6,11 +6,11 @@ clean: rm -f A/Setup A/Setup.o A/Setup.hi rm -f B/Setup B/Setup.o B/Setup.hi rm -rf A/dist B/dist - rm -f package.conf + rm -rf package.conf T3007: $(MAKE) clean - echo '[]' > package.conf + '$(GHC_PKG)' init package.conf cd A && '$(TEST_HC)' -v0 --make Setup cd A && ./Setup configure -v0 --with-compiler='$(TEST_HC)' --ghc-pkg-option=--global-package-db=../package.conf --ghc-option=-package-db../package.conf cd A && ./Setup build -v0 diff --git a/testsuite/tests/ghci/linking/Makefile b/testsuite/tests/ghci/linking/Makefile index 08c5158..5b8e23c 100644 --- a/testsuite/tests/ghci/linking/Makefile +++ b/testsuite/tests/ghci/linking/Makefile @@ -63,7 +63,7 @@ ghcilink004 : echo 'key: test-1.0' >>$(PKG004) echo 'library-dirs: $${pkgroot}' >>$(PKG004) echo 'extra-libraries: foo' >>$(PKG004) - echo '[]' >$(LOCAL_PKGCONF004) + '$(GHC_PKG)' init $(LOCAL_PKGCONF004) '$(GHC_PKG)' --no-user-package-db -f $(LOCAL_PKGCONF004) register $(PKG004) -v0 # "$(TEST_HC)" -c f.c -o dir004/foo.o @@ -91,7 +91,7 @@ ghcilink005 : echo 'key: test-1.0' >>$(PKG005) echo 'library-dirs: $${pkgroot}' >>$(PKG005) echo 'extra-libraries: foo' >>$(PKG005) - echo '[]' >$(LOCAL_PKGCONF005) + '$(GHC_PKG)' init $(LOCAL_PKGCONF005) '$(GHC_PKG)' --no-user-package-db -f $(LOCAL_PKGCONF005) register $(PKG005) -v0 # "$(TEST_HC)" -c -dynamic f.c -o dir005/foo.o @@ -115,7 +115,7 @@ ghcilink006 : echo "id: test-XXX" >>$(PKG006) echo "key: test-1.0" >>$(PKG006) echo "extra-libraries: stdc++" >>$(PKG006) - echo "[]" >$(LOCAL_PKGCONF006) + '$(GHC_PKG)' init $(LOCAL_PKGCONF006) '$(GHC_PKG)' --no-user-package-db -f $(LOCAL_PKGCONF006) register $(PKG006) -v0 # echo ":q" | "$(TEST_HC)" --interactive -ignore-dot-ghci -v0 -package-db $(LOCAL_PKGCONF006) -package test diff --git a/testsuite/tests/plugins/simple-plugin/Makefile b/testsuite/tests/plugins/simple-plugin/Makefile index 17588bf..eb7cc6a 100644 --- a/testsuite/tests/plugins/simple-plugin/Makefile +++ b/testsuite/tests/plugins/simple-plugin/Makefile @@ -13,7 +13,7 @@ package.%: mkdir pkg.$* "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs - echo "[]" > pkg.$*/local.package.conf + "$(GHC_PKG)" init pkg.$*/local.package.conf pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf pkg.$*/setup build --distdir pkg.$*/dist -v0 diff --git a/testsuite/tests/rename/prog006/Makefile b/testsuite/tests/rename/prog006/Makefile index 4124fec..e5d35e1 100644 --- a/testsuite/tests/rename/prog006/Makefile +++ b/testsuite/tests/rename/prog006/Makefile @@ -36,7 +36,8 @@ rn.prog006: echo "key: test-1.0" >>pkg.conf echo "import-dirs: `./pwd`" >>pkg.conf echo "exposed-modules: B.C" >>pkg.conf - echo "[]" >$(LOCAL_PKGCONF) + rm -rf $(LOCAL_PKGCONF) + $(GHC_PKG) init $(LOCAL_PKGCONF) $(LOCAL_GHC_PKG) register pkg.conf -v0 '$(TEST_HC)' $(TEST_HC_OPTS) -c -package-db $(LOCAL_PKGCONF) -package test -fforce-recomp A.hs -i # The -i clears the search path, so A.hs will find B.C from package test diff --git a/testsuite/tests/simplCore/should_compile/T7702plugin/Makefile b/testsuite/tests/simplCore/should_compile/T7702plugin/Makefile index 42c56c9..beba0dd 100644 --- a/testsuite/tests/simplCore/should_compile/T7702plugin/Makefile +++ b/testsuite/tests/simplCore/should_compile/T7702plugin/Makefile @@ -13,7 +13,7 @@ package.%: mkdir pkg.$* "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs - echo "[]" > pkg.$*/local.package.conf + "$(GHC_PKG)" init pkg.$*/local.package.conf pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf pkg.$*/setup build --distdir pkg.$*/dist -v0 diff --git a/testsuite/tests/typecheck/bug1465/Makefile b/testsuite/tests/typecheck/bug1465/Makefile index c082cb6..78cdd51 100644 --- a/testsuite/tests/typecheck/bug1465/Makefile +++ b/testsuite/tests/typecheck/bug1465/Makefile @@ -11,7 +11,7 @@ clean: rm -f v2/setup v2/Setup.o v2/Setup.hi rm -rf v1/dist v2/dist rm -f *.o *.hi - rm -f $(LOCAL_PKGCONF) + rm -rf $(LOCAL_PKGCONF) bug1465: $(MAKE) clean @@ -20,7 +20,7 @@ bug1465: $(MAKE) clean prep: - echo "[]" >$(LOCAL_PKGCONF) + '$(GHC_PKG)' init $(LOCAL_PKGCONF) $(MAKE) prep.v1 $(MAKE) prep.v2 '$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(LOCAL_PKGCONF) -c -package $(PKG)-1.0 B1.hs From git at git.haskell.org Wed Aug 27 19:25:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Aug 2014 19:25:09 +0000 (UTC) Subject: [commit: ghc] master: driver: pass '-fPIC' option to assembler as well (a93ab43) Message-ID: <20140827192509.3F7FF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a93ab43ab5f40cadbedea2f6342b93c245e91434/ghc >--------------------------------------------------------------- commit a93ab43ab5f40cadbedea2f6342b93c245e91434 Author: Sergei Trofimovich Date: Wed Aug 27 22:19:52 2014 +0300 driver: pass '-fPIC' option to assembler as well Summary: Before the patch '-fPIC' was passed only to C compiler, but not to assembler itself. It led to runtime crash in GHC_DYNAMIC_PROGRAMS=YES mode on sparc32. Technical details are in 'Note [-fPIC for assembler]'. Signed-off-by: Sergei Trofimovich Test Plan: validate on sparc Reviewers: simonmar, austin, kgardas Reviewed By: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D177 >--------------------------------------------------------------- a93ab43ab5f40cadbedea2f6342b93c245e91434 compiler/main/DriverPipeline.hs | 44 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 183f435..5a18e6e 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1199,6 +1199,7 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags as_prog <- whichAsProg let cmdline_include_paths = includePaths dflags + let pic_c_flags = picCCOpts dflags next_phase <- maybeMergeStub output_fn <- phaseOutputFilename next_phase @@ -1212,6 +1213,9 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags = liftIO $ as_prog dflags ([ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ] + -- See Note [-fPIC for assembler] + ++ map SysTools.Option pic_c_flags + -- We only support SparcV9 and better because V8 lacks an atomic CAS -- instruction so we have to make sure that the assembler accepts the -- instruction set. Note that the user can still override this @@ -1253,6 +1257,8 @@ runPhase (RealPhase SplitAs) _input_fn dflags osuf = objectSuf dflags split_odir = base_o ++ "_" ++ osuf ++ "_split" + let pic_c_flags = picCCOpts dflags + -- this also creates the hierarchy liftIO $ createDirectoryIfMissing True split_odir @@ -1286,6 +1292,9 @@ runPhase (RealPhase SplitAs) _input_fn dflags then [SysTools.Option "-mcpu=v9"] else []) ++ + -- See Note [-fPIC for assembler] + map SysTools.Option pic_c_flags ++ + [ SysTools.Option "-c" , SysTools.Option "-o" , SysTools.FileOption "" (split_obj n) @@ -2203,3 +2212,38 @@ haveRtsOptsFlags dflags = isJust (rtsOpts dflags) || case rtsOptsEnabled dflags of RtsOptsSafeOnly -> False _ -> True + +-- Note [-fPIC for assembler] +-- When compiling .c source file GHC's driver pipeline basically +-- does the following two things: +-- 1. ${CC} -S 'PIC_CFLAGS' source.c +-- 2. ${CC} -x assembler -c 'PIC_CFLAGS' source.S +-- +-- Why do we need to pass 'PIC_CFLAGS' both to C compiler and assembler? +-- Because on some architectures (at least sparc32) assembler also choses +-- relocation type! +-- Consider the following C module: +-- +-- /* pic-sample.c */ +-- int v; +-- void set_v (int n) { v = n; } +-- int get_v (void) { return v; } +-- +-- $ gcc -S -fPIC pic-sample.c +-- $ gcc -c pic-sample.s -o pic-sample.no-pic.o # incorrect binary +-- $ gcc -c -fPIC pic-sample.s -o pic-sample.pic.o # correct binary +-- +-- $ objdump -r -d pic-sample.pic.o > pic-sample.pic.o.od +-- $ objdump -r -d pic-sample.no-pic.o > pic-sample.no-pic.o.od +-- $ diff -u pic-sample.pic.o.od pic-sample.no-pic.o.od +-- +-- Most of architectures won't show any difference in this test, but on sparc32 +-- the following assembly snippet: +-- +-- sethi %hi(_GLOBAL_OFFSET_TABLE_-8), %l7 +-- +-- generates two kinds or relocations, only 'R_SPARC_PC22' is correct: +-- +-- 3c: 2f 00 00 00 sethi %hi(0), %l7 +-- - 3c: R_SPARC_PC22 _GLOBAL_OFFSET_TABLE_-0x8 +-- + 3c: R_SPARC_HI22 _GLOBAL_OFFSET_TABLE_-0x8 From git at git.haskell.org Wed Aug 27 19:25:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Aug 2014 19:25:12 +0000 (UTC) Subject: [commit: ghc] master: Revert "disable shared libs on sparc (linux/solaris) (fixes #8857)" (78863ed) Message-ID: <20140827192512.EA5CB24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/78863edbb0751f5c9694ea10c6132a87cfd0ee10/ghc >--------------------------------------------------------------- commit 78863edbb0751f5c9694ea10c6132a87cfd0ee10 Author: Sergei Trofimovich Date: Wed Aug 27 22:20:33 2014 +0300 Revert "disable shared libs on sparc (linux/solaris) (fixes #8857)" This reverts commit 623883f1ed0ee11cc925c4590fb09565403fd231. The commit a93ab43ab5f40cadbedea2f6342b93c245e91434 driver: pass '-fPIC' option to assembler as well fixes shared libraries on sparc at least on linux. Properly fixes Issue #8857 Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 78863edbb0751f5c9694ea10c6132a87cfd0ee10 mk/config.mk.in | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/mk/config.mk.in b/mk/config.mk.in index c210cd3..392237f 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -97,9 +97,7 @@ endif # Some platforms don't support shared libraries NoSharedLibsPlatformList = powerpc-unknown-linux \ x86_64-unknown-mingw32 \ - i386-unknown-mingw32 \ - sparc-sun-solaris2 \ - sparc-unknown-linux + i386-unknown-mingw32 ifeq "$(SOLARIS_BROKEN_SHLD)" "YES" NoSharedLibsPlatformList += i386-unknown-solaris2 From git at git.haskell.org Thu Aug 28 04:59:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 04:59:14 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Fix a few minor issues spotted in code review (22c6ff5) Message-ID: <20140828045914.597F124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/22c6ff56ce806a16d9bfb0794978a47d0f25f63b/ghc >--------------------------------------------------------------- commit 22c6ff56ce806a16d9bfb0794978a47d0f25f63b Author: Duncan Coutts Date: Thu Aug 28 05:24:04 2014 +0100 Fix a few minor issues spotted in code review >--------------------------------------------------------------- 22c6ff56ce806a16d9bfb0794978a47d0f25f63b compiler/main/PackageConfig.hs | 0 compiler/main/Packages.lhs | 3 ++- utils/ghc-pkg/Main.hs | 3 +-- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 37ddd84..01c75c0 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -1363,7 +1363,8 @@ add_package pkg_db ipid_map ps (p, mb_parent) | Just pid <- Map.lookup ipid ipid_map = add_package pkg_db ipid_map ps (pid, Just p) | otherwise - = Failed (missingPackageMsg ipid <> missingDependencyMsg mb_parent) + = Failed (missingPackageMsg ipid + <> missingDependencyMsg mb_parent) missingPackageErr :: Outputable pkgid => DynFlags -> pkgid -> IO a missingPackageErr dflags p diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index fdb255a..ac958da 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -57,7 +57,6 @@ import Control.Concurrent import qualified Data.ByteString.Char8 as BS import Data.Binary as Bin ---import qualified Data.Binary.Get as Bin #if defined(mingw32_HOST_OS) -- mingw32 needs these for getExecDir @@ -2141,4 +2140,4 @@ instance Binary PackageKey where case n of 0 -> do a <- get; b <- get; c <- get; return (PackageKey a b c) 1 -> do a <- get; return (OldPackageKey a) - _ -> error ("Binary PackageKey: bad branch " ++ show n) + _ -> fail ("Binary PackageKey: bad branch " ++ show n) From git at git.haskell.org Thu Aug 28 04:59:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 04:59:17 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Add release notes about ghc-pkg change, and Cabal dep removal (f993247) Message-ID: <20140828045917.3E5C824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/f993247f0fb15586602db3c33e4539f0ab6f6a8d/ghc >--------------------------------------------------------------- commit f993247f0fb15586602db3c33e4539f0ab6f6a8d Author: Duncan Coutts Date: Thu Aug 28 05:52:48 2014 +0100 Add release notes about ghc-pkg change, and Cabal dep removal That ghc-pkg doesn't support single-file style databases, and that the ghc library does not depend on Cabal any more. We don't need to document the ghc-pkg change in the ghc-pkg section itself, since ghc-pkg init is already described there, and that is the right thing. The old deprecated approach was not documented. >--------------------------------------------------------------- f993247f0fb15586602db3c33e4539f0ab6f6a8d docs/users_guide/7.10.1-notes.xml | 43 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/docs/users_guide/7.10.1-notes.xml b/docs/users_guide/7.10.1-notes.xml index 0af4c31..404d239 100644 --- a/docs/users_guide/7.10.1-notes.xml +++ b/docs/users_guide/7.10.1-notes.xml @@ -118,6 +118,39 @@ + + + Package system + + + + TODO: cover module renaming, thinning, re-export etc + + + + + ghc-pkg (and ghc) have dropped support for single-file style + package databases. Since version 6.12, ghc-pkg has defaulted + to a new database format (using a directory of files, one per + package plus a binary cache). + + + This change will not affect programs and scripts that use + ghc-pkg init to create package databases. + + + This will affect scripts that create package databases + using tricks like + +echo "[]" > package.conf + + Such scripts will need to be modified to use + ghc-pkg init, and to delete databases + by directory removal, rather than simple file delete. + + + + @@ -251,6 +284,16 @@ package ID. + + + The ghc library no longer depends on the Cabal library. This means + that users of the ghc library are no longer forced to use the same + version of Cabal as ghc did. It also means that Cabal is freed up + to be able to depend on packages that ghc does not want to depend + on (which for example may enable improvements to Cabal's parsing + infrastructure). + + From git at git.haskell.org Thu Aug 28 11:11:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:11:44 +0000 (UTC) Subject: [commit: ghc] master: Less voluminous output when printing continuations (e9cd1d5) Message-ID: <20140828111144.938B724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e9cd1d5e9d6f0e019d6433a3c7dd9585b3f7ae6b/ghc >--------------------------------------------------------------- commit e9cd1d5e9d6f0e019d6433a3c7dd9585b3f7ae6b Author: Simon Peyton Jones Date: Thu May 8 11:05:39 2014 +0100 Less voluminous output when printing continuations >--------------------------------------------------------------- e9cd1d5e9d6f0e019d6433a3c7dd9585b3f7ae6b compiler/simplCore/SimplUtils.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs index 888c923..941587c 100644 --- a/compiler/simplCore/SimplUtils.lhs +++ b/compiler/simplCore/SimplUtils.lhs @@ -194,7 +194,7 @@ instance Outputable SimplCont where ppr (StrictBind b _ _ _ cont) = (ptext (sLit "StrictBind") <+> ppr b) $$ ppr cont ppr (StrictArg ai _ cont) = (ptext (sLit "StrictArg") <+> ppr (ai_fun ai)) $$ ppr cont ppr (Select dup bndr alts se cont) = (ptext (sLit "Select") <+> ppr dup <+> ppr bndr) $$ - (nest 2 $ vcat [ppr (seTvSubst se), ppr alts]) $$ ppr cont + ifPprDebug (nest 2 $ vcat [ppr (seTvSubst se), ppr alts]) $$ ppr cont ppr (CoerceIt co cont) = (ptext (sLit "CoerceIt") <+> ppr co) $$ ppr cont ppr (TickIt t cont) = (ptext (sLit "TickIt") <+> ppr t) $$ ppr cont From git at git.haskell.org Thu Aug 28 11:11:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:11:46 +0000 (UTC) Subject: [commit: ghc] master: Refactor unfoldings (6e0f6ed) Message-ID: <20140828111147.33F0B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6e0f6ededff6018a88dd390590a09f79842ccfa5/ghc >--------------------------------------------------------------- commit 6e0f6ededff6018a88dd390590a09f79842ccfa5 Author: Simon Peyton Jones Date: Thu May 8 11:21:16 2014 +0100 Refactor unfoldings There are two main refactorings here 1. Move the uf_arity field out of CoreUnfolding into UnfWhen It's a lot tidier there. If I've got this right, no behaviour should change. 2. Define specUnfolding and use it in DsBinds and Specialise a) commons-up some shared code b) makes sure that Specialise correctly specialises DFun unfoldings (which it didn't before) The two got put together because both ended up interacting in the specialiser. They cause zero difference to nofib. >--------------------------------------------------------------- 6e0f6ededff6018a88dd390590a09f79842ccfa5 compiler/coreSyn/CoreSubst.lhs | 9 +- compiler/coreSyn/CoreSyn.lhs | 13 +- compiler/coreSyn/CoreUnfold.lhs | 307 +++++++++++++-------- compiler/coreSyn/PprCore.lhs | 8 +- compiler/deSugar/DsBinds.lhs | 24 +- compiler/iface/MkIface.lhs | 10 +- compiler/iface/TcIface.lhs | 6 +- compiler/simplCore/Simplify.lhs | 10 +- compiler/specialise/Specialise.lhs | 97 ++++--- .../tests/deSugar/should_compile/T2431.stderr | 6 +- .../tests/numeric/should_compile/T7116.stdout | 24 +- .../tests/simplCore/should_compile/T3717.stderr | 6 +- .../tests/simplCore/should_compile/T4908.stderr | 11 +- .../tests/simplCore/should_compile/T4930.stderr | 6 +- .../tests/simplCore/should_compile/T7360.stderr | 22 +- .../tests/simplCore/should_compile/T7785.stderr | 2 +- .../tests/simplCore/should_compile/T8848.stderr | 4 +- testsuite/tests/simplCore/should_compile/all.T | 2 +- .../simplCore/should_compile/spec-inline.stderr | 27 +- testsuite/tests/simplCore/should_run/T2486.stderr | 8 +- 20 files changed, 340 insertions(+), 262 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6e0f6ededff6018a88dd390590a09f79842ccfa5 From git at git.haskell.org Thu Aug 28 11:11:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:11:50 +0000 (UTC) Subject: [commit: ghc] master: Kill unused setUnfoldingTemplate (3af1adf) Message-ID: <20140828111150.9583B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3af1adf99f1e30a26e540add808d10c2205a2e20/ghc >--------------------------------------------------------------- commit 3af1adf99f1e30a26e540add808d10c2205a2e20 Author: Simon Peyton Jones Date: Fri May 9 10:55:15 2014 +0100 Kill unused setUnfoldingTemplate >--------------------------------------------------------------- 3af1adf99f1e30a26e540add808d10c2205a2e20 compiler/coreSyn/CoreSyn.lhs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index d107c90..f16e53d 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -54,7 +54,7 @@ module CoreSyn ( unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk, -- ** Predicates and deconstruction on 'Unfolding' - unfoldingTemplate, setUnfoldingTemplate, expandUnfolding_maybe, + unfoldingTemplate, expandUnfolding_maybe, maybeUnfoldingTemplate, otherCons, isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding, @@ -868,9 +868,6 @@ isStableSource InlineRhs = False unfoldingTemplate :: Unfolding -> CoreExpr unfoldingTemplate = uf_tmpl -setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding -setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs } - -- | Retrieves the template of an unfolding if possible maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr From git at git.haskell.org Thu Aug 28 11:11:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:11:53 +0000 (UTC) Subject: [commit: ghc] master: Make maybeUnfoldingTemplate respond to DFunUnfoldings (8f09937) Message-ID: <20140828111153.4413A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8f09937426a40b9c638d63a2d726c3b755f88f82/ghc >--------------------------------------------------------------- commit 8f09937426a40b9c638d63a2d726c3b755f88f82 Author: Simon Peyton Jones Date: Fri May 9 10:59:40 2014 +0100 Make maybeUnfoldingTemplate respond to DFunUnfoldings CoreSyn.maybeUnfoldingTemplate is used mainly when specialising, so make DFunUnfoldings respond to it makes it possible to specialise them properly. >--------------------------------------------------------------- 8f09937426a40b9c638d63a2d726c3b755f88f82 compiler/coreSyn/CoreSyn.lhs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index f16e53d..e82303c 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -869,9 +869,16 @@ unfoldingTemplate :: Unfolding -> CoreExpr unfoldingTemplate = uf_tmpl -- | Retrieves the template of an unfolding if possible +-- maybeUnfoldingTemplate is used mainly wnen specialising, and we do +-- want to specialise DFuns, so it's important to return a template +-- for DFunUnfoldings maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr -maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr -maybeUnfoldingTemplate _ = Nothing +maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) + = Just expr +maybeUnfoldingTemplate (DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = args }) + = Just (mkLams bndrs (mkApps (Var (dataConWorkId con)) args)) +maybeUnfoldingTemplate _ + = Nothing -- | The constructors that the unfolding could never be: -- returns @[]@ if no information is available From git at git.haskell.org Thu Aug 28 11:11:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:11:58 +0000 (UTC) Subject: [commit: ghc] master: Specialise Eq, Ord, Read, Show at Int, Char, String (4c03791) Message-ID: <20140828111158.543C224123@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4c03791f986509c5d95adf50de555876ed05522e/ghc >--------------------------------------------------------------- commit 4c03791f986509c5d95adf50de555876ed05522e Author: Simon Peyton Jones Date: Mon May 12 10:53:09 2014 +0100 Specialise Eq, Ord, Read, Show at Int, Char, String These instances are quite common, so it's good to have pre-specialised versions available >--------------------------------------------------------------- 4c03791f986509c5d95adf50de555876ed05522e libraries/base/GHC/Read.lhs | 3 +++ libraries/base/GHC/Show.lhs | 5 ++++- libraries/ghc-prim/GHC/Classes.hs | 4 ++++ 3 files changed, 11 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/Read.lhs b/libraries/base/GHC/Read.lhs index ab730e6..2fd9f30 100644 --- a/libraries/base/GHC/Read.lhs +++ b/libraries/base/GHC/Read.lhs @@ -423,6 +423,9 @@ instance Read a => Read (Maybe a) where readList = readListDefault instance Read a => Read [a] where + {-# SPECIALISE instance Read [String] #-} + {-# SPECIALISE instance Read [Char] #-} + {-# SPECIALISE instance Read [Int] #-} readPrec = readListPrec readListPrec = readListPrecDefault readList = readListDefault diff --git a/libraries/base/GHC/Show.lhs b/libraries/base/GHC/Show.lhs index 45338e8..09c3c56 100644 --- a/libraries/base/GHC/Show.lhs +++ b/libraries/base/GHC/Show.lhs @@ -184,7 +184,10 @@ instance Show () where showsPrec _ () = showString "()" instance Show a => Show [a] where - showsPrec _ = showList + {-# SPECIALISE instance Show [String] #-} + {-# SPECIALISE instance Show [Char] #-} + {-# SPECIALISE instance Show [Int] #-} + showsPrec _ = showList instance Show Bool where showsPrec _ True = showString "True" diff --git a/libraries/ghc-prim/GHC/Classes.hs b/libraries/ghc-prim/GHC/Classes.hs index 5bb4cb6..9028f6e 100644 --- a/libraries/ghc-prim/GHC/Classes.hs +++ b/libraries/ghc-prim/GHC/Classes.hs @@ -83,7 +83,9 @@ deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) instance (Eq a) => Eq [a] where + {-# SPECIALISE instance Eq [[Char]] #-} {-# SPECIALISE instance Eq [Char] #-} + {-# SPECIALISE instance Eq [Int] #-} [] == [] = True (x:xs) == (y:ys) = x == y && xs == ys _xs == _ys = False @@ -181,7 +183,9 @@ deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, => Ord (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) instance (Ord a) => Ord [a] where + {-# SPECIALISE instance Ord [[Char]] #-} {-# SPECIALISE instance Ord [Char] #-} + {-# SPECIALISE instance Ord [Int] #-} compare [] [] = EQ compare [] (_:_) = LT compare (_:_) [] = GT From git at git.haskell.org Thu Aug 28 11:11:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:11:55 +0000 (UTC) Subject: [commit: ghc] master: Make worker/wrapper work on INLINEABLE things (9cf5906) Message-ID: <20140828111155.ABC7324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9cf5906b692c31b7ec67856b0859cb0e33770651/ghc >--------------------------------------------------------------- commit 9cf5906b692c31b7ec67856b0859cb0e33770651 Author: Simon Peyton Jones Date: Fri May 9 11:15:33 2014 +0100 Make worker/wrapper work on INLINEABLE things This fixes a long-standing bug: Trac #6056. The trouble was that INLINEABLE "used up" the unfolding for the Id, so it couldn't be worker/wrapper'd by the strictness analyser. This patch allows the w/w to go ahead, and makes the *worker* INLINEABLE instead, so it can later be specialised. However, that doesn't completely solve the problem, because the dictionary argument (which the specialiser treats specially) may be strict and hence unpacked by w/w, so now the worker won't be specilialised after all. Solution: never unpack dictionary arguments, which is done by the isClassTyCon test in WwLib.deepSplitProductType_maybe >--------------------------------------------------------------- 9cf5906b692c31b7ec67856b0859cb0e33770651 compiler/coreSyn/CoreUnfold.lhs | 51 +++++++++++++++++----- compiler/stranal/WorkWrap.lhs | 95 +++++++++++++++++++++++++---------------- compiler/stranal/WwLib.lhs | 20 +++++++++ 3 files changed, 119 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 9cf5906b692c31b7ec67856b0859cb0e33770651 From git at git.haskell.org Thu Aug 28 11:12:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:00 +0000 (UTC) Subject: [commit: ghc] master: Move the Enum Word instance into GHC.Enum (3436333) Message-ID: <20140828111201.0AF8A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/343633307f5a24c741b80bbbc952919d9947f56c/ghc >--------------------------------------------------------------- commit 343633307f5a24c741b80bbbc952919d9947f56c Author: Simon Peyton Jones Date: Mon May 12 10:54:30 2014 +0100 Move the Enum Word instance into GHC.Enum This just avoids an unnecessary orphan instance. All the other instances for "earlier" types are in GHC.Enum already. >--------------------------------------------------------------- 343633307f5a24c741b80bbbc952919d9947f56c libraries/base/GHC/Enum.lhs | 35 +++++++++++++++++++++++++++++++++++ libraries/base/GHC/Real.lhs | 25 +------------------------ 2 files changed, 36 insertions(+), 24 deletions(-) diff --git a/libraries/base/GHC/Enum.lhs b/libraries/base/GHC/Enum.lhs index d94e2ec..a6dae7a 100644 --- a/libraries/base/GHC/Enum.lhs +++ b/libraries/base/GHC/Enum.lhs @@ -650,6 +650,41 @@ instance Bounded Word where #else #error Unhandled value for WORD_SIZE_IN_BITS #endif + +instance Enum Word where + succ x + | x /= maxBound = x + 1 + | otherwise = succError "Word" + pred x + | x /= minBound = x - 1 + | otherwise = predError "Word" + toEnum i@(I# i#) + | i >= 0 = W# (int2Word# i#) + | otherwise = toEnumError "Word" i (minBound::Word, maxBound::Word) + fromEnum x@(W# x#) + | x <= maxIntWord = I# (word2Int# x#) + | otherwise = fromEnumError "Word" x + + enumFrom n = map integerToWordX [wordToIntegerX n .. wordToIntegerX (maxBound :: Word)] + enumFromTo n1 n2 = map integerToWordX [wordToIntegerX n1 .. wordToIntegerX n2] + enumFromThenTo n1 n2 m = map integerToWordX [wordToIntegerX n1, wordToIntegerX n2 .. wordToIntegerX m] + enumFromThen n1 n2 = map integerToWordX [wordToIntegerX n1, wordToIntegerX n2 .. wordToIntegerX limit] + where + limit :: Word + limit | n2 >= n1 = maxBound + | otherwise = minBound + +maxIntWord :: Word +-- The biggest word representable as an Int +maxIntWord = W# (case maxInt of I# i -> int2Word# i) + +-- For some reason integerToWord and wordToInteger (GHC.Integer.Type) +-- work over Word# +integerToWordX :: Integer -> Word +integerToWordX i = W# (integerToWord i) + +wordToIntegerX :: Word -> Integer +wordToIntegerX (W# x#) = wordToInteger x# \end{code} diff --git a/libraries/base/GHC/Real.lhs b/libraries/base/GHC/Real.lhs index d70dd81..a54818f 100644 --- a/libraries/base/GHC/Real.lhs +++ b/libraries/base/GHC/Real.lhs @@ -345,30 +345,7 @@ instance Integral Word where divMod (W# x#) y@(W# y#) | y /= 0 = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W# x#) - | isTrue# (i# >=# 0#) = smallInteger i# - | otherwise = wordToInteger x# - where - !i# = word2Int# x# - -instance Enum Word where - succ x - | x /= maxBound = x + 1 - | otherwise = succError "Word" - pred x - | x /= minBound = x - 1 - | otherwise = predError "Word" - toEnum i@(I# i#) - | i >= 0 = W# (int2Word# i#) - | otherwise = toEnumError "Word" i (minBound::Word, maxBound::Word) - fromEnum x@(W# x#) - | x <= fromIntegral (maxBound::Int) - = I# (word2Int# x#) - | otherwise = fromEnumError "Word" x - enumFrom = integralEnumFrom - enumFromThen = integralEnumFromThen - enumFromTo = integralEnumFromTo - enumFromThenTo = integralEnumFromThenTo + toInteger (W# x#) = wordToInteger x# \end{code} From git at git.haskell.org Thu Aug 28 11:12:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:02 +0000 (UTC) Subject: [commit: ghc] master: Don't float out (classop dict e1 e2) (949ad67) Message-ID: <20140828111202.ECA4A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/949ad67e2f475864a405d214c3e02f2918931eb8/ghc >--------------------------------------------------------------- commit 949ad67e2f475864a405d214c3e02f2918931eb8 Author: Simon Peyton Jones Date: Tue May 13 10:00:45 2014 +0100 Don't float out (classop dict e1 e2) A class op applied to a dictionary doesn't do much work, so it's not a great idea to float it out (except possibly to the top level. See Note [Floating over-saturated applications] in SetLevels I also renamed "floatOutPartialApplications" to "floatOutOverSatApps"; the former is deeply confusing, since there is no partial application involved -- quite the reverse, it is *over* saturated. >--------------------------------------------------------------- 949ad67e2f475864a405d214c3e02f2918931eb8 compiler/simplCore/CoreMonad.lhs | 8 +++++--- compiler/simplCore/SetLevels.lhs | 29 ++++++++++++++++++++--------- compiler/simplCore/SimplCore.lhs | 10 +++++----- 3 files changed, 30 insertions(+), 17 deletions(-) diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs index c060360..faec02e 100644 --- a/compiler/simplCore/CoreMonad.lhs +++ b/compiler/simplCore/CoreMonad.lhs @@ -418,8 +418,10 @@ data FloatOutSwitches = FloatOutSwitches { floatOutConstants :: Bool, -- ^ True <=> float constants to top level, -- even if they do not escape a lambda - floatOutPartialApplications :: Bool -- ^ True <=> float out partial applications - -- based on arity information. + floatOutOverSatApps :: Bool -- ^ True <=> float out over-saturated applications + -- based on arity information. + -- See Note [Floating over-saturated applications] + -- in SetLevels } instance Outputable FloatOutSwitches where ppr = pprFloatOutSwitches @@ -430,7 +432,7 @@ pprFloatOutSwitches sw sep $ punctuate comma $ [ ptext (sLit "Lam =") <+> ppr (floatOutLambdas sw) , ptext (sLit "Consts =") <+> ppr (floatOutConstants sw) - , ptext (sLit "PAPs =") <+> ppr (floatOutPartialApplications sw) ]) + , ptext (sLit "OverSatApps =") <+> ppr (floatOutOverSatApps sw) ]) -- The core-to-core pass ordering is derived from the DynFlags: runWhen :: Bool -> CoreToDo -> CoreToDo diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs index 52bcecf..c69687b 100644 --- a/compiler/simplCore/SetLevels.lhs +++ b/compiler/simplCore/SetLevels.lhs @@ -245,6 +245,20 @@ lvlTopBind env (Rec pairs) %* * %************************************************************************ +Note [Floating over-saturated applications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If we see (f x y), and (f x) is a redex (ie f's arity is 1), +we call (f x) an "over-saturated application" + +Should we float out an over-sat app, if can escape a value lambda? +It is sometimes very beneficial (-7% runtime -4% alloc over nofib -O2). +But we don't want to do it for class selectors, because the work saved +is minimal, and the extra local thunks allocated cost money. + +Arguably we could float even class-op applications if they were going to +top level -- but then they must be applied to a constant dictionary and +will almost certainly be optimised away anyway. + \begin{code} lvlExpr :: LevelEnv -- Context -> CoreExprWithFVs -- Input expression @@ -285,13 +299,10 @@ lvlExpr env expr@(_, AnnApp _ _) = do (fun, args) = collectAnnArgs expr -- case fun of - -- float out partial applications. This is very beneficial - -- in some cases (-7% runtime -4% alloc over nofib -O2). - -- In order to float a PAP, there must be a function at the - -- head of the application, and the application must be - -- over-saturated with respect to the function's arity. - (_, AnnVar f) | floatPAPs env && - arity > 0 && arity < n_val_args -> + (_, AnnVar f) | floatOverSat env -- See Note [Floating over-saturated applications] + , arity > 0 + , arity < n_val_args + , Nothing <- isClassOpId_maybe f -> do let (lapp, rargs) = left (n_val_args - arity) expr [] rargs' <- mapM (lvlMFE False env) rargs @@ -940,8 +951,8 @@ floatLams le = floatOutLambdas (le_switches le) floatConsts :: LevelEnv -> Bool floatConsts le = floatOutConstants (le_switches le) -floatPAPs :: LevelEnv -> Bool -floatPAPs le = floatOutPartialApplications (le_switches le) +floatOverSat :: LevelEnv -> Bool +floatOverSat le = floatOutOverSatApps (le_switches le) setCtxtLvl :: LevelEnv -> Level -> LevelEnv setCtxtLvl env lvl = env { le_ctxt_lvl = lvl } diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 59b39a9..1a7fd67 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -227,7 +227,7 @@ getCoreToDo dflags CoreDoFloatOutwards FloatOutSwitches { floatOutLambdas = Just 0, floatOutConstants = True, - floatOutPartialApplications = False }, + floatOutOverSatApps = False }, -- Was: gentleFloatOutSwitches -- -- I have no idea why, but not floating constants to @@ -239,7 +239,7 @@ getCoreToDo dflags -- made 0.0% difference to any other nofib -- benchmark -- - -- Not doing floatOutPartialApplications yet, we'll do + -- Not doing floatOutOverSatApps yet, we'll do -- that later on when we've had a chance to get more -- accurate arity information. In fact it makes no -- difference at all to performance if we do it here, @@ -271,9 +271,9 @@ getCoreToDo dflags runWhen full_laziness $ CoreDoFloatOutwards FloatOutSwitches { - floatOutLambdas = floatLamArgs dflags, - floatOutConstants = True, - floatOutPartialApplications = True }, + floatOutLambdas = floatLamArgs dflags, + floatOutConstants = True, + floatOutOverSatApps = True }, -- nofib/spectral/hartel/wang doubles in speed if you -- do full laziness late in the day. It only happens -- after fusion and other stuff, so the early pass doesn't From git at git.haskell.org Thu Aug 28 11:12:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:05 +0000 (UTC) Subject: [commit: ghc] master: Slightly improve fusion rules for 'take' (2ef997b) Message-ID: <20140828111205.78A4324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2ef997b827a5630ad639b5283574a4273cae47ce/ghc >--------------------------------------------------------------- commit 2ef997b827a5630ad639b5283574a4273cae47ce Author: Simon Peyton Jones Date: Tue May 13 10:55:33 2014 +0100 Slightly improve fusion rules for 'take' >--------------------------------------------------------------- 2ef997b827a5630ad639b5283574a4273cae47ce libraries/base/GHC/List.lhs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/libraries/base/GHC/List.lhs b/libraries/base/GHC/List.lhs index 9b6cc2e..bcc5fea 100644 --- a/libraries/base/GHC/List.lhs +++ b/libraries/base/GHC/List.lhs @@ -385,10 +385,17 @@ takeFoldr (I# n#) xs takeConst :: a -> Int# -> a takeConst x _ = x -{-# NOINLINE [0] takeFB #-} +{-# INLINE [0] takeFB #-} takeFB :: (a -> b -> b) -> b -> a -> (Int# -> b) -> Int# -> b -takeFB c n x xs m | isTrue# (m <=# 1#) = x `c` n - | otherwise = x `c` xs (m -# 1#) +-- The \m accounts for the fact that takeFB is used in a higher-order +-- way by takeFoldr, so it's better to inline. A good example is +-- take n (repeat x) +-- for which we get excellent code... but only if we inline takeFB +-- when given four arguments +takeFB c n x xs + = \ m -> if isTrue# (m <=# 1#) + then x `c` n + else x `c` xs (m -# 1#) {-# INLINE [0] take #-} take (I# n#) xs = takeUInt n# xs From git at git.haskell.org Thu Aug 28 11:12:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:07 +0000 (UTC) Subject: [commit: ghc] master: Wibbles to "...plus N others" error message about instances in scope (baa3c9a) Message-ID: <20140828111207.DB23224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/baa3c9a306df0432f2697009585c66ff096d197e/ghc >--------------------------------------------------------------- commit baa3c9a306df0432f2697009585c66ff096d197e Author: Simon Peyton Jones Date: Tue May 13 12:42:58 2014 +0100 Wibbles to "...plus N others" error message about instances in scope I this this arises from my de-orphaning the Enum Word instance >--------------------------------------------------------------- baa3c9a306df0432f2697009585c66ff096d197e testsuite/tests/annotations/should_fail/annfail10.stderr | 3 +-- testsuite/tests/ghci.debugger/scripts/break006.stderr | 10 ++++------ testsuite/tests/ghci.debugger/scripts/print019.stderr | 2 +- testsuite/tests/ghci/scripts/Defer02.stderr | 5 ++--- .../overloadedlists/should_fail/overloadedlistsfail01.stderr | 10 ++++------ testsuite/tests/typecheck/should_compile/holes2.stderr | 5 ++--- testsuite/tests/typecheck/should_fail/tcfail008.stderr | 5 ++--- testsuite/tests/typecheck/should_fail/tcfail072.stderr | 6 +++--- testsuite/tests/typecheck/should_fail/tcfail133.stderr | 2 +- 9 files changed, 20 insertions(+), 28 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc baa3c9a306df0432f2697009585c66ff096d197e From git at git.haskell.org Thu Aug 28 11:12:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:10 +0000 (UTC) Subject: [commit: ghc] master: Specialise monad functions, and make them INLINEABLE (99178c1) Message-ID: <20140828111210.D847724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/99178c1f904166911483c692f9438ff4992ec2dc/ghc >--------------------------------------------------------------- commit 99178c1f904166911483c692f9438ff4992ec2dc Author: Simon Peyton Jones Date: Tue May 13 10:59:19 2014 +0100 Specialise monad functions, and make them INLINEABLE Specialise liftM, foldM, etc, and make them specialisable for new monads at their call sites by using INLINEABLE >--------------------------------------------------------------- 99178c1f904166911483c692f9438ff4992ec2dc libraries/base/Control/Monad.hs | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 00c1fdd..4a8060f 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -210,14 +210,17 @@ join x = x >>= id -- the result as a pair of lists. This function is mainly used with complicated -- data structures or a state-transforming monad. mapAndUnzipM :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c]) +{-# INLINE mapAndUnzipM #-} mapAndUnzipM f xs = sequence (map f xs) >>= return . unzip -- | The 'zipWithM' function generalizes 'zipWith' to arbitrary monads. zipWithM :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c] +{-# INLINE zipWithM #-} zipWithM f xs ys = sequence (zipWith f xs ys) -- | 'zipWithM_' is the extension of 'zipWithM' which ignores the final result. zipWithM_ :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m () +{-# INLINE zipWithM_ #-} zipWithM_ f xs ys = sequence_ (zipWith f xs ys) {- | The 'foldM' function is analogous to 'foldl', except that its result is @@ -240,20 +243,32 @@ If right-to-left evaluation is required, the input list should be reversed. -} foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a +{-# INLINEABLE foldM #-} +{-# SPECIALISE foldM :: (a -> b -> IO a) -> a -> [b] -> IO a #-} +{-# SPECIALISE foldM :: (a -> b -> Maybe a) -> a -> [b] -> Maybe a #-} foldM _ a [] = return a foldM f a (x:xs) = f a x >>= \fax -> foldM f fax xs -- | Like 'foldM', but discards the result. foldM_ :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m () +{-# INLINEABLE foldM_ #-} +{-# SPECIALISE foldM_ :: (a -> b -> IO a) -> a -> [b] -> IO () #-} +{-# SPECIALISE foldM_ :: (a -> b -> Maybe a) -> a -> [b] -> Maybe () #-} foldM_ f a xs = foldM f a xs >> return () -- | @'replicateM' n act@ performs the action @n@ times, -- gathering the results. replicateM :: (Monad m) => Int -> m a -> m [a] +{-# INLINEABLE replicateM #-} +{-# SPECIALISE replicateM :: Int -> IO a -> IO [a] #-} +{-# SPECIALISE replicateM :: Int -> Maybe a -> Maybe [a] #-} replicateM n x = sequence (replicate n x) -- | Like 'replicateM', but discards the result. replicateM_ :: (Monad m) => Int -> m a -> m () +{-# INLINEABLE replicateM_ #-} +{-# SPECIALISE replicateM_ :: Int -> IO a -> IO () #-} +{-# SPECIALISE replicateM_ :: Int -> Maybe a -> Maybe () #-} replicateM_ n x = sequence_ (replicate n x) {- | Conditional execution of monadic expressions. For example, @@ -265,11 +280,17 @@ and otherwise do nothing. -} when :: (Monad m) => Bool -> m () -> m () +{-# INLINEABLE when #-} +{-# SPECIALISE when :: Bool -> IO () -> IO () #-} +{-# SPECIALISE when :: Bool -> Maybe () -> Maybe () #-} when p s = if p then s else return () -- | The reverse of 'when'. unless :: (Monad m) => Bool -> m () -> m () +{-# INLINEABLE unless #-} +{-# SPECIALISE unless :: Bool -> IO () -> IO () #-} +{-# SPECIALISE unless :: Bool -> Maybe () -> Maybe () #-} unless p s = if p then return () else s -- | Promote a function to a monad. @@ -300,6 +321,22 @@ liftM4 f m1 m2 m3 m4 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f liftM5 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) } +{-# INLINEABLE liftM #-} +{-# SPECIALISE liftM :: (a1->r) -> IO a1 -> IO r #-} +{-# SPECIALISE liftM :: (a1->r) -> Maybe a1 -> Maybe r #-} +{-# INLINEABLE liftM2 #-} +{-# SPECIALISE liftM2 :: (a1->a2->r) -> IO a1 -> IO a2 -> IO r #-} +{-# SPECIALISE liftM2 :: (a1->a2->r) -> Maybe a1 -> Maybe a2 -> Maybe r #-} +{-# INLINEABLE liftM3 #-} +{-# SPECIALISE liftM3 :: (a1->a2->a3->r) -> IO a1 -> IO a2 -> IO a3 -> IO r #-} +{-# SPECIALISE liftM3 :: (a1->a2->a3->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe r #-} +{-# INLINEABLE liftM4 #-} +{-# SPECIALISE liftM4 :: (a1->a2->a3->a4->r) -> IO a1 -> IO a2 -> IO a3 -> IO a4 -> IO r #-} +{-# SPECIALISE liftM4 :: (a1->a2->a3->a4->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe r #-} +{-# INLINEABLE liftM5 #-} +{-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> IO a1 -> IO a2 -> IO a3 -> IO a4 -> IO a5 -> IO r #-} +{-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe a5 -> Maybe r #-} + {- | In many situations, the 'liftM' operations can be replaced by uses of 'ap', which promotes function application. @@ -337,6 +374,7 @@ f <$!> m = do -- @mfilter odd (Just 2) == Nothing@ mfilter :: (MonadPlus m) => (a -> Bool) -> m a -> m a +{-# INLINEABLE mfilter #-} mfilter p ma = do a <- ma if p a then return a else mzero From git at git.haskell.org Thu Aug 28 11:12:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:13 +0000 (UTC) Subject: [commit: ghc] master: More SPEC rules fire (a3e207f) Message-ID: <20140828111213.4ED4E24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a3e207f6032745adb9289da73a87170bdeab517d/ghc >--------------------------------------------------------------- commit a3e207f6032745adb9289da73a87170bdeab517d Author: Simon Peyton Jones Date: Tue May 13 12:43:27 2014 +0100 More SPEC rules fire >--------------------------------------------------------------- a3e207f6032745adb9289da73a87170bdeab517d testsuite/tests/perf/compiler/T4007.stdout | 3 +-- testsuite/tests/simplCore/should_compile/T8848.stderr | 7 +++++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/perf/compiler/T4007.stdout b/testsuite/tests/perf/compiler/T4007.stdout index 83af66c..7242659 100644 --- a/testsuite/tests/perf/compiler/T4007.stdout +++ b/testsuite/tests/perf/compiler/T4007.stdout @@ -1,6 +1,5 @@ Rule fired: unpack -Rule fired: Class op >> -Rule fired: Class op return +Rule fired: SPEC Control.Monad.sequence_ @ GHC.Types.IO _ Rule fired: <=# Rule fired: tagToEnum# Rule fired: fold/build diff --git a/testsuite/tests/simplCore/should_compile/T8848.stderr b/testsuite/tests/simplCore/should_compile/T8848.stderr index c17d599..a96051a 100644 --- a/testsuite/tests/simplCore/should_compile/T8848.stderr +++ b/testsuite/tests/simplCore/should_compile/T8848.stderr @@ -1,5 +1,3 @@ -Rule fired: Class op fmap -Rule fired: Class op fmap Rule fired: Class op pure Rule fired: Class op <*> Rule fired: Class op <*> @@ -8,6 +6,7 @@ Rule fired: Class op $p1Applicative Rule fired: Class op <*> Rule fired: Class op $p1Applicative Rule fired: Class op <*> +Rule fired: Class op fmap Rule fired: Class op $p1Applicative Rule fired: Class op fmap Rule fired: Class op <*> @@ -17,3 +16,7 @@ Rule fired: Class op <*> Rule fired: SPEC $cfmap @ 'T8848.Z Rule fired: SPEC $c<$ @ 'T8848.Z Rule fired: SPEC T8848.$fFunctorShape @ 'T8848.Z +Rule fired: Class op fmap +Rule fired: Class op fmap +Rule fired: SPEC $c<$ @ 'T8848.Z +Rule fired: SPEC T8848.$fFunctorShape @ 'T8848.Z From git at git.haskell.org Thu Aug 28 11:12:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:15 +0000 (UTC) Subject: [commit: ghc] master: Add -fspecialise-aggressively (b9e49d3) Message-ID: <20140828111215.D41D524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b9e49d3e9580e13d89efd1f779cb76f610e0d6e0/ghc >--------------------------------------------------------------- commit b9e49d3e9580e13d89efd1f779cb76f610e0d6e0 Author: Simon Peyton Jones Date: Tue May 13 13:10:26 2014 +0100 Add -fspecialise-aggressively This flag specialises any imported overloaded function that has an unfolding, whether or not it was marked INLINEABLE. We get a lot of orphan SPEC rules as a result, but that doesn't matter provided we don't treat orphan auto-generated rules as causing the module itself to be an orphan module. See Note [Orphans and auto-generated rules] in MkIface. >--------------------------------------------------------------- b9e49d3e9580e13d89efd1f779cb76f610e0d6e0 compiler/iface/MkIface.lhs | 23 ++++++- compiler/main/DynFlags.hs | 2 + compiler/specialise/Specialise.lhs | 135 ++++++++++++++++++++++++++----------- 3 files changed, 119 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 b9e49d3e9580e13d89efd1f779cb76f610e0d6e0 From git at git.haskell.org Thu Aug 28 11:12:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:18 +0000 (UTC) Subject: [commit: ghc] master: Compiler performance increases -- yay! (dce7095) Message-ID: <20140828111222.1C39124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dce70957c321508c7ad1d5b8e91203da4c036e51/ghc >--------------------------------------------------------------- commit dce70957c321508c7ad1d5b8e91203da4c036e51 Author: Simon Peyton Jones Date: Tue May 13 12:43:50 2014 +0100 Compiler performance increases -- yay! >--------------------------------------------------------------- dce70957c321508c7ad1d5b8e91203da4c036e51 testsuite/tests/perf/compiler/all.T | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index ea62520..10eecba 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -195,7 +195,7 @@ test('T4801', # 2013-02-10: 11207828 (x86/OSX) # (some date): 11139444 # 2013-11-13: 11829000 (x86/Windows, 64bit machine) - (wordsize(64), 25002136, 10)]), + (wordsize(64), 21442744, 10)]), # prev: 20486256 (amd64/OS X) # 30/08/2012: 17305600--20391920 (varies a lot) # 19/10/2012: 26882576 (-fPIC turned on) @@ -204,6 +204,7 @@ test('T4801', # 10/01/2014: 25166280 # 13/01/2014: 22646000 (mostly due to #8647) # 18/02/2014: 25002136 (call arity analysis changes) + # 12/05/2014: 25002136 (specialisation and inlining changes) only_ways(['normal']), extra_hc_opts('-static') ], @@ -352,14 +353,13 @@ test('T5321Fun', # prev: 300000000 # 2012-10-08: 344416344 x86/Linux # (increase due to new codegen) - (wordsize(64), 694019152, 10)]) + (wordsize(64), 614409344, 10)]) # prev: 585521080 - # 29/08/2012: 713385808 - # (increase due to new codegen) - # 15/05/2013: 628341952 - # (reason for decrease unknown) - # 24/06/2013: 694019152 - # (reason for re-increase unknown) + # 29/08/2012: 713385808 # (increase due to new codegen) + # 15/05/2013: 628341952 # (reason for decrease unknown) + # 24/06/2013: 694019152 # (reason for re-increase unknown) + # 12/05/2014: 614409344 # (specialisation and inlining changes) + ], compile,['']) From git at git.haskell.org Thu Aug 28 11:12:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:22 +0000 (UTC) Subject: [commit: ghc] master: Make tidyProgram discard speculative specialisation rules (6d48ce2) Message-ID: <20140828111222.3B7B42406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6d48ce2925e3cc0e267c58367739d4064094af7f/ghc >--------------------------------------------------------------- commit 6d48ce2925e3cc0e267c58367739d4064094af7f Author: Simon Peyton Jones Date: Fri May 23 08:23:41 2014 +0100 Make tidyProgram discard speculative specialisation rules The new function TidyPgm.trimAutoRules discards bindings and rules that were useful, but now have served their purpose. See Note [Trimming auto rules] in TidyPgm >--------------------------------------------------------------- 6d48ce2925e3cc0e267c58367739d4064094af7f compiler/coreSyn/CoreFVs.lhs | 2 +- compiler/coreSyn/CoreSyn.lhs | 6 +++- compiler/main/TidyPgm.lhs | 75 +++++++++++++++++++++++++++++++++++++++++--- 3 files changed, 77 insertions(+), 6 deletions(-) diff --git a/compiler/coreSyn/CoreFVs.lhs b/compiler/coreSyn/CoreFVs.lhs index 69da1ad..ae162b6 100644 --- a/compiler/coreSyn/CoreFVs.lhs +++ b/compiler/coreSyn/CoreFVs.lhs @@ -23,7 +23,7 @@ module CoreFVs ( varTypeTyVars, idUnfoldingVars, idFreeVars, idRuleAndUnfoldingVars, idRuleVars, idRuleRhsVars, stableUnfoldingVars, - ruleRhsFreeVars, rulesFreeVars, + ruleRhsFreeVars, ruleFreeVars, rulesFreeVars, ruleLhsOrphNames, ruleLhsFreeIds, vectsFreeVars, diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index e82303c..6627ab0 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -81,7 +81,7 @@ module CoreSyn ( -- ** Operations on 'CoreRule's seqRules, ruleArity, ruleName, ruleIdName, ruleActivation, setRuleIdName, - isBuiltinRule, isLocalRule, + isBuiltinRule, isLocalRule, isAutoRule, -- * Core vectorisation declarations data type CoreVect(..) @@ -599,6 +599,10 @@ isBuiltinRule :: CoreRule -> Bool isBuiltinRule (BuiltinRule {}) = True isBuiltinRule _ = False +isAutoRule :: CoreRule -> Bool +isAutoRule (BuiltinRule {}) = False +isAutoRule (Rule { ru_auto = is_auto }) = is_auto + -- | The number of arguments the 'ru_fn' must be applied -- to before the rule can match on it ruleArity :: CoreRule -> Int diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index 6f24e3a..68415c8 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -62,7 +62,7 @@ import qualified ErrUtils as Err import Control.Monad import Data.Function -import Data.List ( sortBy ) +import Data.List ( sortBy, partition ) import Data.IORef ( atomicModifyIORef ) \end{code} @@ -335,8 +335,10 @@ tidyProgram hsc_env (ModGuts { mg_module = mod -- Then pick just the ones we need to expose -- See Note [Which rules to expose] + ; let { (trimmed_binds, trimmed_rules) = trimAutoRules binds ext_rules } + ; (tidy_env, tidy_binds) - <- tidyTopBinds hsc_env mod unfold_env tidy_occ_env binds + <- tidyTopBinds hsc_env mod unfold_env tidy_occ_env trimmed_binds ; let { final_ids = [ id | id <- bindersOfBinds tidy_binds, isExternalName (idName id)] @@ -348,7 +350,7 @@ tidyProgram hsc_env (ModGuts { mg_module = mod -- it was born, but we want Global, IdInfo-rich (or not) DFunId in the -- tidy_insts. Similarly the Ids inside a PatSyn. - ; tidy_rules = tidyRules tidy_env ext_rules + ; tidy_rules = tidyRules tidy_env trimmed_rules -- You might worry that the tidy_env contains IdInfo-rich stuff -- and indeed it does, but if omit_prags is on, ext_rules is -- empty @@ -415,14 +417,79 @@ tidyProgram hsc_env (ModGuts { mg_module = mod md_anns = anns -- are already tidy }) } + where + lookup_dfun :: TypeEnv -> Var -> Id + lookup_dfun type_env dfun_id + = case lookupTypeEnv type_env (idName dfun_id) of + Just (AnId dfun_id') -> dfun_id' + _other -> pprPanic "lookup_dfun" (ppr dfun_id) lookup_aux_id :: TypeEnv -> Var -> Id lookup_aux_id type_env id = case lookupTypeEnv type_env (idName id) of Just (AnId id') -> id' _other -> pprPanic "lookup_axu_id" (ppr id) +\end{code} --------------------------- +Note [Trimming auto rules] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +With auto-specialisation we may specialise local or imported dfuns or +INLINE functions, and then later inline them. That may leave behind +something like + RULE "foo" forall d. f @ Int d = f_spec +where there is no remaining reference to f_spec except from the RULE. + +Now that RULE *might* be useful to an importing module, but that is +purely speculative, and meanwhile the code is taking up space and +codegen time. So is seeems better to drop the bidign for f_spec if +the auto-generated rule is the only reason that it is being kept +alive. + +Notice, though, that the RULE still might have been useful; that is, +it was the right thing to have generated it in the first place. See +Note [Inline specialisations] in Specialise. But now it has served +its purpose, and can be discarded. + +So trimAutoRules does this: + * Remove all bindings that are kept alive *only* by isAutoRule rules + * Remove all auto rules that mention bindings that have been removed +So if a binding is kept alive for some other reason (e.g. f_spec is +called in the final code), we keep th e rule too. + +I found that binary sizes jumped by 6-10% when I started to specialise +INLINE functions (again, Note [Inline specialisations] in Specialise). +Adding trimAutoRules removed all this bloat. + + +\begin{code} +trimAutoRules :: [CoreBind] -> [CoreRule] -> ([CoreBind], [CoreRule]) +-- See Note [Trimming auto rules] +trimAutoRules binds rules + | null auto_rules + = (binds, rules) + | otherwise + = (binds', filter keep_rule auto_rules ++ user_rules) + where + (auto_rules, user_rules) = partition isAutoRule rules + rule_fvs = foldr (unionVarSet . ruleRhsFreeVars) emptyVarSet user_rules + + (all_fvs, binds') = trim_binds binds + + trim_binds :: [CoreBind] -> (VarSet, [CoreBind]) + trim_binds [] + = (rule_fvs, []) + trim_binds (bind:binds) + | keep_bind = (fvs `unionVarSet` bind_fvs, bind:binds') + | otherwise = (fvs, binds') + where + needed bndr = isExportedId bndr || bndr `elemVarSet` fvs + keep_bind = any needed (bindersOf bind) + (fvs, binds') = trim_binds binds + bind_fvs = bindFreeVars bind + + keep_rule rule = ruleFreeVars rule `subVarSet` all_fvs + +---------------------- tidyTypeEnv :: Bool -- Compiling without -O, so omit prags -> TypeEnv -> TypeEnv From git at git.haskell.org Thu Aug 28 11:12:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:24 +0000 (UTC) Subject: [commit: ghc] master: Fix an egregious bug in the NonRec case of bindFreeVars (fa582cc) Message-ID: <20140828111224.B79B824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fa582cc4fbff690c3ce2243c0ca00ca29c029134/ghc >--------------------------------------------------------------- commit fa582cc4fbff690c3ce2243c0ca00ca29c029134 Author: Simon Peyton Jones Date: Fri May 23 08:15:52 2014 +0100 Fix an egregious bug in the NonRec case of bindFreeVars We were missing the free variables of rules etc. It's correct for Rec but wrong for NonRec. I'm not sure how this bug hasn't bitten us before, but it cropped up when I was doing trimAutoRules. >--------------------------------------------------------------- fa582cc4fbff690c3ce2243c0ca00ca29c029134 compiler/coreSyn/CoreFVs.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreFVs.lhs b/compiler/coreSyn/CoreFVs.lhs index 4011191..69da1ad 100644 --- a/compiler/coreSyn/CoreFVs.lhs +++ b/compiler/coreSyn/CoreFVs.lhs @@ -82,7 +82,7 @@ exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet -- | Find all locally defined free Ids in a binding group bindFreeVars :: CoreBind -> VarSet -bindFreeVars (NonRec _ r) = exprFreeVars r +bindFreeVars (NonRec b r) = rhs_fvs (b,r) isLocalVar emptyVarSet bindFreeVars (Rec prs) = addBndrs (map fst prs) (foldr (union . rhs_fvs) noVars prs) isLocalVar emptyVarSet From git at git.haskell.org Thu Aug 28 11:12:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:27 +0000 (UTC) Subject: [commit: ghc] master: Comments only (86a2ebf) Message-ID: <20140828111227.6291424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/86a2ebf8deae9505c7a183acf0847b3e53b43fee/ghc >--------------------------------------------------------------- commit 86a2ebf8deae9505c7a183acf0847b3e53b43fee Author: Simon Peyton Jones Date: Fri May 23 09:16:00 2014 +0100 Comments only >--------------------------------------------------------------- 86a2ebf8deae9505c7a183acf0847b3e53b43fee compiler/simplCore/SetLevels.lhs | 3 +++ compiler/specialise/Specialise.lhs | 35 ++++++++++++++++++++++++++--------- compiler/stranal/WorkWrap.lhs | 6 +++++- 3 files changed, 34 insertions(+), 10 deletions(-) diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs index c69687b..5f63096 100644 --- a/compiler/simplCore/SetLevels.lhs +++ b/compiler/simplCore/SetLevels.lhs @@ -352,6 +352,9 @@ lvlExpr env expr@(_, AnnLam {}) lvlExpr env (_, AnnLet bind body) = do { (bind', new_env) <- lvlBind env bind ; body' <- lvlExpr new_env body + -- No point in going via lvlMFE here. If the binding is alive + -- (mentioned in body), and the whole let-expression doesn't + -- float, then neither will the body ; return (Let bind' body') } lvlExpr env (_, AnnCase scrut@(scrut_fvs,_) case_bndr ty alts) diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs index 5a2b8cd..ee8f693 100644 --- a/compiler/specialise/Specialise.lhs +++ b/compiler/specialise/Specialise.lhs @@ -1496,9 +1496,9 @@ Here is what we do with the InlinePragma of the original function (a) An INLINE pragma is transferred (b) An INLINABLE pragma is *not* transferred -Why (a)? Previously the idea is that the point of INLINE was -precisely to specialise the function at its call site, and that's not -so important for the specialised copies. But *pragma-directed* +Why (a): transfer INLINE pragmas? The point of INLINE was precisely to +specialise the function at its call site, and arguably that's not so +important for the specialised copies. BUT *pragma-directed* specialisation now takes place in the typechecker/desugarer, with manually specified INLINEs. The specialisation here is automatic. It'd be very odd if a function marked INLINE was specialised (because @@ -1509,16 +1509,33 @@ programmer said INLINE! You might wonder why we specialise INLINE functions at all. After all they should be inlined, right? Two reasons: - * Even INLINE functions are sometimes not inlined, when - they aren't applied to interesting arguments. But perhaps the type - arguments alone are enough to specialise (even though the args are too - boring to trigger inlining), and it's certainly better to call the + * Even INLINE functions are sometimes not inlined, when they aren't + applied to interesting arguments. But perhaps the type arguments + alone are enough to specialise (even though the args are too boring + to trigger inlining), and it's certainly better to call the specialised version. * The RHS of an INLINE function might call another overloaded function, and we'd like to generate a specialised version of that function too. - -Why (b)? See Trac #4874 for persuasive examples. Suppose we have + This actually happens a lot. Consider + replicateM_ :: (Monad m) => Int -> m a -> m () + {-# INLINABLE replicateM_ #-} + replicateM_ d x ma = ... + The strictness analyser may transform to + replicateM_ :: (Monad m) => Int -> m a -> m () + {-# INLINE replicateM_ #-} + replicateM_ d x ma = case x of I# x' -> $wreplicateM_ d x' ma + + $wreplicateM_ :: (Monad m) => Int# -> m a -> m () + {-# INLINABLE $wreplicateM_ #-} + $wreplicateM_ = ... + Now an importing module has a specialised call to replicateM_, say + (replicateM_ dMonadIO). We certainly want to specialise $wreplicateM_! + This particular example had a huge effect on the call to replicateM_ + in nofib/shootout/n-body. + +Why (b): discard INLINEABLE pragmas? See Trac #4874 for persuasive examples. +Suppose we have {-# INLINABLE f #-} f :: Ord a => [a] -> Int f xs = letrec f' = ...f'... in f' diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs index f845151..f7717ed 100644 --- a/compiler/stranal/WorkWrap.lhs +++ b/compiler/stranal/WorkWrap.lhs @@ -232,7 +232,7 @@ strictness. Eg if we have g :: Int -> Int g x = f x x -- Provokes a specialisation for f - module Bsr where + module Bar where import Foo h :: Int -> Int @@ -246,6 +246,10 @@ more robust to give the wrapper an Activation of (ActiveAfter 0), so that it becomes active in an importing module at the same time that it appears in the first place in the defining module. +At one stage I tried making the wrapper inlining always-active, and +that had a very bad effect on nofib/imaginary/x2n1; a wrapper was +inlined before the specialisation fired. + \begin{code} tryWW :: DynFlags -> FamInstEnvs From git at git.haskell.org Thu Aug 28 11:12:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:29 +0000 (UTC) Subject: [commit: ghc] master: Run float-inwards immediately before the strictness analyser. (1122857) Message-ID: <20140828111229.E9CF224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1122857e6967795a4595a837f3b080cf5f0e18c2/ghc >--------------------------------------------------------------- commit 1122857e6967795a4595a837f3b080cf5f0e18c2 Author: Simon Peyton Jones Date: Fri May 23 13:42:05 2014 +0100 Run float-inwards immediately before the strictness analyser. Doing so pushes bindings nearer their use site and hence makes them more likely to be strict. These bindings might only show up after the inlining from simplification. Example in fulsom, Csg.calc, where an arg of timesDouble thereby becomes strict. Very few programs are affected, but it's basically good news. Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- fft -0.2% +1.3% 0.06 0.06 -10.0% fulsom -0.0% -2.6% -4.3% -4.7% -6.7% simple +0.0% -0.8% 0.0% 0.0% 0.0% -------------------------------------------------------------------------------- Min -0.5% -2.6% -4.5% -4.7% -10.0% Max +0.1% +1.3% +3.3% +3.4% +2.6% Geometric Mean -0.0% -0.0% -0.6% -0.6% -0.2% The lossage in fft is the loss of detecting a common sub-expression, and can be fixed by doing earlier CSE. But that is in any case a bit of a fluke so I don't mind losing it in exchange for this more reliable gain. >--------------------------------------------------------------- 1122857e6967795a4595a837f3b080cf5f0e18c2 compiler/simplCore/SimplCore.lhs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 1a7fd67..2a70dcf 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -246,8 +246,6 @@ getCoreToDo dflags -- but maybe we save some unnecessary to-and-fro in -- the simplifier. - runWhen do_float_in CoreDoFloatInwards, - simpl_phases, -- Phase 0: allow all Ids to be inlined now @@ -262,6 +260,13 @@ getCoreToDo dflags -- Don't stop now! simpl_phase 0 ["main"] (max max_iter 3), + runWhen do_float_in CoreDoFloatInwards, + -- Run float-inwards immediately before the strictness analyser + -- Doing so pushes bindings nearer their use site and hence makes + -- them more likely to be strict. These bindings might only show + -- up after the inlining from simplification. Example in fulsom, + -- Csg.calc, where an arg of timesDouble thereby becomes strict. + runWhen call_arity $ CoreDoPasses [ CoreDoCallArity , simpl_phase 0 ["post-call-arity"] max_iter From git at git.haskell.org Thu Aug 28 11:12:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:34 +0000 (UTC) Subject: [commit: ghc] master: Testsuite wibbles (082e41b) Message-ID: <20140828111237.26DA624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/082e41b4c469371cae2eda3fb9b5e0e0f54e73e3/ghc >--------------------------------------------------------------- commit 082e41b4c469371cae2eda3fb9b5e0e0f54e73e3 Author: Simon Peyton Jones Date: Fri May 23 13:42:37 2014 +0100 Testsuite wibbles >--------------------------------------------------------------- 082e41b4c469371cae2eda3fb9b5e0e0f54e73e3 .../tests/simplCore/should_compile/EvalTest.stdout | 2 +- .../tests/simplCore/should_compile/T4138.stdout | 2 +- .../tests/simplCore/should_compile/T8848.stderr | 23 ++++++++++++++++++++++ 3 files changed, 25 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/simplCore/should_compile/EvalTest.stdout b/testsuite/tests/simplCore/should_compile/EvalTest.stdout index 30c7ea4..25ed320 100644 --- a/testsuite/tests/simplCore/should_compile/EvalTest.stdout +++ b/testsuite/tests/simplCore/should_compile/EvalTest.stdout @@ -1 +1 @@ -rght [Dmd=] :: EvalTest.AList a +rght [Dmd=] :: EvalTest.AList a1 diff --git a/testsuite/tests/simplCore/should_compile/T4138.stdout b/testsuite/tests/simplCore/should_compile/T4138.stdout index d00491f..0cfbf08 100644 --- a/testsuite/tests/simplCore/should_compile/T4138.stdout +++ b/testsuite/tests/simplCore/should_compile/T4138.stdout @@ -1 +1 @@ -1 +2 diff --git a/testsuite/tests/simplCore/should_compile/T8848.stderr b/testsuite/tests/simplCore/should_compile/T8848.stderr index a96051a..dcc478c 100644 --- a/testsuite/tests/simplCore/should_compile/T8848.stderr +++ b/testsuite/tests/simplCore/should_compile/T8848.stderr @@ -13,6 +13,26 @@ Rule fired: Class op <*> Rule fired: Class op $p1Applicative Rule fired: Class op fmap Rule fired: Class op <*> +Rule fired: Class op $p1Applicative +Rule fired: Class op fmap +Rule fired: Class op <*> +Rule fired: + SPEC/main:T8848 Control.Applicative.liftA2 _ _ _ @ (T8848.Shape + 'T8848.Z) +Rule fired: Class op $p1Applicative +Rule fired: Class op fmap +Rule fired: Class op <*> +Rule fired: + SPEC/main:T8848 Control.Applicative.liftA2 _ _ _ @ (T8848.Shape + 'T8848.Z) +Rule fired: Class op $p1Applicative +Rule fired: Class op fmap +Rule fired: Class op <*> +Rule fired: Class op $p1Applicative +Rule fired: Class op fmap +Rule fired: Class op <*> +Rule fired: Class op fmap +Rule fired: Class op fmap Rule fired: SPEC $cfmap @ 'T8848.Z Rule fired: SPEC $c<$ @ 'T8848.Z Rule fired: SPEC T8848.$fFunctorShape @ 'T8848.Z @@ -20,3 +40,6 @@ Rule fired: Class op fmap Rule fired: Class op fmap Rule fired: SPEC $c<$ @ 'T8848.Z Rule fired: SPEC T8848.$fFunctorShape @ 'T8848.Z +Rule fired: SPEC T8848.$fFunctorShape @ 'T8848.Z +Rule fired: Class op fmap +Rule fired: Class op fmap From git at git.haskell.org Thu Aug 28 11:12:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:32 +0000 (UTC) Subject: [commit: ghc] master: Performance changes (bb87726) Message-ID: <20140828111235.F07022406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bb8772662d48b27966422d00356b468bacff377f/ghc >--------------------------------------------------------------- commit bb8772662d48b27966422d00356b468bacff377f Author: Simon Peyton Jones Date: Fri May 23 13:49:04 2014 +0100 Performance changes * T1969 improves, perhaps because of better specialiation * T5642 (a bizarre case) worsens, because we get lots and lots of specialisations of imported functions for the lots and lots of data types T5642 declares >--------------------------------------------------------------- bb8772662d48b27966422d00356b468bacff377f testsuite/tests/perf/compiler/all.T | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 10eecba..15fdb79 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -74,6 +74,7 @@ test('T1969', # 2014-01-22 316103268 (x86/Linux) # 2014-06-29 303300692 (x86/Linux) (wordsize(64), 651626680, 5)]), + (wordsize(64), 625525224, 5)]), # 17/11/2009 434845560 (amd64/Linux) # 08/12/2009 459776680 (amd64/Linux) # 17/05/2010 519377728 (amd64/Linux) @@ -396,6 +397,11 @@ test('T5642', # prev: 1300000000 # 2014-07-17: 1358833928 (general round of updates) # 2014-08-07: 1402242360 (caused by 1fc60ea) +# Watch out for: + # 23/05/2014: 1452688392 (More aggressive specialisation means we get + # specialised copies of imported functions that + # are ultimately discarded by trimAutoRules + # It's a bizarre program with LOTS of data types) ], compile,['-O']) From git at git.haskell.org Thu Aug 28 11:12:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:37 +0000 (UTC) Subject: [commit: ghc] master: Remove dead lookup_dfun_id (merge-o) (6c6b001) Message-ID: <20140828111237.524DF24124@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6c6b001eb2356fa49968412f90ddc22e086f8135/ghc >--------------------------------------------------------------- commit 6c6b001eb2356fa49968412f90ddc22e086f8135 Author: Simon Peyton Jones Date: Thu Aug 28 11:13:24 2014 +0100 Remove dead lookup_dfun_id (merge-o) >--------------------------------------------------------------- 6c6b001eb2356fa49968412f90ddc22e086f8135 compiler/main/TidyPgm.lhs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index 68415c8..ba5ccb7 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -417,12 +417,6 @@ tidyProgram hsc_env (ModGuts { mg_module = mod md_anns = anns -- are already tidy }) } - where - lookup_dfun :: TypeEnv -> Var -> Id - lookup_dfun type_env dfun_id - = case lookupTypeEnv type_env (idName dfun_id) of - Just (AnId dfun_id') -> dfun_id' - _other -> pprPanic "lookup_dfun" (ppr dfun_id) lookup_aux_id :: TypeEnv -> Var -> Id lookup_aux_id type_env id From git at git.haskell.org Thu Aug 28 11:12:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:39 +0000 (UTC) Subject: [commit: ghc] master: Simple refactor of the case-of-case transform (a0b2897) Message-ID: <20140828111239.B269624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a0b2897ee406e24a05c41768a0fc2395442dfa06/ghc >--------------------------------------------------------------- commit a0b2897ee406e24a05c41768a0fc2395442dfa06 Author: Simon Peyton Jones Date: Tue May 27 09:09:28 2014 +0100 Simple refactor of the case-of-case transform More modular, less code. No change in behaviour. >--------------------------------------------------------------- a0b2897ee406e24a05c41768a0fc2395442dfa06 compiler/simplCore/Simplify.lhs | 28 +++++++++++----------------- 1 file changed, 11 insertions(+), 17 deletions(-) diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index d722f51..49c86a1 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -956,19 +956,8 @@ simplExprF1 env expr@(Lam {}) cont zap b | isTyVar b = b | otherwise = zapLamIdInfo b -simplExprF1 env (Case scrut bndr alts_ty alts) cont - | sm_case_case (getMode env) - = -- Simplify the scrutinee with a Select continuation - simplExprF env scrut (Select NoDup bndr alts env cont) - - | otherwise - = -- If case-of-case is off, simply simplify the case expression - -- in a vanilla Stop context, and rebuild the result around it - do { case_expr' <- simplExprC env scrut - (Select NoDup bndr alts env (mkBoringStop alts_out_ty)) - ; rebuild env case_expr' cont } - where - alts_out_ty = substTy env alts_ty +simplExprF1 env (Case scrut bndr _ alts) cont + = simplExprF env scrut (Select NoDup bndr alts env cont) simplExprF1 env (Let (Rec pairs) body) cont = do { env' <- simplRecBndrs env (map fst pairs) @@ -2326,7 +2315,9 @@ missingAlt env case_bndr _ cont \begin{code} prepareCaseCont :: SimplEnv -> [InAlt] -> SimplCont - -> SimplM (SimplEnv, SimplCont, SimplCont) + -> SimplM (SimplEnv, + SimplCont, -- Non-dupable part + SimplCont) -- Dupable part -- We are considering -- K[case _ of { p1 -> r1; ...; pn -> rn }] -- where K is some enclosing continuation for the case @@ -2336,12 +2327,15 @@ prepareCaseCont :: SimplEnv -- The idea is that we'll transform thus: -- Knodup[ (case _ of { p1 -> Kdup[r1]; ...; pn -> Kdup[rn] } -- --- We also return some extra bindings in SimplEnv (that scope over +-- We may also return some extra bindings in SimplEnv (that scope over -- the entire continuation) +-- +-- When case-of-case is off, just make the entire continuation non-dupable prepareCaseCont env alts cont - | many_alts alts = mkDupableCont env cont - | otherwise = return (env, cont, mkBoringStop (contResultType cont)) + | not (sm_case_case (getMode env)) = return (env, mkBoringStop (contInputType cont), cont) + | not (many_alts alts) = return (env, cont, mkBoringStop (contResultType cont)) + | otherwise = mkDupableCont env cont where many_alts :: [InAlt] -> Bool -- True iff strictly > 1 non-bottom alternative many_alts [] = False -- See Note [Bottom alternatives] From git at git.haskell.org Thu Aug 28 11:12:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:42 +0000 (UTC) Subject: [commit: ghc] master: White space only (39ccdf9) Message-ID: <20140828111243.8261624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/39ccdf91f81cdcf619b66b1fe6ed716161964048/ghc >--------------------------------------------------------------- commit 39ccdf91f81cdcf619b66b1fe6ed716161964048 Author: Simon Peyton Jones Date: Thu Aug 28 11:13:37 2014 +0100 White space only >--------------------------------------------------------------- 39ccdf91f81cdcf619b66b1fe6ed716161964048 compiler/stranal/WorkWrap.lhs | 44 +++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs index f7717ed..ef2fb53 100644 --- a/compiler/stranal/WorkWrap.lhs +++ b/compiler/stranal/WorkWrap.lhs @@ -8,7 +8,7 @@ module WorkWrap ( wwTopBinds ) where import CoreSyn -import CoreUnfold ( certainlyWillInline, mkWwInlineRule, mkWorkerUnfolding ) +import CoreUnfold ( certainlyWillInline, mkWwInlineRule, mkWorkerUnfolding ) import CoreUtils ( exprType, exprIsHNF ) import CoreArity ( exprArity ) import Var @@ -283,9 +283,9 @@ tryWW dflags fam_envs is_rec fn_id rhs | not loop_breaker , Just stable_unf <- certainlyWillInline dflags fn_unf = return [ (fn_id `setIdUnfolding` stable_unf, rhs) ] - -- Note [Don't w/w inline small non-loop-breaker, or INLINE, things] - -- NB: use idUnfolding because we don't want to apply - -- this criterion to a loop breaker! + -- Note [Don't w/w inline small non-loop-breaker, or INLINE, things] + -- NB: use idUnfolding because we don't want to apply + -- this criterion to a loop breaker! | is_fun = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds res_info rhs @@ -298,7 +298,7 @@ tryWW dflags fam_envs is_rec fn_id rhs where loop_breaker = isStrongLoopBreaker (occInfo fn_info) - fn_info = idInfo fn_id + fn_info = idInfo fn_id inline_act = inlinePragmaActivation (inlinePragInfo fn_info) fn_unf = unfoldingInfo fn_info @@ -331,28 +331,28 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs Just (work_demands, wrap_fn, work_fn) -> do work_uniq <- getUniqueM let work_rhs = work_fn rhs - work_id = mkWorkerId work_uniq fn_id (exprType work_rhs) - `setIdOccInfo` occInfo fn_info - -- Copy over occurrence info from parent - -- Notably whether it's a loop breaker - -- Doesn't matter much, since we will simplify next, but - -- seems right-er to do so - - `setInlinePragma` inl_prag - -- Any inline activation (which sets when inlining is active) - -- on the original function is duplicated on the worker - -- It *matters* that the pragma stays on the wrapper - -- It seems sensible to have it on the worker too, although we - -- can't think of a compelling reason. (In ptic, INLINE things are - -- not w/wd). However, the RuleMatchInfo is not transferred since + work_id = mkWorkerId work_uniq fn_id (exprType work_rhs) + `setIdOccInfo` occInfo fn_info + -- Copy over occurrence info from parent + -- Notably whether it's a loop breaker + -- Doesn't matter much, since we will simplify next, but + -- seems right-er to do so + + `setInlinePragma` inl_prag + -- Any inline activation (which sets when inlining is active) + -- on the original function is duplicated on the worker + -- It *matters* that the pragma stays on the wrapper + -- It seems sensible to have it on the worker too, although we + -- can't think of a compelling reason. (In ptic, INLINE things are + -- not w/wd). However, the RuleMatchInfo is not transferred since -- it does not make sense for workers to be constructorlike. `setIdUnfolding` mkWorkerUnfolding dflags work_fn (unfoldingInfo fn_info) -- See Note [Worker-wrapper for INLINABLE functions] - `setIdStrictness` mkClosedStrictSig work_demands work_res_info - -- Even though we may not be at top level, - -- it's ok to give it an empty DmdEnv + `setIdStrictness` mkClosedStrictSig work_demands work_res_info + -- Even though we may not be at top level, + -- it's ok to give it an empty DmdEnv `setIdArity` (exprArity work_rhs) -- Set the arity so that the Core Lint check that the From git at git.haskell.org Thu Aug 28 11:12:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 11:12:44 +0000 (UTC) Subject: [commit: ghc] master: Testsuite wibbles (a1a400e) Message-ID: <20140828111244.ACB4A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a1a400ed088cb1303661cf32f34c0cbf57253300/ghc >--------------------------------------------------------------- commit a1a400ed088cb1303661cf32f34c0cbf57253300 Author: Simon Peyton Jones Date: Thu Aug 28 12:10:57 2014 +0100 Testsuite wibbles >--------------------------------------------------------------- a1a400ed088cb1303661cf32f34c0cbf57253300 testsuite/tests/simplCore/should_compile/T8848.stderr | 8 ++++---- testsuite/tests/typecheck/should_fail/T5095.stderr | 1 - 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/simplCore/should_compile/T8848.stderr b/testsuite/tests/simplCore/should_compile/T8848.stderr index dcc478c..ba72af4 100644 --- a/testsuite/tests/simplCore/should_compile/T8848.stderr +++ b/testsuite/tests/simplCore/should_compile/T8848.stderr @@ -17,14 +17,14 @@ Rule fired: Class op $p1Applicative Rule fired: Class op fmap Rule fired: Class op <*> Rule fired: - SPEC/main:T8848 Control.Applicative.liftA2 _ _ _ @ (T8848.Shape - 'T8848.Z) + SPEC/main at main:T8848 Control.Applicative.liftA2 _ _ _ @ (T8848.Shape + 'T8848.Z) Rule fired: Class op $p1Applicative Rule fired: Class op fmap Rule fired: Class op <*> Rule fired: - SPEC/main:T8848 Control.Applicative.liftA2 _ _ _ @ (T8848.Shape - 'T8848.Z) + SPEC/main at main:T8848 Control.Applicative.liftA2 _ _ _ @ (T8848.Shape + 'T8848.Z) Rule fired: Class op $p1Applicative Rule fired: Class op fmap Rule fired: Class op <*> diff --git a/testsuite/tests/typecheck/should_fail/T5095.stderr b/testsuite/tests/typecheck/should_fail/T5095.stderr index f7c29d4..e8d2b71 100644 --- a/testsuite/tests/typecheck/should_fail/T5095.stderr +++ b/testsuite/tests/typecheck/should_fail/T5095.stderr @@ -3,7 +3,6 @@ T5095.hs:9:11: Overlapping instances for Eq a arising from a use of ?==? Matching instances: instance [overlappable] Show a => Eq a -- Defined at T5095.hs:5:31 - instance Eq a => Eq (GHC.Real.Ratio a) -- Defined in ?GHC.Real? instance Eq () -- Defined in ?GHC.Classes? instance (Eq a, Eq b) => Eq (a, b) -- Defined in ?GHC.Classes? instance (Eq a, Eq b, Eq c) => Eq (a, b, c) From git at git.haskell.org Thu Aug 28 12:49:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 12:49:32 +0000 (UTC) Subject: [commit: ghc] master: testsuite: disable T367_letnoescape on 'optllvm' (1145568) Message-ID: <20140828124932.1CCC524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/11455684212b2bbf76d5eb20fdd2d01fbdf21311/ghc >--------------------------------------------------------------- commit 11455684212b2bbf76d5eb20fdd2d01fbdf21311 Author: Sergei Trofimovich Date: Thu Aug 28 15:45:23 2014 +0300 testsuite: disable T367_letnoescape on 'optllvm' Known Issue #7297 Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 11455684212b2bbf76d5eb20fdd2d01fbdf21311 testsuite/tests/concurrent/should_run/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index b43026a..166c232 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -23,7 +23,7 @@ test('conc073', normal, compile_and_run, ['']) # vector code must get inlined to become non-allocating test('T367', [reqlib('vector'), omit_ways(['ghci']), timeout_multiplier(0.001)], compile_and_run, ['-O2 -fno-omit-yields']) -test('T367_letnoescape', [timeout_multiplier(0.02)], compile_and_run, ['-fno-omit-yields']) +test('T367_letnoescape', [timeout_multiplier(0.02), expect_broken_for(7297,['optllvm'])], compile_and_run, ['-fno-omit-yields']) test('T1980', normal, compile_and_run, ['']) test('T2910', normal, compile_and_run, ['']) From git at git.haskell.org Thu Aug 28 13:17:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 13:17:35 +0000 (UTC) Subject: [commit: ghc] master: testsuite: disable 'rdynamic' for 'ghci' way (75d998b) Message-ID: <20140828131735.521CD24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/75d998bfad7433ba000236dfd07e386c95f2b769/ghc >--------------------------------------------------------------- commit 75d998bfad7433ba000236dfd07e386c95f2b769 Author: Sergei Trofimovich Date: Thu Aug 28 16:14:22 2014 +0300 testsuite: disable 'rdynamic' for 'ghci' way '-rdynamic' is currently only a link-time option. Does not make sense for ghci without major changes. Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 75d998bfad7433ba000236dfd07e386c95f2b769 testsuite/tests/rts/all.T | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 0eb54ba..d494872 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -233,7 +233,11 @@ test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], c # with the non-threaded one. test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug']) -test('rdynamic', unless(opsys('linux') or opsys('mingw32'), skip), +test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) + # this needs runtime infrastructure to do in ghci: + # '-rdynamic' ghc, load modules only via dlopen(RTLD_BLOBAL) and more. + , omit_ways(['ghci']) + ], compile_and_run, ['-rdynamic -package ghc']) # 251 = RTS exit code for "out of memory" From git at git.haskell.org Thu Aug 28 16:51:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 16:51:40 +0000 (UTC) Subject: [commit: ghc] master: Add an interesting type-family/GADT example of deletion for red-black trees (94926b1) Message-ID: <20140828165143.3011024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/94926b113f0f2669792cc2d85f29c348cfa291c9/ghc >--------------------------------------------------------------- commit 94926b113f0f2669792cc2d85f29c348cfa291c9 Author: Simon Peyton Jones Date: Thu Aug 28 10:34:17 2014 +0100 Add an interesting type-family/GADT example of deletion for red-black trees Due to Stephanie Weirich, Dan Licata, John Hughes, Matt Might >--------------------------------------------------------------- 94926b113f0f2669792cc2d85f29c348cfa291c9 testsuite/tests/indexed-types/should_compile/all.T | 1 + .../indexed-types/should_compile/red-black.hs | 327 +++++++++++++++++++++ 2 files changed, 328 insertions(+) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 94926b113f0f2669792cc2d85f29c348cfa291c9 From git at git.haskell.org Thu Aug 28 16:51:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 16:51:43 +0000 (UTC) Subject: [commit: ghc] master: Comments only (87c1568) Message-ID: <20140828165143.5D2FD24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/87c1568647f22c377ca5d42e2d132faafddd5a73/ghc >--------------------------------------------------------------- commit 87c1568647f22c377ca5d42e2d132faafddd5a73 Author: Simon Peyton Jones Date: Thu Aug 28 16:59:06 2014 +0100 Comments only >--------------------------------------------------------------- 87c1568647f22c377ca5d42e2d132faafddd5a73 libraries/base/GHC/IO.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/libraries/base/GHC/IO.hs b/libraries/base/GHC/IO.hs index 5309665..388c81f 100644 --- a/libraries/base/GHC/IO.hs +++ b/libraries/base/GHC/IO.hs @@ -178,29 +178,37 @@ like 'bracket' cannot be used safely within 'unsafeDupablePerformIO'. /Since: 4.4.0.0/ -} {-# NOINLINE unsafeDupablePerformIO #-} + -- See Note [unsafeDupablePerformIO is NOINLINE] unsafeDupablePerformIO :: IO a -> a unsafeDupablePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r) + -- See Note [unsafeDupablePerformIO has a lazy RHS] +-- Note [unsafeDupablePerformIO is NOINLINE] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Why do we NOINLINE unsafeDupablePerformIO? See the comment with -- GHC.ST.runST. Essentially the issue is that the IO computation -- inside unsafePerformIO must be atomic: it must either all run, or -- not at all. If we let the compiler see the application of the IO -- to realWorld#, it might float out part of the IO. +-- Note [unsafeDupablePerformIO has a lazy RHS] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Why is there a call to 'lazy' in unsafeDupablePerformIO? -- If we don't have it, the demand analyser discovers the following strictness -- for unsafeDupablePerformIO: C(U(AV)) -- But then consider -- unsafeDupablePerformIO (\s -> let r = f x in -- case writeIORef v r s of (# s1, _ #) -> --- (# s1, r #) +-- (# s1, r #) ) -- The strictness analyser will find that the binding for r is strict, -- (because of uPIO's strictness sig), and so it'll evaluate it before --- doing the writeIORef. This actually makes tests/lib/should_run/memo002 --- get a deadlock! +-- doing the writeIORef. This actually makes libraries/base/tests/memo002 +-- get a deadlock, where we specifically wanted to write a lazy thunk +-- into the ref cell. -- -- Solution: don't expose the strictness of unsafeDupablePerformIO, -- by hiding it with 'lazy' +-- But see discussion in Trac #9390 (comment:33) {-| 'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily. From git at git.haskell.org Thu Aug 28 16:51:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 16:51:45 +0000 (UTC) Subject: [commit: ghc] master: Temporary fix to the crash (b7bdf13) Message-ID: <20140828165145.F0CCF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b7bdf13d9cf1c31f7f7eab063150aa7362d67941/ghc >--------------------------------------------------------------- commit b7bdf13d9cf1c31f7f7eab063150aa7362d67941 Author: Simon Peyton Jones Date: Thu Aug 28 17:50:49 2014 +0100 Temporary fix to the crash ghc-stage2: panic! (the 'impossible' happened) (GHC version 7.9.20140828 for x86_64-unknown-linux): nameModule $w$smiddle_sfx6 make[1]: *** [utils/haddock/dist/build/Haddock/Backends/Xhtml.dyn_o] Error 1 >--------------------------------------------------------------- b7bdf13d9cf1c31f7f7eab063150aa7362d67941 compiler/main/TidyPgm.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index ba5ccb7..faec956 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -448,7 +448,7 @@ So trimAutoRules does this: * Remove all bindings that are kept alive *only* by isAutoRule rules * Remove all auto rules that mention bindings that have been removed So if a binding is kept alive for some other reason (e.g. f_spec is -called in the final code), we keep th e rule too. +called in the final code), we keep the rule too. I found that binary sizes jumped by 6-10% when I started to specialise INLINE functions (again, Note [Inline specialisations] in Specialise). @@ -459,7 +459,7 @@ Adding trimAutoRules removed all this bloat. trimAutoRules :: [CoreBind] -> [CoreRule] -> ([CoreBind], [CoreRule]) -- See Note [Trimming auto rules] trimAutoRules binds rules - | null auto_rules + | True {- null auto_rules -} -- Temporrary fix = (binds, rules) | otherwise = (binds', filter keep_rule auto_rules ++ user_rules) From git at git.haskell.org Thu Aug 28 20:47:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 20:47:48 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] ghc-prim: Update .gitignore (aa49892) Message-ID: <20140828204748.D433824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aa49892e954390f4cf6fcec930caadbdc7200bac/ghc >--------------------------------------------------------------- commit aa49892e954390f4cf6fcec930caadbdc7200bac Author: Austin Seipp Date: Thu Aug 28 15:47:10 2014 -0500 [ci skip] ghc-prim: Update .gitignore Signed-off-by: Austin Seipp >--------------------------------------------------------------- aa49892e954390f4cf6fcec930caadbdc7200bac libraries/ghc-prim/.gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/ghc-prim/.gitignore b/libraries/ghc-prim/.gitignore index 896a42e..9ae69e6 100644 --- a/libraries/ghc-prim/.gitignore +++ b/libraries/ghc-prim/.gitignore @@ -1,3 +1,4 @@ +/dist/ /dist-install/ /ghc.mk /GNUmakefile \ No newline at end of file From git at git.haskell.org Thu Aug 28 20:47:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 20:47:51 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] Update .gitignore (8270ff3) Message-ID: <20140828204752.885D624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8270ff3f517564a8763c8ba6cb1c8a383edf3836/ghc >--------------------------------------------------------------- commit 8270ff3f517564a8763c8ba6cb1c8a383edf3836 Author: Austin Seipp Date: Thu Aug 28 15:47:23 2014 -0500 [ci skip] Update .gitignore Signed-off-by: Austin Seipp >--------------------------------------------------------------- 8270ff3f517564a8763c8ba6cb1c8a383edf3836 .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 99bf3a6..d578d5c 100644 --- a/.gitignore +++ b/.gitignore @@ -77,6 +77,7 @@ _darcs/ /bindisttest/ /ch01.html /ch02.html +/compiler/dist/ /compiler/ghc.cabal /compiler/ghc.cabal.old /distrib/configure.ac From git at git.haskell.org Thu Aug 28 21:10:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Aug 2014 21:10:20 +0000 (UTC) Subject: [commit: ghc] master: PprC: cleanup: don't emit 'FB_' / 'FE_' in via-C (9072f2f) Message-ID: <20140828211020.AA35C24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9072f2f86d2b3405a45c59960779aeeab281e634/ghc >--------------------------------------------------------------- commit 9072f2f86d2b3405a45c59960779aeeab281e634 Author: Sergei Trofimovich Date: Fri Aug 29 00:00:19 2014 +0300 PprC: cleanup: don't emit 'FB_' / 'FE_' in via-C No need to emit (now empty) those special markers. Markers were needed only in registerised -fvia-C mode. Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 9072f2f86d2b3405a45c59960779aeeab281e634 compiler/cmm/PprC.hs | 7 ------- includes/Stg.h | 2 -- 2 files changed, 9 deletions(-) diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index 68b6bf7..58042f7 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -99,9 +99,7 @@ pprTop (CmmProc infos clbl _ graph) = (if (externallyVisibleCLabel clbl) then mkFN_ else mkIF_) (ppr clbl) <+> lbrace, nest 8 temp_decls, - nest 8 mkFB_, vcat (map pprBBlock blocks), - nest 8 mkFE_, rbrace ] ) where @@ -785,11 +783,6 @@ mkJMP_ i = ptext (sLit "JMP_") <> parens i mkFN_ i = ptext (sLit "FN_") <> parens i -- externally visible function mkIF_ i = ptext (sLit "IF_") <> parens i -- locally visible - -mkFB_, mkFE_ :: SDoc -mkFB_ = ptext (sLit "FB_") -- function code begin -mkFE_ = ptext (sLit "FE_") -- function code end - -- from includes/Stg.h -- mkC_,mkW_,mkP_ :: SDoc diff --git a/includes/Stg.h b/includes/Stg.h index 1f3e18a..8b3a3fc 100644 --- a/includes/Stg.h +++ b/includes/Stg.h @@ -248,8 +248,6 @@ ABI). -------------------------------------------------------------------------- */ #define JMP_(cont) return((StgFunPtr)(cont)) -#define FB_ -#define FE_ /* ----------------------------------------------------------------------------- Other Stg stuff... From git at git.haskell.org Fri Aug 29 10:03:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 10:03:31 +0000 (UTC) Subject: [commit: ghc] master: Improve trimming of auto-rules (49370ce) Message-ID: <20140829100331.A27AC24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/49370cedccc9d51395a6cc3e182b55ce5a50b560/ghc >--------------------------------------------------------------- commit 49370cedccc9d51395a6cc3e182b55ce5a50b560 Author: Simon Peyton Jones Date: Fri Aug 29 08:06:36 2014 +0100 Improve trimming of auto-rules I hadn't got the new function trimAutoRules quite right, so we had a left-over rule which mentioned a local variable whose binding had been discarded. (Result: crash when compiling Haddock.) This patch merges trimAutoRules into an expanded version of findExternalRules, gets it right, and adds lots of comments. See Note [Finding external rules]. And indeed in one regression test we get to trim off more rules (and hence code) than before. >--------------------------------------------------------------- 49370cedccc9d51395a6cc3e182b55ce5a50b560 compiler/main/TidyPgm.lhs | 256 +++++++++++++--------- testsuite/tests/simplCore/should_run/T2486.stderr | 16 -- 2 files changed, 151 insertions(+), 121 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 49370cedccc9d51395a6cc3e182b55ce5a50b560 From git at git.haskell.org Fri Aug 29 10:03:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 10:03:33 +0000 (UTC) Subject: [commit: ghc] master: Fix syntax in perf/compiler/all.T (4a87142) Message-ID: <20140829100334.105F624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4a87142ff9fa04d34cd417a28666b7b9b339f7b0/ghc >--------------------------------------------------------------- commit 4a87142ff9fa04d34cd417a28666b7b9b339f7b0 Author: Simon Peyton Jones Date: Fri Aug 29 10:11:06 2014 +0100 Fix syntax in perf/compiler/all.T >--------------------------------------------------------------- 4a87142ff9fa04d34cd417a28666b7b9b339f7b0 testsuite/tests/perf/compiler/all.T | 1 - 1 file changed, 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 15fdb79..012fb5b 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -73,7 +73,6 @@ test('T1969', # 2013-02-10 322937684 (x86/OSX) # 2014-01-22 316103268 (x86/Linux) # 2014-06-29 303300692 (x86/Linux) - (wordsize(64), 651626680, 5)]), (wordsize(64), 625525224, 5)]), # 17/11/2009 434845560 (amd64/Linux) # 08/12/2009 459776680 (amd64/Linux) From git at git.haskell.org Fri Aug 29 10:03:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 10:03:36 +0000 (UTC) Subject: [commit: ghc] master: White space only (7eae141) Message-ID: <20140829100336.9DAF724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7eae14171e10298b8951066443d5cf075a1826aa/ghc >--------------------------------------------------------------- commit 7eae14171e10298b8951066443d5cf075a1826aa Author: Simon Peyton Jones Date: Fri Aug 29 10:11:19 2014 +0100 White space only >--------------------------------------------------------------- 7eae14171e10298b8951066443d5cf075a1826aa testsuite/tests/perf/compiler/all.T | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 012fb5b..75ca79b 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -90,6 +90,7 @@ test('T1969', # 18/10/2013 698612512 (x86_64/Linux) fix for #8456 # 10/02/2014 660922376 (x86_64/Linux) call artiy analysis # 17/07/2014 651626680 (x86_64/Linux) roundabout update + only_ways(['normal']), extra_hc_opts('-dcore-lint -static') From git at git.haskell.org Fri Aug 29 10:03:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 10:03:39 +0000 (UTC) Subject: [commit: ghc] master: Better compiler performance (30% less allocation) for T783! (2da63c6) Message-ID: <20140829100339.ADFBF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2da63c60d0edfc8b3ae9c31f2179fee0dc026edd/ghc >--------------------------------------------------------------- commit 2da63c60d0edfc8b3ae9c31f2179fee0dc026edd Author: Simon Peyton Jones Date: Fri Aug 29 10:12:04 2014 +0100 Better compiler performance (30% less allocation) for T783! >--------------------------------------------------------------- 2da63c60d0edfc8b3ae9c31f2179fee0dc026edd testsuite/tests/perf/compiler/all.T | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 75ca79b..1cf4287 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -330,7 +330,7 @@ test('T783', # 2013-02-10: 329202116 (x86/Windows) # 2013-02-10: 338465200 (x86/OSX) # 2014-04-04: 319179104 (x86 Windows, 64 bit machine) - (wordsize(64), 640031840, 10)]), + (wordsize(64), 441932632, 10)]), # prev: 349263216 (amd64/Linux) # 07/08/2012: 384479856 (amd64/Linux) # 29/08/2012: 436927840 (amd64/Linux) @@ -343,6 +343,8 @@ test('T783', # (fix previous fix for #8456) # 2014-07-17: 640031840 (amd64/Linux) # (general round of updates) + # 2014-08-29: 441932632 (amd64/Linux) + # (better specialisation, raft of core-to-core optimisations) extra_hc_opts('-static') ], compile,['']) From git at git.haskell.org Fri Aug 29 10:03:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 10:03:42 +0000 (UTC) Subject: [commit: ghc] master: Rename red-black test in indexed-types to red-black-delete (8df3159) Message-ID: <20140829100343.ABED824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8df3159a5a73bb5d5bad754bb5d06082b690a94f/ghc >--------------------------------------------------------------- commit 8df3159a5a73bb5d5bad754bb5d06082b690a94f Author: Simon Peyton Jones Date: Fri Aug 29 10:16:35 2014 +0100 Rename red-black test in indexed-types to red-black-delete >--------------------------------------------------------------- 8df3159a5a73bb5d5bad754bb5d06082b690a94f testsuite/tests/indexed-types/should_compile/all.T | 2 +- .../indexed-types/should_compile/{red-black.hs => red-black-delete.hs} | 0 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 95a5557..be0099c 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -245,4 +245,4 @@ test('T8978', normal, compile, ['']) test('T8979', normal, compile, ['']) test('T9085', normal, compile, ['']) test('T9316', normal, compile, ['']) -test('red-black', normal, compile, ['']) +test('red-black-delete', normal, compile, ['']) diff --git a/testsuite/tests/indexed-types/should_compile/red-black.hs b/testsuite/tests/indexed-types/should_compile/red-black-delete.hs similarity index 100% rename from testsuite/tests/indexed-types/should_compile/red-black.hs rename to testsuite/tests/indexed-types/should_compile/red-black-delete.hs From git at git.haskell.org Fri Aug 29 10:03:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 10:03:44 +0000 (UTC) Subject: [commit: ghc] master: Define mapUnionVarSet, and use it (dfc9d30) Message-ID: <20140829100344.CC5D224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dfc9d309a5202d65032c80f5b74df17035a61b8c/ghc >--------------------------------------------------------------- commit dfc9d309a5202d65032c80f5b74df17035a61b8c Author: Simon Peyton Jones Date: Fri Aug 29 10:14:45 2014 +0100 Define mapUnionVarSet, and use it Call sites are much easier to understand than before >--------------------------------------------------------------- dfc9d309a5202d65032c80f5b74df17035a61b8c compiler/basicTypes/VarSet.lhs | 8 +++++++- compiler/coreSyn/CoreFVs.lhs | 10 +++++----- compiler/main/InteractiveEval.hs | 4 ++-- compiler/main/TidyPgm.lhs | 15 ++++++--------- compiler/simplCore/CoreMonad.lhs | 2 +- compiler/simplCore/FloatIn.lhs | 4 ++-- compiler/simplCore/OccurAnal.lhs | 10 +++++----- compiler/typecheck/TcEvidence.lhs | 8 ++++---- compiler/typecheck/TcSimplify.lhs | 2 +- compiler/typecheck/TcType.lhs | 4 ++-- compiler/types/Coercion.lhs | 4 ++-- compiler/types/TypeRep.lhs | 2 +- 12 files changed, 38 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 dfc9d309a5202d65032c80f5b74df17035a61b8c From git at git.haskell.org Fri Aug 29 10:03:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 10:03:47 +0000 (UTC) Subject: [commit: ghc] master: In GHC.Real, specialise 'even' and 'odd' to Int and Integer (db5868c) Message-ID: <20140829100347.D278B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/db5868cf0589b36df2948517a47930dd676974a0/ghc >--------------------------------------------------------------- commit db5868cf0589b36df2948517a47930dd676974a0 Author: Simon Peyton Jones Date: Fri Aug 29 10:19:02 2014 +0100 In GHC.Real, specialise 'even' and 'odd' to Int and Integer This was previously happening by a fluke -- they were called with those types in GHC.Real itself -- but my recent changes to specialisation mean that auto specialisations like these are not necessarily exported. Losing those specialisations made a huge difference to two performance tests perf/should_run/MethSharing perf/should_run/T9339 >--------------------------------------------------------------- db5868cf0589b36df2948517a47930dd676974a0 libraries/base/GHC/Real.lhs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/libraries/base/GHC/Real.lhs b/libraries/base/GHC/Real.lhs index a54818f..481125a 100644 --- a/libraries/base/GHC/Real.lhs +++ b/libraries/base/GHC/Real.lhs @@ -517,6 +517,10 @@ showSigned showPos p x even, odd :: (Integral a) => a -> Bool even n = n `rem` 2 == 0 odd = not . even +{-# SPECIALISE even :: Int -> Bool #-} +{-# SPECIALISE odd :: Int -> Bool #-} +{-# SPECIALISE even :: Integer -> Bool #-} +{-# SPECIALISE odd :: Integer -> Bool #-} ------------------------------------------------------- -- | raise a number to a non-negative integral power From git at git.haskell.org Fri Aug 29 10:03:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 10:03:50 +0000 (UTC) Subject: [commit: ghc] master: Testsuite wibbles (b2affa0) Message-ID: <20140829100350.6064D24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b2affa0f213f08acd1c0bb0f2a5e8b2a70272a0b/ghc >--------------------------------------------------------------- commit b2affa0f213f08acd1c0bb0f2a5e8b2a70272a0b Author: Simon Peyton Jones Date: Fri Aug 29 10:20:21 2014 +0100 Testsuite wibbles >--------------------------------------------------------------- b2affa0f213f08acd1c0bb0f2a5e8b2a70272a0b testsuite/tests/perf/compiler/T4007.stdout | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/T4007.stdout b/testsuite/tests/perf/compiler/T4007.stdout index 7242659..83a1f16 100644 --- a/testsuite/tests/perf/compiler/T4007.stdout +++ b/testsuite/tests/perf/compiler/T4007.stdout @@ -1,5 +1,10 @@ Rule fired: unpack -Rule fired: SPEC Control.Monad.sequence_ @ GHC.Types.IO _ +Rule fired: Class op return +Rule fired: Class op >> +Rule fired: Class op >> +Rule fired: Class op return +Rule fired: Class op >> +Rule fired: Class op return Rule fired: <=# Rule fired: tagToEnum# Rule fired: fold/build From git at git.haskell.org Fri Aug 29 10:03:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 10:03:52 +0000 (UTC) Subject: [commit: ghc] master: Improve "specImport discarding" message (9fae691) Message-ID: <20140829100352.B9F7024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9fae691982f02bc1d004ab26cf7829f8d1a53fcb/ghc >--------------------------------------------------------------- commit 9fae691982f02bc1d004ab26cf7829f8d1a53fcb Author: Simon Peyton Jones Date: Fri Aug 29 10:19:37 2014 +0100 Improve "specImport discarding" message >--------------------------------------------------------------- 9fae691982f02bc1d004ab26cf7829f8d1a53fcb compiler/specialise/Specialise.lhs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs index ee8f693..517f022 100644 --- a/compiler/specialise/Specialise.lhs +++ b/compiler/specialise/Specialise.lhs @@ -1614,7 +1614,8 @@ instance Outputable CallInfoSet where pprCallInfo :: Id -> CallInfo -> SDoc pprCallInfo fn (CallKey mb_tys, (dxs, _)) - = hang (ppr fn) 2 (sep (map ppr_call_key_ty mb_tys ++ map pprParendExpr dxs)) + = hang (ppr fn <+> dcolon <+> ppr (idType fn)) + 2 (ptext (sLit "args:") <+> fsep (map ppr_call_key_ty mb_tys ++ map pprParendExpr dxs)) ppr_call_key_ty :: Maybe Type -> SDoc ppr_call_key_ty Nothing = char '_' From git at git.haskell.org Fri Aug 29 12:43:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 12:43:14 +0000 (UTC) Subject: [commit: ghc] wip/remove-cabal-dep: Fix quoting in previous testsuite updates (c12598a) Message-ID: <20140829124314.4A8CD24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/remove-cabal-dep Link : http://ghc.haskell.org/trac/ghc/changeset/c12598ac234a5d2cd674fef02b84b22d859e3799/ghc >--------------------------------------------------------------- commit c12598ac234a5d2cd674fef02b84b22d859e3799 Author: Duncan Coutts Date: Fri Aug 29 13:42:07 2014 +0100 Fix quoting in previous testsuite updates Thanks to ezyang for spotting. >--------------------------------------------------------------- c12598ac234a5d2cd674fef02b84b22d859e3799 testsuite/tests/rename/prog006/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/rename/prog006/Makefile b/testsuite/tests/rename/prog006/Makefile index e5d35e1..41c33c8 100644 --- a/testsuite/tests/rename/prog006/Makefile +++ b/testsuite/tests/rename/prog006/Makefile @@ -37,7 +37,7 @@ rn.prog006: echo "import-dirs: `./pwd`" >>pkg.conf echo "exposed-modules: B.C" >>pkg.conf rm -rf $(LOCAL_PKGCONF) - $(GHC_PKG) init $(LOCAL_PKGCONF) + '$(GHC_PKG)' init $(LOCAL_PKGCONF) $(LOCAL_GHC_PKG) register pkg.conf -v0 '$(TEST_HC)' $(TEST_HC_OPTS) -c -package-db $(LOCAL_PKGCONF) -package test -fforce-recomp A.hs -i # The -i clears the search path, so A.hs will find B.C from package test From git at git.haskell.org Fri Aug 29 13:03:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 13:03:35 +0000 (UTC) Subject: [commit: ghc] branch 'wip/cabal-head-updates' created Message-ID: <20140829130335.B0FD524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/cabal-head-updates Referencing: 687b8b0d09424d5a1918d36f01f55805b1834411 From git at git.haskell.org Fri Aug 29 13:03:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 13:03:38 +0000 (UTC) Subject: [commit: ghc] wip/cabal-head-updates: Update to Cabal head, update ghc-pkg to use new module re-export types (b157361) Message-ID: <20140829130338.EF26024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/cabal-head-updates Link : http://ghc.haskell.org/trac/ghc/changeset/b15736199c671adf8c29c616763c0fb6ae8df011/ghc >--------------------------------------------------------------- commit b15736199c671adf8c29c616763c0fb6ae8df011 Author: Duncan Coutts Date: Fri Aug 29 13:53:52 2014 +0100 Update to Cabal head, update ghc-pkg to use new module re-export types The main change is that Cabal changed the representation of module re-exports to distinguish reexports in source .cabal files versus re-exports in installed package registraion files. Cabal now also does the resolution of re-exports to specific installed packages itself, so ghc-pkg no longer has to do this. This is a cleaner design overall because re-export resolution can fail so it is better to do it during package configuration rather than package registration. It also simplifies the re-export representation that ghc-pkg has to use. >--------------------------------------------------------------- b15736199c671adf8c29c616763c0fb6ae8df011 libraries/Cabal | 2 +- utils/ghc-cabal/Main.hs | 11 +++---- utils/ghc-pkg/Main.hs | 82 +++++++++++++------------------------------------ 3 files changed, 27 insertions(+), 68 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 8d59dc9..468ca1d 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 8d59dc9fba584a9fdb810f4d84f7f3ccb089dd08 +Subproject commit 468ca1db0bbd57568812b26547133de6dae2153e diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs index 47eb1de..df72723 100644 --- a/utils/ghc-cabal/Main.hs +++ b/utils/ghc-cabal/Main.hs @@ -346,13 +346,10 @@ generate directory distdir dll0Modules config_args withLibLBI pd lbi $ \lib clbi -> do cwd <- getCurrentDirectory let ipid = InstalledPackageId (display (packageId pd) ++ "-inplace") - let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir - pd lib lbi clbi - final_ipi = installedPkgInfo { - Installed.installedPackageId = ipid, - Installed.haddockHTMLs = [] - } - content = Installed.showInstalledPackageInfo final_ipi ++ "\n" + let installedPkgInfo = (inplaceInstalledPackageInfo cwd distdir + pd ipid lib lbi clbi) + { Installed.haddockHTMLs = [] } + content = Installed.showInstalledPackageInfo installedPkgInfo ++ "\n" writeFileAtomic (distdir "inplace-pkg-config") (BS.pack $ toUTF8 content) let diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index ac958da..4d4f8e9 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -20,8 +20,7 @@ import Distribution.InstalledPackageInfo as Cabal import Distribution.License import Distribution.Compat.ReadP hiding (get) import Distribution.ParseUtils -import Distribution.ModuleExport -import Distribution.Package hiding (depends) +import Distribution.Package hiding (depends, installedPackageId) import Distribution.Text import Distribution.Version import Distribution.Simple.Utils (fromUTF8, toUTF8) @@ -38,8 +37,6 @@ import System.Console.GetOpt import qualified Control.Exception as Exception import Data.Maybe -import qualified Data.Set as Set - import Data.Char ( isSpace, toLower ) import Data.Ord (comparing) import Control.Applicative (Applicative(..)) @@ -899,9 +896,6 @@ registerPackage input verbosity my_flags auto_ghci_libs multi_instance validatePackageConfig pkg_expanded verbosity truncated_stack auto_ghci_libs multi_instance update force - -- postprocess the package - pkg' <- resolveReexports truncated_stack pkg - let -- In the normal mode, we only allow one version of each package, so we -- remove all instances with the same source package id as the one we're @@ -912,7 +906,7 @@ registerPackage input verbosity my_flags auto_ghci_libs multi_instance p <- packages db_to_operate_on, sourcePackageId p == sourcePackageId pkg ] -- - changeDB verbosity (removes ++ [AddPackage pkg']) db_to_operate_on + changeDB verbosity (removes ++ [AddPackage pkg]) db_to_operate_on parsePackageInfo :: String @@ -935,47 +929,6 @@ mungePackageInfo ipi = ipi { packageKey = packageKey' } = OldPackageKey (sourcePackageId ipi) | otherwise = packageKey ipi --- | Takes the "reexported-modules" field of an InstalledPackageInfo --- and resolves the references so they point to the original exporter --- of a module (i.e. the module is in exposed-modules, not --- reexported-modules). This is done by maintaining an invariant on --- the installed package database that a reexported-module field always --- points to the original exporter. -resolveReexports :: PackageDBStack - -> InstalledPackageInfo - -> IO InstalledPackageInfo -resolveReexports db_stack pkg = do - let dep_mask = Set.fromList (depends pkg) - deps = filter (flip Set.member dep_mask . installedPackageId) - (allPackagesInStack db_stack) - matchExposed pkg_dep m = map ((,) (installedPackageId pkg_dep)) - (filter (==m) (exposedModules pkg_dep)) - worker ModuleExport{ exportOrigPackageName = Just pnm } pkg_dep - | pnm /= packageName (sourcePackageId pkg_dep) = [] - -- Now, either the package matches, *or* we were asked to search the - -- true location ourselves. - worker ModuleExport{ exportOrigName = m } pkg_dep = - matchExposed pkg_dep m ++ - map (fromMaybe (error $ "Impossible! Missing true location in " ++ - display (installedPackageId pkg_dep)) - . exportCachedTrueOrig) - (filter ((==m) . exportName) (reexportedModules pkg_dep)) - self_reexports ModuleExport{ exportOrigPackageName = Just pnm } - | pnm /= packageName (sourcePackageId pkg) = [] - self_reexports ModuleExport{ exportName = m', exportOrigName = m } - -- Self-reexport without renaming doesn't make sense - | m == m' = [] - -- *Only* match against exposed modules! - | otherwise = matchExposed pkg m - - r <- forM (reexportedModules pkg) $ \me -> do - case nub (concatMap (worker me) deps ++ self_reexports me) of - [c] -> return me { exportCachedTrueOrig = Just c } - [] -> die $ "Couldn't resolve reexport " ++ display me - cs -> die $ "Found multiple possible ways to resolve reexport " ++ - display me ++ ": " ++ show cs - return (pkg { reexportedModules = r }) - -- ----------------------------------------------------------------------------- -- Making changes to a package database @@ -1068,16 +1021,25 @@ convertPackageInfoToCacheFormat pkg = GhcPkg.haddockHTMLs = haddockHTMLs pkg, GhcPkg.exposedModules = exposedModules pkg, GhcPkg.hiddenModules = hiddenModules pkg, - GhcPkg.reexportedModules = [ GhcPkg.ModuleExport m ipid' m' - | ModuleExport { - exportName = m, - exportCachedTrueOrig = - Just (InstalledPackageId ipid', m') - } <- reexportedModules pkg - ], + GhcPkg.reexportedModules = map convertModuleReexport + (reexportedModules pkg), GhcPkg.exposed = exposed pkg, GhcPkg.trusted = trusted pkg } + where + convertModuleReexport :: ModuleReexport + -> GhcPkg.ModuleExport String ModuleName + convertModuleReexport + ModuleReexport { + moduleReexportName = m, + moduleReexportDefiningPackage = ipid', + moduleReexportDefiningName = m' + } + = GhcPkg.ModuleExport { + exportModuleName = m, + exportOriginalPackageId = display ipid', + exportOriginalModuleName = m' + } instance GhcPkg.BinaryStringRep ModuleName where fromStringRep = ModuleName.fromString . fromUTF8 . BS.unpack @@ -2128,10 +2090,10 @@ instance Binary ModuleName where put = put . display get = fmap ModuleName.fromString get -instance Binary m => Binary (ModuleExport m) where - put (ModuleExport a b c d) = do put a; put b; put c; put d - get = do a <- get; b <- get; c <- get; d <- get; - return (ModuleExport a b c d) +instance Binary ModuleReexport where + put (ModuleReexport a b c) = do put a; put b; put c + get = do a <- get; b <- get; c <- get + return (ModuleReexport a b c) instance Binary PackageKey where put (PackageKey a b c) = do putWord8 0; put a; put b; put c From git at git.haskell.org Fri Aug 29 13:03:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 13:03:41 +0000 (UTC) Subject: [commit: ghc] wip/cabal-head-updates: Add extra ghc-pkg sanity check for module re-exports and duplicates (687b8b0) Message-ID: <20140829130342.72CD524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/cabal-head-updates Link : http://ghc.haskell.org/trac/ghc/changeset/687b8b0d09424d5a1918d36f01f55805b1834411/ghc >--------------------------------------------------------------- commit 687b8b0d09424d5a1918d36f01f55805b1834411 Author: Duncan Coutts Date: Fri Aug 29 14:00:57 2014 +0100 Add extra ghc-pkg sanity check for module re-exports and duplicates For re-exports, check that the defining package exists and that it exposes the defining module (or for self-rexport exposed or hidden modules). Also check that the defining package is actually a direct or indirect dependency of the package doing the re-exporting. Also add a check for duplicate modules in a package, including re-exported modules. >--------------------------------------------------------------- 687b8b0d09424d5a1918d36f01f55805b1834411 utils/ghc-pkg/Main.hs | 66 +++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 62 insertions(+), 4 deletions(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 4d4f8e9..f2419c7 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -14,6 +14,7 @@ module Main (main) where import Version ( version, targetOS, targetARCH ) import qualified GHC.PackageDb as GhcPkg import qualified Distribution.Simple.PackageIndex as PackageIndex +import qualified Data.Graph as Graph import qualified Distribution.ModuleName as ModuleName import Distribution.ModuleName (ModuleName) import Distribution.InstalledPackageInfo as Cabal @@ -1519,7 +1520,9 @@ checkPackageConfig pkg verbosity db_stack auto_ghci_libs mapM_ (checkDir True "framework-dirs") (frameworkDirs pkg) mapM_ (checkFile True "haddock-interfaces") (haddockInterfaces pkg) mapM_ (checkDirURL True "haddock-html") (haddockHTMLs pkg) - checkModules pkg + checkDuplicateModules pkg + checkModuleFiles pkg + checkModuleReexports db_stack pkg mapM_ (checkHSLib verbosity (libraryDirs pkg) auto_ghci_libs) (hsLibraries pkg) -- ToDo: check these somehow? -- extra_libraries :: [String], @@ -1653,9 +1656,8 @@ doesFileExistOnPath filenames paths = go fullFilenames go ((p, fp) : xs) = do b <- doesFileExist fp if b then return (Just p) else go xs --- XXX maybe should check reexportedModules too -checkModules :: InstalledPackageInfo -> Validate () -checkModules pkg = do +checkModuleFiles :: InstalledPackageInfo -> Validate () +checkModuleFiles pkg = do mapM_ findModule (exposedModules pkg ++ hiddenModules pkg) where findModule modl = @@ -1667,6 +1669,62 @@ checkModules pkg = do when (isNothing m) $ verror ForceFiles ("cannot find any of " ++ show files) +checkDuplicateModules :: InstalledPackageInfo -> Validate () +checkDuplicateModules pkg + | null dups = return () + | otherwise = verror ForceAll ("package has duplicate modules: " ++ + unwords (map display dups)) + where + dups = [ m | (m:_:_) <- group (sort mods) ] + mods = exposedModules pkg ++ hiddenModules pkg + ++ map moduleReexportName (reexportedModules pkg) + +checkModuleReexports :: PackageDBStack -> InstalledPackageInfo -> Validate () +checkModuleReexports db_stack pkg = + mapM_ checkReexport (reexportedModules pkg) + where + all_pkgs = allPackagesInStack db_stack + ipix = PackageIndex.fromList all_pkgs + + checkReexport ModuleReexport { + moduleReexportDefiningPackage = definingPkgId, + moduleReexportDefiningName = definingModule + } = case PackageIndex.lookupInstalledPackageId ipix definingPkgId of + Nothing + -> verror ForceAll ("module re-export refers to a non-existant " ++ + "(or not visible) defining package: " ++ + display definingPkgId) + + Just definingPkg + | not (isIndirectDependency definingPkgId) + -> verror ForceAll ("module re-export refers to a defining " ++ + "package that is not a direct (or indirect) " ++ + "dependency of this package: " ++ + display definingPkgId) + + | definingPkgId == installedPackageId pkg + && definingModule `notElem` (exposedModules definingPkg + ++ hiddenModules definingPkg) + -> verror ForceAll ("module (self) re-export refers to a module " ++ + "that is not defined in this package " ++ + display definingModule) + + | definingPkgId /= installedPackageId pkg + && definingModule `notElem` exposedModules definingPkg + -> verror ForceAll ("module re-export refers to a module that is " ++ + "not exposed by the defining package " ++ + display definingModule) + + | otherwise + -> return () + + isIndirectDependency pkgid = fromMaybe False $ do + thispkg <- graphVertex (installedPackageId pkg) + otherpkg <- graphVertex pkgid + return (Graph.path depgraph thispkg otherpkg) + (depgraph, _, graphVertex) = PackageIndex.dependencyGraph ipix + + checkGHCiLib :: Verbosity -> String -> String -> String -> Bool -> IO () checkGHCiLib verbosity batch_lib_dir batch_lib_file lib auto_build | auto_build = autoBuildGHCiLib verbosity batch_lib_dir batch_lib_file ghci_lib_file From git at git.haskell.org Fri Aug 29 13:26:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 13:26:15 +0000 (UTC) Subject: [commit: ghc] wip/cabal-head-updates: Update to Cabal head, update ghc-pkg to use new module re-export types (74e7770) Message-ID: <20140829132615.A05E524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/cabal-head-updates Link : http://ghc.haskell.org/trac/ghc/changeset/74e777023482ad6ab3ce493ae5467c8b98aefdeb/ghc >--------------------------------------------------------------- commit 74e777023482ad6ab3ce493ae5467c8b98aefdeb Author: Duncan Coutts Date: Fri Aug 29 13:53:52 2014 +0100 Update to Cabal head, update ghc-pkg to use new module re-export types The main change is that Cabal changed the representation of module re-exports to distinguish reexports in source .cabal files versus re-exports in installed package registraion files. Cabal now also does the resolution of re-exports to specific installed packages itself, so ghc-pkg no longer has to do this. This is a cleaner design overall because re-export resolution can fail so it is better to do it during package configuration rather than package registration. It also simplifies the re-export representation that ghc-pkg has to use. >--------------------------------------------------------------- 74e777023482ad6ab3ce493ae5467c8b98aefdeb libraries/Cabal | 2 +- utils/ghc-cabal/Main.hs | 12 +++----- utils/ghc-pkg/Main.hs | 82 +++++++++++++------------------------------------ 3 files changed, 28 insertions(+), 68 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 8d59dc9..2ce3838 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 8d59dc9fba584a9fdb810f4d84f7f3ccb089dd08 +Subproject commit 2ce3838f97f66f03e952333f8c23129f00ebf6cb diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs index 47eb1de..fc97111 100644 --- a/utils/ghc-cabal/Main.hs +++ b/utils/ghc-cabal/Main.hs @@ -346,13 +346,11 @@ generate directory distdir dll0Modules config_args withLibLBI pd lbi $ \lib clbi -> do cwd <- getCurrentDirectory let ipid = InstalledPackageId (display (packageId pd) ++ "-inplace") - let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir - pd lib lbi clbi - final_ipi = installedPkgInfo { - Installed.installedPackageId = ipid, - Installed.haddockHTMLs = [] - } - content = Installed.showInstalledPackageInfo final_ipi ++ "\n" + let installedPkgInfo = (inplaceInstalledPackageInfo cwd distdir + pd ipid lib lbi clbi) + { Installed.haddockHTMLs = [] } + content = Installed.showInstalledPackageInfo installedPkgInfo + ++ "\n" writeFileAtomic (distdir "inplace-pkg-config") (BS.pack $ toUTF8 content) let diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index ac958da..4d4f8e9 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -20,8 +20,7 @@ import Distribution.InstalledPackageInfo as Cabal import Distribution.License import Distribution.Compat.ReadP hiding (get) import Distribution.ParseUtils -import Distribution.ModuleExport -import Distribution.Package hiding (depends) +import Distribution.Package hiding (depends, installedPackageId) import Distribution.Text import Distribution.Version import Distribution.Simple.Utils (fromUTF8, toUTF8) @@ -38,8 +37,6 @@ import System.Console.GetOpt import qualified Control.Exception as Exception import Data.Maybe -import qualified Data.Set as Set - import Data.Char ( isSpace, toLower ) import Data.Ord (comparing) import Control.Applicative (Applicative(..)) @@ -899,9 +896,6 @@ registerPackage input verbosity my_flags auto_ghci_libs multi_instance validatePackageConfig pkg_expanded verbosity truncated_stack auto_ghci_libs multi_instance update force - -- postprocess the package - pkg' <- resolveReexports truncated_stack pkg - let -- In the normal mode, we only allow one version of each package, so we -- remove all instances with the same source package id as the one we're @@ -912,7 +906,7 @@ registerPackage input verbosity my_flags auto_ghci_libs multi_instance p <- packages db_to_operate_on, sourcePackageId p == sourcePackageId pkg ] -- - changeDB verbosity (removes ++ [AddPackage pkg']) db_to_operate_on + changeDB verbosity (removes ++ [AddPackage pkg]) db_to_operate_on parsePackageInfo :: String @@ -935,47 +929,6 @@ mungePackageInfo ipi = ipi { packageKey = packageKey' } = OldPackageKey (sourcePackageId ipi) | otherwise = packageKey ipi --- | Takes the "reexported-modules" field of an InstalledPackageInfo --- and resolves the references so they point to the original exporter --- of a module (i.e. the module is in exposed-modules, not --- reexported-modules). This is done by maintaining an invariant on --- the installed package database that a reexported-module field always --- points to the original exporter. -resolveReexports :: PackageDBStack - -> InstalledPackageInfo - -> IO InstalledPackageInfo -resolveReexports db_stack pkg = do - let dep_mask = Set.fromList (depends pkg) - deps = filter (flip Set.member dep_mask . installedPackageId) - (allPackagesInStack db_stack) - matchExposed pkg_dep m = map ((,) (installedPackageId pkg_dep)) - (filter (==m) (exposedModules pkg_dep)) - worker ModuleExport{ exportOrigPackageName = Just pnm } pkg_dep - | pnm /= packageName (sourcePackageId pkg_dep) = [] - -- Now, either the package matches, *or* we were asked to search the - -- true location ourselves. - worker ModuleExport{ exportOrigName = m } pkg_dep = - matchExposed pkg_dep m ++ - map (fromMaybe (error $ "Impossible! Missing true location in " ++ - display (installedPackageId pkg_dep)) - . exportCachedTrueOrig) - (filter ((==m) . exportName) (reexportedModules pkg_dep)) - self_reexports ModuleExport{ exportOrigPackageName = Just pnm } - | pnm /= packageName (sourcePackageId pkg) = [] - self_reexports ModuleExport{ exportName = m', exportOrigName = m } - -- Self-reexport without renaming doesn't make sense - | m == m' = [] - -- *Only* match against exposed modules! - | otherwise = matchExposed pkg m - - r <- forM (reexportedModules pkg) $ \me -> do - case nub (concatMap (worker me) deps ++ self_reexports me) of - [c] -> return me { exportCachedTrueOrig = Just c } - [] -> die $ "Couldn't resolve reexport " ++ display me - cs -> die $ "Found multiple possible ways to resolve reexport " ++ - display me ++ ": " ++ show cs - return (pkg { reexportedModules = r }) - -- ----------------------------------------------------------------------------- -- Making changes to a package database @@ -1068,16 +1021,25 @@ convertPackageInfoToCacheFormat pkg = GhcPkg.haddockHTMLs = haddockHTMLs pkg, GhcPkg.exposedModules = exposedModules pkg, GhcPkg.hiddenModules = hiddenModules pkg, - GhcPkg.reexportedModules = [ GhcPkg.ModuleExport m ipid' m' - | ModuleExport { - exportName = m, - exportCachedTrueOrig = - Just (InstalledPackageId ipid', m') - } <- reexportedModules pkg - ], + GhcPkg.reexportedModules = map convertModuleReexport + (reexportedModules pkg), GhcPkg.exposed = exposed pkg, GhcPkg.trusted = trusted pkg } + where + convertModuleReexport :: ModuleReexport + -> GhcPkg.ModuleExport String ModuleName + convertModuleReexport + ModuleReexport { + moduleReexportName = m, + moduleReexportDefiningPackage = ipid', + moduleReexportDefiningName = m' + } + = GhcPkg.ModuleExport { + exportModuleName = m, + exportOriginalPackageId = display ipid', + exportOriginalModuleName = m' + } instance GhcPkg.BinaryStringRep ModuleName where fromStringRep = ModuleName.fromString . fromUTF8 . BS.unpack @@ -2128,10 +2090,10 @@ instance Binary ModuleName where put = put . display get = fmap ModuleName.fromString get -instance Binary m => Binary (ModuleExport m) where - put (ModuleExport a b c d) = do put a; put b; put c; put d - get = do a <- get; b <- get; c <- get; d <- get; - return (ModuleExport a b c d) +instance Binary ModuleReexport where + put (ModuleReexport a b c) = do put a; put b; put c + get = do a <- get; b <- get; c <- get + return (ModuleReexport a b c) instance Binary PackageKey where put (PackageKey a b c) = do putWord8 0; put a; put b; put c From git at git.haskell.org Fri Aug 29 13:26:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 13:26:18 +0000 (UTC) Subject: [commit: ghc] wip/cabal-head-updates: Update to Cabal head, update ghc-pkg to use new module re-export types (0df4c4c) Message-ID: <20140829132618.5B28F24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/cabal-head-updates Link : http://ghc.haskell.org/trac/ghc/changeset/0df4c4c08adf76062e33fbf7f5bf48b6f6e967fc/ghc >--------------------------------------------------------------- commit 0df4c4c08adf76062e33fbf7f5bf48b6f6e967fc Author: Duncan Coutts Date: Fri Aug 29 14:00:57 2014 +0100 Update to Cabal head, update ghc-pkg to use new module re-export types Summary: The main change is that Cabal changed the representation of module re-exports to distinguish reexports in source .cabal files versus re-exports in installed package registraion files. Cabal now also does the resolution of re-exports to specific installed packages itself, so ghc-pkg no longer has to do this. This is a cleaner design overall because re-export resolution can fail so it is better to do it during package configuration rather than package registration. It also simplifies the re-export representation that ghc-pkg has to use. Add extra ghc-pkg sanity check for module re-exports and duplicates For re-exports, check that the defining package exists and that it exposes the defining module (or for self-rexport exposed or hidden modules). Also check that the defining package is actually a direct or indirect dependency of the package doing the re-exporting. Also add a check for duplicate modules in a package, including re-exported modules. Test Plan: So far the sanity checks are totally untested. Should add some test case to make sure the sanity checks do catch things correctly, and don't ban legal things. Reviewers: ezyang, austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D183 >--------------------------------------------------------------- 0df4c4c08adf76062e33fbf7f5bf48b6f6e967fc utils/ghc-pkg/Main.hs | 66 +++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 62 insertions(+), 4 deletions(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 4d4f8e9..f063db4 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -14,6 +14,7 @@ module Main (main) where import Version ( version, targetOS, targetARCH ) import qualified GHC.PackageDb as GhcPkg import qualified Distribution.Simple.PackageIndex as PackageIndex +import qualified Data.Graph as Graph import qualified Distribution.ModuleName as ModuleName import Distribution.ModuleName (ModuleName) import Distribution.InstalledPackageInfo as Cabal @@ -1519,7 +1520,9 @@ checkPackageConfig pkg verbosity db_stack auto_ghci_libs mapM_ (checkDir True "framework-dirs") (frameworkDirs pkg) mapM_ (checkFile True "haddock-interfaces") (haddockInterfaces pkg) mapM_ (checkDirURL True "haddock-html") (haddockHTMLs pkg) - checkModules pkg + checkDuplicateModules pkg + checkModuleFiles pkg + checkModuleReexports db_stack pkg mapM_ (checkHSLib verbosity (libraryDirs pkg) auto_ghci_libs) (hsLibraries pkg) -- ToDo: check these somehow? -- extra_libraries :: [String], @@ -1653,9 +1656,8 @@ doesFileExistOnPath filenames paths = go fullFilenames go ((p, fp) : xs) = do b <- doesFileExist fp if b then return (Just p) else go xs --- XXX maybe should check reexportedModules too -checkModules :: InstalledPackageInfo -> Validate () -checkModules pkg = do +checkModuleFiles :: InstalledPackageInfo -> Validate () +checkModuleFiles pkg = do mapM_ findModule (exposedModules pkg ++ hiddenModules pkg) where findModule modl = @@ -1667,6 +1669,62 @@ checkModules pkg = do when (isNothing m) $ verror ForceFiles ("cannot find any of " ++ show files) +checkDuplicateModules :: InstalledPackageInfo -> Validate () +checkDuplicateModules pkg + | null dups = return () + | otherwise = verror ForceAll ("package has duplicate modules: " ++ + unwords (map display dups)) + where + dups = [ m | (m:_:_) <- group (sort mods) ] + mods = exposedModules pkg ++ hiddenModules pkg + ++ map moduleReexportName (reexportedModules pkg) + +checkModuleReexports :: PackageDBStack -> InstalledPackageInfo -> Validate () +checkModuleReexports db_stack pkg = + mapM_ checkReexport (reexportedModules pkg) + where + all_pkgs = allPackagesInStack db_stack + ipix = PackageIndex.fromList all_pkgs + + checkReexport ModuleReexport { + moduleReexportDefiningPackage = definingPkgId, + moduleReexportDefiningName = definingModule + } = case PackageIndex.lookupInstalledPackageId ipix definingPkgId of + Nothing + -> verror ForceAll ("module re-export refers to a non-existant " ++ + "(or not visible) defining package: " ++ + display definingPkgId) + + Just definingPkg + | not (isIndirectDependency definingPkgId) + -> verror ForceAll ("module re-export refers to a defining " ++ + "package that is not a direct (or indirect) " ++ + "dependency of this package: " ++ + display definingPkgId) + + | definingPkgId == installedPackageId pkg + && definingModule `notElem` (exposedModules definingPkg + ++ hiddenModules definingPkg) + -> verror ForceAll ("module (self) re-export refers to a module " ++ + "that is not defined in this package " ++ + display definingModule) + + | definingPkgId /= installedPackageId pkg + && definingModule `notElem` exposedModules definingPkg + -> verror ForceAll ("module re-export refers to a module that is " ++ + "not exposed by the defining package " ++ + display definingModule) + + | otherwise + -> return () + + isIndirectDependency pkgid = fromMaybe False $ do + thispkg <- graphVertex (installedPackageId pkg) + otherpkg <- graphVertex pkgid + return (Graph.path depgraph thispkg otherpkg) + (depgraph, _, graphVertex) = PackageIndex.dependencyGraph ipix + + checkGHCiLib :: Verbosity -> String -> String -> String -> Bool -> IO () checkGHCiLib verbosity batch_lib_dir batch_lib_file lib auto_build | auto_build = autoBuildGHCiLib verbosity batch_lib_dir batch_lib_file ghci_lib_file From git at git.haskell.org Fri Aug 29 13:56:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 13:56:52 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9417' created Message-ID: <20140829135652.B8ABB24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T9417 Referencing: c3342505ff06967536ea80b4df93f20e537d1050 From git at git.haskell.org Fri Aug 29 13:56:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 13:56:55 +0000 (UTC) Subject: [commit: ghc] wip/T9417: Include pattern synonyms as AConLikes in the type environment, even for simplified/boot ModDetails (fixes #9417) (c334250) Message-ID: <20140829135656.2701124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9417 Link : http://ghc.haskell.org/trac/ghc/changeset/c3342505ff06967536ea80b4df93f20e537d1050/ghc >--------------------------------------------------------------- commit c3342505ff06967536ea80b4df93f20e537d1050 Author: Dr. ERDI Gergo Date: Fri Aug 29 21:15:22 2014 +0800 Include pattern synonyms as AConLikes in the type environment, even for simplified/boot ModDetails (fixes #9417) >--------------------------------------------------------------- c3342505ff06967536ea80b4df93f20e537d1050 compiler/basicTypes/PatSyn.lhs | 8 +------- compiler/main/TidyPgm.lhs | 15 +++++++++------ 2 files changed, 10 insertions(+), 13 deletions(-) diff --git a/compiler/basicTypes/PatSyn.lhs b/compiler/basicTypes/PatSyn.lhs index cba8427..2081b5a 100644 --- a/compiler/basicTypes/PatSyn.lhs +++ b/compiler/basicTypes/PatSyn.lhs @@ -17,7 +17,7 @@ module PatSyn ( patSynWrapper, patSynMatcher, patSynExTyVars, patSynSig, patSynInstArgTys, patSynInstResTy, - tidyPatSynIds, patSynIds + tidyPatSynIds ) where #include "HsVersions.h" @@ -267,12 +267,6 @@ patSynWrapper = psWrapper patSynMatcher :: PatSyn -> Id patSynMatcher = psMatcher -patSynIds :: PatSyn -> [Id] -patSynIds (MkPatSyn { psMatcher = match_id, psWrapper = mb_wrap_id }) - = case mb_wrap_id of - Nothing -> [match_id] - Just wrap_id -> [match_id, wrap_id] - tidyPatSynIds :: (Id -> Id) -> PatSyn -> PatSyn tidyPatSynIds tidy_fn ps@(MkPatSyn { psMatcher = match_id, psWrapper = mb_wrap_id }) = ps { psMatcher = tidy_fn match_id, psWrapper = fmap tidy_fn mb_wrap_id } diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index 6f24e3a..4615859 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -142,12 +142,12 @@ mkBootModDetailsTc hsc_env ; showPass dflags CoreTidy ; let { insts' = map (tidyClsInstDFun globaliseAndTidyId) insts - ; pat_syns' = map (tidyPatSynIds globaliseAndTidyId) pat_syns - ; dfun_ids = map instanceDFunId insts' - ; pat_syn_ids = concatMap patSynIds pat_syns' ; type_env1 = mkBootTypeEnv (availsToNameSet exports) (typeEnvIds type_env) tcs fam_insts - ; type_env' = extendTypeEnvWithIds type_env1 (pat_syn_ids ++ dfun_ids) + ; pat_syns' = map (tidyPatSynIds globaliseAndTidyId) pat_syns + ; type_env2 = extendTypeEnvWithPatSyns pat_syns' type_env1 + ; dfun_ids = map instanceDFunId insts' + ; type_env' = extendTypeEnvWithIds type_env2 dfun_ids } ; return (ModDetails { md_types = type_env' , md_insts = insts' @@ -360,8 +360,7 @@ tidyProgram hsc_env (ModGuts { mg_module = mod -- This is really the only reason we keep mg_patsyns at all; otherwise -- they could just stay in type_env ; tidy_patsyns = map (tidyPatSynIds (lookup_aux_id tidy_type_env)) patsyns - ; type_env2 = extendTypeEnvList type_env1 - [AConLike (PatSynCon ps) | ps <- tidy_patsyns ] + ; type_env2 = extendTypeEnvWithPatSyns tidy_patsyns type_env1 ; tidy_type_env = tidyTypeEnv omit_prags type_env2 @@ -457,6 +456,10 @@ trimThing (AnId id) trimThing other_thing = other_thing + +extendTypeEnvWithPatSyns :: [PatSyn] -> TypeEnv -> TypeEnv +extendTypeEnvWithPatSyns tidy_patsyns type_env + = extendTypeEnvList type_env [AConLike (PatSynCon ps) | ps <- tidy_patsyns ] \end{code} \begin{code} From git at git.haskell.org Fri Aug 29 14:03:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:03:40 +0000 (UTC) Subject: [commit: ghc] master: Improve the ghc-pkg warnings for missing and out of date package cache files (ce29a26) Message-ID: <20140829140341.8EC3924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ce29a2609cdd2c1941fcd184d7c76a73cdd050f9/ghc >--------------------------------------------------------------- commit ce29a2609cdd2c1941fcd184d7c76a73cdd050f9 Author: Duncan Coutts Date: Tue Aug 19 16:10:04 2014 +0100 Improve the ghc-pkg warnings for missing and out of date package cache files In particular, report when it's missing, and also report it for ghc-pkg check. Also make the warning message more explicit, that ghc will not be able to read these dbs, even though ghc-pkg may be able to. >--------------------------------------------------------------- ce29a2609cdd2c1941fcd184d7c76a73cdd050f9 utils/ghc-pkg/Main.hs | 61 ++++++++++++++++++++++++++++++++------------------- 1 file changed, 38 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 ce29a2609cdd2c1941fcd184d7c76a73cdd050f9 From git at git.haskell.org Fri Aug 29 14:03:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:03:43 +0000 (UTC) Subject: [commit: ghc] master: Simplify conversion in binary serialisation of ghc-pkg db (69e9f6e) Message-ID: <20140829140343.1B96F24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/69e9f6e48f938ce62a885a9086392ffd6a579c29/ghc >--------------------------------------------------------------- commit 69e9f6e48f938ce62a885a9086392ffd6a579c29 Author: Duncan Coutts Date: Tue Aug 19 01:00:54 2014 +0100 Simplify conversion in binary serialisation of ghc-pkg db We can serialise directly, without having to convert some fields to string first. (Part of preparitory work for removing the compiler's dep on Cabal) >--------------------------------------------------------------- 69e9f6e48f938ce62a885a9086392ffd6a579c29 .../bin-package-db/Distribution/InstalledPackageInfo/Binary.hs | 6 ++++++ utils/ghc-pkg/Main.hs | 7 +++---- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs b/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs index baf8a05..9fd27f6 100644 --- a/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs +++ b/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs @@ -22,8 +22,10 @@ module Distribution.InstalledPackageInfo.Binary ( import Distribution.Version import Distribution.Package hiding (depends) import Distribution.License +import Distribution.ModuleName as ModuleName import Distribution.ModuleExport import Distribution.InstalledPackageInfo as IPI +import Distribution.Text (display) import Data.Binary as Bin import Control.Exception as Exception @@ -164,6 +166,10 @@ instance Binary Version where deriving instance Binary PackageName deriving instance Binary InstalledPackageId +instance Binary ModuleName where + put = put . display + get = fmap ModuleName.fromString get + instance Binary m => Binary (ModuleExport m) where put (ModuleExport a b c d) = do put a; put b; put c; put d get = do a <- get; b <- get; c <- get; d <- get; diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index c88b814..554640e 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -706,8 +706,7 @@ readParseDatabase verbosity mb_user_conf use_cache path when (verbosity > Normal) $ infoLn ("using cache: " ++ cache) pkgs <- myReadBinPackageDB cache - let pkgs' = map convertPackageInfoIn pkgs - mkPackageDB pkgs' + mkPackageDB pkgs else do when (verbosity >= Normal) $ do warn ("WARNING: cache is out of date: " @@ -735,7 +734,7 @@ readParseDatabase verbosity mb_user_conf use_cache path -- bytestring 0.9.0.x (fixed in 0.9.1.x) where the file wasn't closed -- after it has been completely read, leading to a sharing violation -- later. -myReadBinPackageDB :: FilePath -> IO [InstalledPackageInfoString] +myReadBinPackageDB :: FilePath -> IO [InstalledPackageInfo] myReadBinPackageDB filepath = do h <- openBinaryFile filepath ReadMode sz <- hFileSize h @@ -1021,7 +1020,7 @@ updateDBCache verbosity db = do let filename = location db cachefilename when (verbosity > Normal) $ infoLn ("writing cache " ++ filename) - writeBinaryFileAtomic filename (map convertPackageInfoOut (packages db)) + writeBinaryFileAtomic filename (packages db) `catchIO` \e -> if isPermissionError e then die (filename ++ ": you don't have permission to modify this file") From git at git.haskell.org Fri Aug 29 14:03:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:03:45 +0000 (UTC) Subject: [commit: ghc] master: Drop support for single-file style package databases (557c8b8) Message-ID: <20140829140345.7D32E24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/557c8b8c3591ae908c1309afd53e0d8db096f43a/ghc >--------------------------------------------------------------- commit 557c8b8c3591ae908c1309afd53e0d8db096f43a Author: Duncan Coutts Date: Tue Aug 19 13:23:56 2014 +0100 Drop support for single-file style package databases Historically the package db format was a single text file in Read/Show format containing [InstalledPackageInfo]. For several years now the default format has been a directory with one file per package, plus a binary cache. The old format cannot be supported under the new scheme where the compiler will not depend on the Cabal library (because it will not have access to the InstalledPackageInfo type) so we must drop support. It would still technically be possible to support a single text file style db (but containing a different type), but there does not seem to be any compelling reason to do so. (Part of preparitory work for removing the compiler's dep on Cabal) >--------------------------------------------------------------- 557c8b8c3591ae908c1309afd53e0d8db096f43a compiler/main/Packages.lhs | 18 +++++-------- utils/ghc-pkg/Main.hs | 67 +++++++--------------------------------------- 2 files changed, 16 insertions(+), 69 deletions(-) diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 702c049..8bb56fd 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -74,7 +74,6 @@ import System.Directory import System.FilePath as FilePath import qualified System.FilePath.Posix as FilePath.Posix import Control.Monad -import Data.Char (isSpace) import Data.List as List import Data.Map (Map) import Data.Monoid hiding ((<>)) @@ -391,16 +390,13 @@ readPackageConfig dflags conf_file = do else do isfile <- doesFileExist conf_file - when (not isfile) $ - throwGhcExceptionIO $ InstallationError $ - "can't find a package database at " ++ conf_file - debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file) - str <- readFile conf_file - case reads str of - [(configs, rest)] - | all isSpace rest -> return (map installedPackageInfoToPackageConfig configs) - _ -> throwGhcExceptionIO $ InstallationError $ - "invalid package database file " ++ conf_file + if isfile + then throwGhcExceptionIO $ InstallationError $ + "ghc no longer supports single-file style package databases (" ++ + conf_file ++ + ") use 'ghc-pkg init' to create the database with the correct format." + else throwGhcExceptionIO $ InstallationError $ + "can't find a package database at " ++ conf_file let top_dir = topDir dflags diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 554640e..3825e4e 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -46,6 +46,7 @@ import System.Exit ( exitWith, ExitCode(..) ) import System.Environment ( getArgs, getProgName, getEnv ) import System.IO import System.IO.Error +import GHC.IO.Exception (IOErrorType(InappropriateType)) import Data.List import Control.Concurrent @@ -672,9 +673,12 @@ readParseDatabase verbosity mb_user_conf use_cache path | otherwise = do e <- tryIO $ getDirectoryContents path case e of - Left _ -> do - pkgs <- parseMultiPackageConf verbosity path - mkPackageDB pkgs + Left err + | ioeGetErrorType err == InappropriateType -> + die ("ghc no longer supports single-file style package databases (" + ++ path ++ ") use 'ghc-pkg init' to create the database with " + ++ "the correct format.") + | otherwise -> ioError err Right fs | not use_cache -> ignore_cache (const $ return ()) | otherwise -> do @@ -742,15 +746,6 @@ myReadBinPackageDB filepath = do hClose h return $ Bin.runGet Bin.get b -parseMultiPackageConf :: Verbosity -> FilePath -> IO [InstalledPackageInfo] -parseMultiPackageConf verbosity file = do - when (verbosity > Normal) $ infoLn ("reading package database: " ++ file) - str <- readUTF8File file - let pkgs = map convertPackageInfoIn $ read str - Exception.evaluate pkgs - `catchError` \e-> - die ("error while parsing " ++ file ++ ": " ++ show e) - parseSingletonPackageConf :: Verbosity -> FilePath -> IO InstalledPackageInfo parseSingletonPackageConf verbosity file = do when (verbosity > Normal) $ infoLn ("reading package config: " ++ file) @@ -982,12 +977,8 @@ data DBOp = RemovePackage InstalledPackageInfo changeDB :: Verbosity -> [DBOp] -> PackageDB -> IO () changeDB verbosity cmds db = do let db' = updateInternalDB db cmds - isfile <- doesFileExist (location db) - if isfile - then writeNewConfig verbosity (location db') (packages db') - else do - createDirectoryIfMissing True (location db) - changeDBDir verbosity cmds db' + createDirectoryIfMissing True (location db) + changeDBDir verbosity cmds db' updateInternalDB :: PackageDB -> [DBOp] -> PackageDB updateInternalDB db cmds = db{ packages = foldl do_cmd (packages db) cmds } @@ -1397,46 +1388,6 @@ closure pkgs db_stack = go pkgs db_stack brokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo] brokenPackages pkgs = snd (closure [] pkgs) --- ----------------------------------------------------------------------------- --- Manipulating package.conf files - -type InstalledPackageInfoString = InstalledPackageInfo_ String - -convertPackageInfoOut :: InstalledPackageInfo -> InstalledPackageInfoString -convertPackageInfoOut - (pkgconf@(InstalledPackageInfo { exposedModules = e, - reexportedModules = r, - hiddenModules = h })) = - pkgconf{ exposedModules = map display e, - reexportedModules = map (fmap display) r, - hiddenModules = map display h } - -convertPackageInfoIn :: InstalledPackageInfoString -> InstalledPackageInfo -convertPackageInfoIn - (pkgconf@(InstalledPackageInfo { exposedModules = e, - reexportedModules = r, - hiddenModules = h })) = - pkgconf{ exposedModules = map convert e, - reexportedModules = map (fmap convert) r, - hiddenModules = map convert h } - where convert = fromJust . simpleParse - -writeNewConfig :: Verbosity -> FilePath -> [InstalledPackageInfo] -> IO () -writeNewConfig verbosity filename ipis = do - when (verbosity >= Normal) $ - info "Writing new package config file... " - createDirectoryIfMissing True $ takeDirectory filename - let shown = concat $ intersperse ",\n " - $ map (show . convertPackageInfoOut) ipis - fileContents = "[" ++ shown ++ "\n]" - writeFileUtf8Atomic filename fileContents - `catchIO` \e -> - if isPermissionError e - then die (filename ++ ": you don't have permission to modify this file") - else ioError e - when (verbosity >= Normal) $ - infoLn "done." - ----------------------------------------------------------------------------- -- Sanity-check a new package config, and automatically build GHCi libs -- if requested. From git at git.haskell.org Fri Aug 29 14:03:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:03:47 +0000 (UTC) Subject: [commit: ghc] master: Use ghc-local types for packages, rather than Cabal types (27d6c08) Message-ID: <20140829140347.E4C5E24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/27d6c089549a2ee815940e6630a54cb372bbbcd2/ghc >--------------------------------------------------------------- commit 27d6c089549a2ee815940e6630a54cb372bbbcd2 Author: Duncan Coutts Date: Fri Aug 22 14:38:10 2014 +0100 Use ghc-local types for packages, rather than Cabal types Also start using the new package db file format properly, by using the ghc-specific section. This is the main patch in the series for removing the compiler's dep on the Cabal lib. >--------------------------------------------------------------- 27d6c089549a2ee815940e6630a54cb372bbbcd2 compiler/ghci/Linker.lhs | 8 +- compiler/main/Finder.lhs | 19 ++- compiler/main/PackageConfig.hs | 124 ++++++++++++------- compiler/main/Packages.lhs | 74 ++++++------ libraries/bin-package-db/GHC/PackageDb.hs | 195 +++++++++++++++++++++++++++--- utils/ghc-pkg/Main.hs | 60 ++++++++- 6 files changed, 360 insertions(+), 120 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 27d6c089549a2ee815940e6630a54cb372bbbcd2 From git at git.haskell.org Fri Aug 29 14:03:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:03:50 +0000 (UTC) Subject: [commit: ghc] master: Make binary a boot package (227205e) Message-ID: <20140829140350.E68F424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/227205e1b5143631b1f47ef9b4677a1b6675b067/ghc >--------------------------------------------------------------- commit 227205e1b5143631b1f47ef9b4677a1b6675b067 Author: Duncan Coutts Date: Fri Aug 22 15:10:47 2014 +0100 Make binary a boot package Since ghc-pkg needs a relatively recent version. >--------------------------------------------------------------- 227205e1b5143631b1f47ef9b4677a1b6675b067 ghc.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghc.mk b/ghc.mk index 8ba90fe..fb93ef0 100644 --- a/ghc.mk +++ b/ghc.mk @@ -383,7 +383,7 @@ else # 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 = Cabal/Cabal hpc bin-package-db hoopl transformers +PACKAGES_STAGE0 = Cabal/Cabal hpc binary bin-package-db hoopl transformers ifeq "$(Windows_Host)" "NO" ifneq "$(HostOS_CPP)" "ios" PACKAGES_STAGE0 += terminfo From git at git.haskell.org Fri Aug 29 14:03:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:03:53 +0000 (UTC) Subject: [commit: ghc] master: Fix warnings arising from the package db refactoring (6930a88) Message-ID: <20140829140353.6EBBE24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6930a88c307825d95f22ed9cb8ba3c894b600905/ghc >--------------------------------------------------------------- commit 6930a88c307825d95f22ed9cb8ba3c894b600905 Author: Duncan Coutts Date: Fri Aug 22 15:57:07 2014 +0100 Fix warnings arising from the package db refactoring >--------------------------------------------------------------- 6930a88c307825d95f22ed9cb8ba3c894b600905 libraries/bin-package-db/GHC/PackageDb.hs | 10 +++++----- utils/ghc-pkg/Main.hs | 6 +----- 2 files changed, 6 insertions(+), 10 deletions(-) diff --git a/libraries/bin-package-db/GHC/PackageDb.hs b/libraries/bin-package-db/GHC/PackageDb.hs index 08dabd2..b29d707 100644 --- a/libraries/bin-package-db/GHC/PackageDb.hs +++ b/libraries/bin-package-db/GHC/PackageDb.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} -- This module deliberately defines orphan instances for now (Binary Version). -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.PackageDb @@ -246,10 +246,10 @@ writeFileAtomic targetPath content = do let (targetDir, targetName) = splitFileName targetPath Exception.bracketOnError (openBinaryTempFileWithDefaultPermissions targetDir $ targetName <.> "tmp") - (\(tmpPath, handle) -> hClose handle >> removeFile tmpPath) - (\(tmpPath, handle) -> do - BS.Lazy.hPut handle content - hClose handle + (\(tmpPath, hnd) -> hClose hnd >> removeFile tmpPath) + (\(tmpPath, hnd) -> do + BS.Lazy.hPut hnd content + hClose hnd #if mingw32_HOST_OS || mingw32_TARGET_OS renameFile tmpPath targetPath -- If the targetPath exists then renameFile will fail diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index d9af8fb..858797f 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, RecordWildCards, GeneralizedNewtypeDeriving, StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 2004-2009. @@ -13,7 +14,6 @@ module Main (main) where import Version ( version, targetOS, targetARCH ) import qualified GHC.PackageDb as GhcPkg import qualified Distribution.Simple.PackageIndex as PackageIndex -import qualified Distribution.Package as Cabal import qualified Distribution.ModuleName as ModuleName import Distribution.ModuleName (ModuleName) import Distribution.InstalledPackageInfo as Cabal @@ -1899,10 +1899,6 @@ throwIOIO = Exception.throwIO catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a catchIO = Exception.catch -catchError :: IO a -> (String -> IO a) -> IO a -catchError io handler = io `Exception.catch` handler' - where handler' (Exception.ErrorCall err) = handler err - tryIO :: IO a -> IO (Either Exception.IOException a) tryIO = Exception.try From git at git.haskell.org Fri Aug 29 14:03:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:03:56 +0000 (UTC) Subject: [commit: ghc] master: Introduce new file format for the package database binary cache (8d7a1dc) Message-ID: <20140829140356.5E65E24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8d7a1dcdbee47a980d0ecc8fa8e9336866a75d1b/ghc >--------------------------------------------------------------- commit 8d7a1dcdbee47a980d0ecc8fa8e9336866a75d1b Author: Duncan Coutts Date: Tue Aug 19 20:33:10 2014 +0100 Introduce new file format for the package database binary cache The purpose of the new format is to make it possible for the compiler to not depend on the Cabal library. The new cache file format contains more or less the same information duplicated in two different sections using different representations. One section is basically the same as what the package db contains now, a list of packages using the types defined in the Cabal library. This section is read back by ghc-pkg, and used for things like ghc-pkg dump which have to produce output using the Cabal InstalledPackageInfo text representation. The other section is a ghc-local type which contains a subset of the information from the Cabal InstalledPackageInfo -- just the bits that the compiler cares about. The trick is that the compiler can read this second section without needing to know the representation (or types) of the first part. The ghc-pkg tool knows about both representations and writes both. This patch introduces the new cache file format but does not yet use it properly. More patches to follow. (As of this patch, the compiler reads the part intended for ghc-pkg so it still depends on Cabal and the ghc-local package type is not yet fully defined.) >--------------------------------------------------------------- 8d7a1dcdbee47a980d0ecc8fa8e9336866a75d1b compiler/main/Packages.lhs | 6 +- .../Distribution/InstalledPackageInfo/Binary.hs | 19 +- libraries/bin-package-db/GHC/PackageDb.hs | 206 +++++++++++++++++++++ libraries/bin-package-db/bin-package-db.cabal | 18 +- utils/ghc-pkg/Main.hs | 33 ++-- 5 files changed, 238 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 8d7a1dcdbee47a980d0ecc8fa8e9336866a75d1b From git at git.haskell.org Fri Aug 29 14:03:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:03:58 +0000 (UTC) Subject: [commit: ghc] master: Fix long lines and trailing whitespace (29f84d3) Message-ID: <20140829140358.ADB4324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/29f84d30e3283c3da50c7c37a544672db5eee2b7/ghc >--------------------------------------------------------------- commit 29f84d30e3283c3da50c7c37a544672db5eee2b7 Author: Duncan Coutts Date: Sat Aug 23 13:12:20 2014 +0100 Fix long lines and trailing whitespace in the previous patches in this series >--------------------------------------------------------------- 29f84d30e3283c3da50c7c37a544672db5eee2b7 compiler/ghci/Linker.lhs | 10 ++-- compiler/main/Finder.lhs | 5 +- compiler/main/PackageConfig.hs | 0 compiler/main/Packages.lhs | 14 ++++-- libraries/bin-package-db/GHC/PackageDb.hs | 21 ++++---- utils/ghc-pkg/Main.hs | 81 ++++++++++++++++++------------- 6 files changed, 78 insertions(+), 53 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 29f84d30e3283c3da50c7c37a544672db5eee2b7 From git at git.haskell.org Fri Aug 29 14:04:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:04:01 +0000 (UTC) Subject: [commit: ghc] master: Move Cabal Binary instances from bin-package-db to ghc-pkg itself (0af7d0c) Message-ID: <20140829140401.41A8F24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0af7d0c10b6370d370b2cdfc4010217be735c3c7/ghc >--------------------------------------------------------------- commit 0af7d0c10b6370d370b2cdfc4010217be735c3c7 Author: Duncan Coutts Date: Fri Aug 22 15:08:24 2014 +0100 Move Cabal Binary instances from bin-package-db to ghc-pkg itself The ghc-pkg program of course still depends on Cabal, it's just the bin-package-db library (shared between ghc and ghc-pkg) that does not. >--------------------------------------------------------------- 0af7d0c10b6370d370b2cdfc4010217be735c3c7 .../Distribution/InstalledPackageInfo/Binary.hs | 168 --------------------- libraries/bin-package-db/bin-package-db.cabal | 10 +- utils/ghc-pkg/Main.hs | 152 ++++++++++++++++++- 3 files changed, 152 insertions(+), 178 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 0af7d0c10b6370d370b2cdfc4010217be735c3c7 From git at git.haskell.org Fri Aug 29 14:04:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:04:03 +0000 (UTC) Subject: [commit: ghc] master: Remove a TODO that is now done (8955b5e) Message-ID: <20140829140404.14CED24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8955b5eea3e8c1ddcba57261ab0e1250783ddda2/ghc >--------------------------------------------------------------- commit 8955b5eea3e8c1ddcba57261ab0e1250783ddda2 Author: Duncan Coutts Date: Sun Aug 24 03:41:45 2014 +0100 Remove a TODO that is now done >--------------------------------------------------------------- 8955b5eea3e8c1ddcba57261ab0e1250783ddda2 compiler/main/Packages.lhs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 9640f72..9b18a33 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -383,10 +383,6 @@ readPackageConfig dflags conf_file = do then do let filename = conf_file "package.cache" debugTraceMsg dflags 2 (text "Using binary package database:" <+> text filename) readPackageDbForGhc filename -{- - -- TODO readPackageDbForGhc ^^ instead - return (map installedPackageInfoToPackageConfig conf) --} else do isfile <- doesFileExist conf_file if isfile From git at git.haskell.org Fri Aug 29 14:04:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:04:06 +0000 (UTC) Subject: [commit: ghc] master: Add a ghc -show-packages mode to display ghc's view of the package env (a4cb9a6) Message-ID: <20140829140406.9D01124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a4cb9a6173f0af76a32b812c022bbdd76b2abfac/ghc >--------------------------------------------------------------- commit a4cb9a6173f0af76a32b812c022bbdd76b2abfac Author: Duncan Coutts Date: Sun Aug 24 03:38:39 2014 +0100 Add a ghc -show-packages mode to display ghc's view of the package env You can use ghc -show-packages, in addition to any -package -package-conf -hide-package, etc flags and see just what ghc's package info looks like. The format is much like ghc-pkg show. Like the existing verbose tracing, but a specific mode. Re-introduce pretty printed package info (Cabal handled this previously). >--------------------------------------------------------------- a4cb9a6173f0af76a32b812c022bbdd76b2abfac compiler/main/PackageConfig.hs | 41 +++++++++++++++++++++++++++++++---------- compiler/main/Packages.lhs | 27 +++++++++++++-------------- ghc/Main.hs | 16 +++++++++++++--- 3 files changed, 57 insertions(+), 27 deletions(-) diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs index 7cd2779..3124e29 100644 --- a/compiler/main/PackageConfig.hs +++ b/compiler/main/PackageConfig.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, RecordWildCards #-} -- | -- Package configuration information: essentially the interface to Cabal, with @@ -23,7 +23,7 @@ module PackageConfig ( installedPackageIdString, sourcePackageIdString, packageNameString, - showInstalledPackageInfo, + pprPackageConfig, ) where #include "HsVersions.h" @@ -97,14 +97,35 @@ packageNameString pkg = str where PackageName str = packageName pkg -showInstalledPackageInfo :: PackageConfig -> String -showInstalledPackageInfo = show - -instance Show ModuleName where - show = moduleNameString - -instance Show PackageKey where - show = packageKeyString +pprPackageConfig :: PackageConfig -> SDoc +pprPackageConfig InstalledPackageInfo {..} = + vcat [ + field "name" (ppr packageName), + field "version" (text (showVersion packageVersion)), + field "id" (ppr installedPackageId), + field "key" (ppr packageKey), + field "exposed" (ppr exposed), + field "exposed-modules" (fsep (map ppr exposedModules)), + field "hidden-modules" (fsep (map ppr hiddenModules)), + field "reexported-modules" (fsep (map ppr haddockHTMLs)), + field "trusted" (ppr trusted), + field "import-dirs" (fsep (map text importDirs)), + field "library-dirs" (fsep (map text libraryDirs)), + field "hs-libraries" (fsep (map text hsLibraries)), + field "extra-libraries" (fsep (map text extraLibraries)), + field "extra-ghci-libraries" (fsep (map text extraGHCiLibraries)), + field "include-dirs" (fsep (map text includeDirs)), + field "includes" (fsep (map text includes)), + field "depends" (fsep (map ppr depends)), + field "cc-options" (fsep (map text ccOptions)), + field "ld-options" (fsep (map text ldOptions)), + field "framework-dirs" (fsep (map text frameworkDirs)), + field "frameworks" (fsep (map text frameworks)), + field "haddock-interfaces" (fsep (map text haddockInterfaces)), + field "haddock-html" (fsep (map text haddockHTMLs)) + ] + where + field name body = text name <> colon <+> nest 4 body -- ----------------------------------------------------------------------------- diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 9b18a33..af2d3fe 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -16,8 +16,6 @@ module Packages ( lookupPackage, resolveInstalledPackageId, searchPackageId, - dumpPackages, - simpleDumpPackages, getPackageDetails, listVisibleModuleNames, lookupModuleInAllPackages, @@ -42,6 +40,8 @@ module Packages ( -- * Utils packageKeyPackageIdString, pprFlag, + pprPackages, + pprPackagesSimple, pprModuleMap, isDllName ) @@ -63,7 +63,7 @@ import Maybes import System.Environment ( getEnv ) import FastString -import ErrUtils ( debugTraceMsg, putMsg, MsgDoc ) +import ErrUtils ( debugTraceMsg, MsgDoc ) import Exception import Unique @@ -1422,21 +1422,20 @@ isDllName dflags _this_pkg this_mod name -- ----------------------------------------------------------------------------- -- Displaying packages --- | Show (very verbose) package info on console, if verbosity is >= 5 -dumpPackages :: DynFlags -> IO () -dumpPackages = dumpPackages' showInstalledPackageInfo +-- | Show (very verbose) package info +pprPackages :: DynFlags -> SDoc +pprPackages = pprPackagesWith pprPackageConfig -dumpPackages' :: (PackageConfig -> String) -> DynFlags -> IO () -dumpPackages' showIPI dflags - = do putMsg dflags $ - vcat (map (text . showIPI) - (listPackageConfigMap dflags)) +pprPackagesWith :: (PackageConfig -> SDoc) -> DynFlags -> SDoc +pprPackagesWith pprIPI dflags = + vcat (intersperse (text "---") (map pprIPI (listPackageConfigMap dflags))) --- | Show simplified package info on console, if verbosity == 4. +-- | Show simplified package info. +-- -- The idea is to only print package id, and any information that might -- be different from the package databases (exposure, trust) -simpleDumpPackages :: DynFlags -> IO () -simpleDumpPackages = dumpPackages' showIPI +pprPackagesSimple :: DynFlags -> SDoc +pprPackagesSimple = pprPackagesWith (text . showIPI) where showIPI ipi = let InstalledPackageId i = installedPackageId ipi e = if exposed ipi then "E" else " " t = if trusted ipi then "T" else " " diff --git a/ghc/Main.hs b/ghc/Main.hs index 70dde39..8746125 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -33,7 +33,7 @@ import InteractiveUI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings ) import Config import Constants import HscTypes -import Packages ( dumpPackages, simpleDumpPackages, pprModuleMap ) +import Packages ( pprPackages, pprPackagesSimple, pprModuleMap ) import DriverPhases import BasicTypes ( failed ) import StaticFlags @@ -210,7 +210,7 @@ main' postLoadMode dflags0 args flagWarnings = do ---------------- Display configuration ----------- case verbosity dflags6 of - v | v == 4 -> liftIO $ simpleDumpPackages dflags6 + v | v == 4 -> liftIO $ dumpPackagesSimple dflags6 | v >= 5 -> liftIO $ dumpPackages dflags6 | otherwise -> return () @@ -237,6 +237,7 @@ main' postLoadMode dflags0 args flagWarnings = do DoInteractive -> ghciUI srcs Nothing DoEval exprs -> ghciUI srcs $ Just $ reverse exprs DoAbiHash -> abiHash srcs + ShowPackages -> liftIO $ showPackages dflags6 liftIO $ dumpFinalStats dflags6 @@ -435,12 +436,15 @@ data PostLoadMode | DoInteractive -- ghc --interactive | DoEval [String] -- ghc -e foo -e bar => DoEval ["bar", "foo"] | DoAbiHash -- ghc --abi-hash + | ShowPackages -- ghc --show-packages -doMkDependHSMode, doMakeMode, doInteractiveMode, doAbiHashMode :: Mode +doMkDependHSMode, doMakeMode, doInteractiveMode, + doAbiHashMode, showPackagesMode :: Mode doMkDependHSMode = mkPostLoadMode DoMkDependHS doMakeMode = mkPostLoadMode DoMake doInteractiveMode = mkPostLoadMode DoInteractive doAbiHashMode = mkPostLoadMode DoAbiHash +showPackagesMode = mkPostLoadMode ShowPackages showInterfaceMode :: FilePath -> Mode showInterfaceMode fp = mkPostLoadMode (ShowInterface fp) @@ -533,6 +537,7 @@ mode_flags = , Flag "-show-options" (PassFlag (setMode showOptionsMode)) , Flag "-supported-languages" (PassFlag (setMode showSupportedExtensionsMode)) , Flag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode)) + , Flag "-show-packages" (PassFlag (setMode showPackagesMode)) ] ++ [ Flag k' (PassFlag (setMode (printSetting k))) | k <- ["Project version", @@ -772,6 +777,11 @@ countFS entries longest has_z (b:bs) = in countFS entries' longest' (has_z + has_zs) bs +showPackages, dumpPackages, dumpPackagesSimple :: DynFlags -> IO () +showPackages dflags = putStrLn (showSDoc dflags (pprPackages dflags)) +dumpPackages dflags = putMsg dflags (pprPackages dflags) +dumpPackagesSimple dflags = putMsg dflags (pprPackagesSimple dflags) + -- ----------------------------------------------------------------------------- -- ABI hash support From git at git.haskell.org Fri Aug 29 14:04:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:04:08 +0000 (UTC) Subject: [commit: ghc] master: Drop ghc library dep on Cabal (9597a25) Message-ID: <20140829140408.E4D3024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9597a258d356ae83411a512351c92428b61c112d/ghc >--------------------------------------------------------------- commit 9597a258d356ae83411a512351c92428b61c112d Author: Duncan Coutts Date: Fri Aug 22 15:09:55 2014 +0100 Drop ghc library dep on Cabal >--------------------------------------------------------------- 9597a258d356ae83411a512351c92428b61c112d compiler/ghc.cabal.in | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index d449ada..31220e4 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -52,7 +52,6 @@ Library containers >= 0.1 && < 0.6, array >= 0.1 && < 0.6, filepath >= 1 && < 1.4, - Cabal, hpc, transformers, bin-package-db, From git at git.haskell.org Fri Aug 29 14:04:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:04:11 +0000 (UTC) Subject: [commit: ghc] master: Address a number of Edward's code review comments (42f99e9) Message-ID: <20140829140411.46C7A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/42f99e99ab38314b15d5ad4bb360ed04579bdc2d/ghc >--------------------------------------------------------------- commit 42f99e99ab38314b15d5ad4bb360ed04579bdc2d Author: Duncan Coutts Date: Sun Aug 24 23:43:40 2014 +0100 Address a number of Edward's code review comments Some others addressed as part of other recent patches. >--------------------------------------------------------------- 42f99e99ab38314b15d5ad4bb360ed04579bdc2d compiler/main/Finder.lhs | 1 + libraries/bin-package-db/GHC/PackageDb.hs | 7 +++++++ utils/ghc-pkg/Main.hs | 17 +++++++++++------ 3 files changed, 19 insertions(+), 6 deletions(-) diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs index 65151d9..b5ad08b 100644 --- a/compiler/main/Finder.lhs +++ b/compiler/main/Finder.lhs @@ -615,6 +615,7 @@ cantFindErr cannot_find _ dflags mod_name find_result | otherwise = hang (ptext (sLit "Locations searched:")) 2 $ vcat (map text files) + pkg_hidden :: PackageKey -> SDoc pkg_hidden pkgid = ptext (sLit "It is a member of the hidden package") <+> quotes (ppr pkgid) diff --git a/libraries/bin-package-db/GHC/PackageDb.hs b/libraries/bin-package-db/GHC/PackageDb.hs index eea525c..5039a01 100644 --- a/libraries/bin-package-db/GHC/PackageDb.hs +++ b/libraries/bin-package-db/GHC/PackageDb.hs @@ -154,6 +154,10 @@ readPackageDbForGhc file = -- | Read the part of the package DB that ghc-pkg is interested in -- +-- Note that the Binary instance for ghc-pkg's representation of packages +-- is not defined in this package. This is because ghc-pkg uses Cabal types +-- (and Binary instances for these) which this package does not depend on. +-- readPackageDbForGhcPkg :: Binary pkgs => FilePath -> IO pkgs readPackageDbForGhcPkg file = decodeFromFile file getDbForGhcPkg @@ -224,6 +228,9 @@ headerMagic :: BS.ByteString headerMagic = BS.Char8.pack "\0ghcpkg\0" +-- TODO: we may be able to replace the following with utils from the binary +-- package in future. + -- | Feed a 'Get' decoder with data chunks from a file. -- decodeFromFile :: FilePath -> Get a -> IO a diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index ec23eb4..fdb255a 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -590,8 +590,9 @@ getPkgDatabases verbosity modify use_user use_cache expand_vars my_flags = do Just f -> return (Just (f, True)) fs -> return (Just (last fs, True)) - -- If the user database exists, and for "check" and all "modify" commands - -- we will attempt to use the user db. + -- If the user database exists, and for "use_user" commands (which includes + -- "ghc-pkg check" and all commands that modify the db) we will attempt to + -- use the user db. let sys_databases | Just (user_conf,user_exists) <- mb_user_conf, use_user || user_exists = [user_conf, global_conf] @@ -694,8 +695,7 @@ readParseDatabase verbosity mb_user_conf modify use_cache path e_tcache <- tryIO $ getModificationTime cache case e_tcache of Left ex -> do - when ( verbosity > Normal - || verbosity >= Normal && not modify) $ + whenReportCacheErrors $ if isDoesNotExistError ex then do warn ("WARNING: cache does not exist: " ++ cache) @@ -727,8 +727,7 @@ readParseDatabase verbosity mb_user_conf modify use_cache path pkgs <- GhcPkg.readPackageDbForGhcPkg cache mkPackageDB pkgs else do - when ( verbosity > Normal - || verbosity >= Normal && not modify) $ do + whenReportCacheErrors $ do warn ("WARNING: cache is out of date: " ++ cache) warn ("ghc will see an old view of this " ++ "package db. Use 'ghc-pkg recache' to fix.") @@ -741,6 +740,12 @@ readParseDatabase verbosity mb_user_conf modify use_cache path parseSingletonPackageConf verbosity f pkgs <- mapM doFile $ map (path ) confs mkPackageDB pkgs + + -- We normally report cache errors for read-only commands, + -- since modify commands because will usually fix the cache. + whenReportCacheErrors = + when ( verbosity > Normal + || verbosity >= Normal && not modify) where mkPackageDB pkgs = do path_abs <- absolutePath path From git at git.haskell.org Fri Aug 29 14:04:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:04:13 +0000 (UTC) Subject: [commit: ghc] master: Switch the package id types to use FastString (rather than String) (c72efd7) Message-ID: <20140829140413.D5CFC24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c72efd7cee77d5f934bbede4ddf680ea348467db/ghc >--------------------------------------------------------------- commit c72efd7cee77d5f934bbede4ddf680ea348467db Author: Duncan Coutts Date: Sun Aug 24 21:59:03 2014 +0100 Switch the package id types to use FastString (rather than String) The conversions should now be correct w.r.t Unicode. Also move a couple instances to avoid orphan instances. Strictly speaking there's no need for these types to use FastString as they do not need the unique feature. They could just use some other compact string type, but ghc's internal utils don't have much support for such a type, so we just use FastString. >--------------------------------------------------------------- c72efd7cee77d5f934bbede4ddf680ea348467db compiler/basicTypes/Module.lhs | 9 +++++++++ compiler/main/PackageConfig.hs | 44 +++++++++++++++++++----------------------- compiler/main/Packages.lhs | 28 +++++++++++++-------------- 3 files changed, 43 insertions(+), 38 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c72efd7cee77d5f934bbede4ddf680ea348467db From git at git.haskell.org Fri Aug 29 14:04:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:04:16 +0000 (UTC) Subject: [commit: ghc] master: Fix validation error in Linker arising from package rep changes (9d6fbcc) Message-ID: <20140829140416.252AC24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9d6fbcc73309fea32cdf3ee751f21dca904bcf72/ghc >--------------------------------------------------------------- commit 9d6fbcc73309fea32cdf3ee751f21dca904bcf72 Author: Duncan Coutts Date: Wed Aug 27 13:26:24 2014 +0100 Fix validation error in Linker arising from package rep changes >--------------------------------------------------------------- 9d6fbcc73309fea32cdf3ee751f21dca904bcf72 compiler/ghci/Linker.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index d4de513..3169858 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -1023,7 +1023,7 @@ data LibrarySpec partOfGHCi :: [PackageName] partOfGHCi | isWindowsHost || isDarwinHost = [] - | otherwise = map PackageName + | otherwise = map (PackageName . mkFastString) ["base", "template-haskell", "editline"] showLS :: LibrarySpec -> String From git at git.haskell.org Fri Aug 29 14:04:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:04:18 +0000 (UTC) Subject: [commit: ghc] master: Fix string conversions in ghc-pkg to be correct w.r.t. Unicode (b00deb7) Message-ID: <20140829140418.BB3FA24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b00deb7ca4b3cf485252779f7515776f8f1f95b6/ghc >--------------------------------------------------------------- commit b00deb7ca4b3cf485252779f7515776f8f1f95b6 Author: Duncan Coutts Date: Sun Aug 24 22:11:33 2014 +0100 Fix string conversions in ghc-pkg to be correct w.r.t. Unicode Similar change to that on the ghc library side in the previous patch. The BinaryStringRep class has to use a ByteString in UTF8 encoding. >--------------------------------------------------------------- b00deb7ca4b3cf485252779f7515776f8f1f95b6 utils/ghc-pkg/Main.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index cedc048..ec23eb4 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -24,6 +24,7 @@ import Distribution.ModuleExport import Distribution.Package hiding (depends) import Distribution.Text import Distribution.Version +import Distribution.Simple.Utils (fromUTF8, toUTF8) import System.FilePath as FilePath import qualified System.FilePath.Posix as FilePath.Posix import System.Process @@ -1075,12 +1076,12 @@ convertPackageInfoToCacheFormat pkg = } instance GhcPkg.BinaryStringRep ModuleName where - fromStringRep = ModuleName.fromString . BS.unpack - toStringRep = BS.pack . display + fromStringRep = ModuleName.fromString . fromUTF8 . BS.unpack + toStringRep = BS.pack . toUTF8 . display instance GhcPkg.BinaryStringRep String where - fromStringRep = BS.unpack - toStringRep = BS.pack + fromStringRep = fromUTF8 . BS.unpack + toStringRep = BS.pack . toUTF8 -- ----------------------------------------------------------------------------- From git at git.haskell.org Fri Aug 29 14:04:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:04:21 +0000 (UTC) Subject: [commit: ghc] master: Make mkFastStringByteString pure and fix up uses (1bc2a55) Message-ID: <20140829140421.7269B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1bc2a55542c487ff97455da5f39597bc25bbfa49/ghc >--------------------------------------------------------------- commit 1bc2a55542c487ff97455da5f39597bc25bbfa49 Author: Duncan Coutts Date: Sun Aug 24 21:46:17 2014 +0100 Make mkFastStringByteString pure and fix up uses It's morally pure, and we'll need it in a pure context. >--------------------------------------------------------------- 1bc2a55542c487ff97455da5f39597bc25bbfa49 compiler/deSugar/MatchLit.lhs | 3 +-- compiler/utils/Binary.hs | 2 +- compiler/utils/FastString.lhs | 15 ++++++++------- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs index 71a5e10..38ed3af 100644 --- a/compiler/deSugar/MatchLit.lhs +++ b/compiler/deSugar/MatchLit.lhs @@ -38,7 +38,6 @@ import TysWiredIn import Literal import SrcLoc import Data.Ratio -import MonadUtils import Outputable import BasicTypes import DynFlags @@ -365,7 +364,7 @@ matchLiterals (var:vars) ty sub_groups wrap_str_guard eq_str (MachStr s, mr) = do { -- We now have to convert back to FastString. Perhaps there -- should be separate MachBytes and MachStr constructors? - s' <- liftIO $ mkFastStringByteString s + let s' = mkFastStringByteString s ; lit <- mkStringExprFS s' ; let pred = mkApps (Var eq_str) [Var var, lit] ; return (mkGuardedMatchResult pred mr) } diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 0aa8c64..53ee903 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -681,7 +681,7 @@ putFS bh fs = putBS bh $ fastStringToByteString fs getFS :: BinHandle -> IO FastString getFS bh = do bs <- getBS bh - mkFastStringByteString bs + return $! mkFastStringByteString bs putBS :: BinHandle -> ByteString -> IO () putBS bh bs = diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs index 157e5f0..a38d87e 100644 --- a/compiler/utils/FastString.lhs +++ b/compiler/utils/FastString.lhs @@ -380,10 +380,12 @@ mkFastStringForeignPtr ptr !fp len -- | Create a 'FastString' from an existing 'ForeignPtr'; the difference -- between this and 'mkFastStringBytes' is that we don't have to copy -- the bytes if the string is new to the table. -mkFastStringByteString :: ByteString -> IO FastString -mkFastStringByteString bs = BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> do - let ptr' = castPtr ptr - mkFastStringWith (mkNewFastStringByteString bs ptr' len) ptr' len +mkFastStringByteString :: ByteString -> FastString +mkFastStringByteString bs = + inlinePerformIO $ + BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> do + let ptr' = castPtr ptr + mkFastStringWith (mkNewFastStringByteString bs ptr' len) ptr' len -- | Creates a UTF-8 encoded 'FastString' from a 'String' mkFastString :: String -> FastString @@ -510,8 +512,7 @@ zEncodeFS fs@(FastString _ _ _ ref) = Just zfs -> (m', zfs) appendFS :: FastString -> FastString -> FastString -appendFS fs1 fs2 = inlinePerformIO - $ mkFastStringByteString +appendFS fs1 fs2 = mkFastStringByteString $ BS.append (fastStringToByteString fs1) (fastStringToByteString fs2) @@ -530,7 +531,7 @@ tailFS (FastString _ _ bs _) = inlinePerformIO $ BS.unsafeUseAsCString bs $ \ptr -> do let (_, ptr') = utf8DecodeChar (castPtr ptr) n = ptr' `minusPtr` ptr - mkFastStringByteString $ BS.drop n bs + return $! mkFastStringByteString (BS.drop n bs) consFS :: Char -> FastString -> FastString consFS c fs = mkFastString (c : unpackFS fs) From git at git.haskell.org Fri Aug 29 14:04:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:04:23 +0000 (UTC) Subject: [commit: ghc] master: Update Cabal and haddock submodules to follow the Canal-dep removal changes (01461ce) Message-ID: <20140829140423.990AC24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/01461ce86f9d4bd3a4969b43aa9d237949ca3ce6/ghc >--------------------------------------------------------------- commit 01461ce86f9d4bd3a4969b43aa9d237949ca3ce6 Author: Duncan Coutts Date: Wed Aug 27 13:57:46 2014 +0100 Update Cabal and haddock submodules to follow the Canal-dep removal changes In particular, Cabal was still in one place using old file-style package databases. Haddock just needed simple changes to follow the change of representation of packages in the ghc library. >--------------------------------------------------------------- 01461ce86f9d4bd3a4969b43aa9d237949ca3ce6 libraries/Cabal | 2 +- utils/haddock | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 6cc4699..8d59dc9 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 6cc46998f0778c04b535c805416604995fe153b5 +Subproject commit 8d59dc9fba584a9fdb810f4d84f7f3ccb089dd08 diff --git a/utils/haddock b/utils/haddock index f32ad30..b2a807d 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit f32ad30e9b8c5d4ee54c60c9c3b282fef7d297a5 +Subproject commit b2a807da55d197c648fd2df1f156f9862711d92b From git at git.haskell.org Fri Aug 29 14:04:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:04:25 +0000 (UTC) Subject: [commit: ghc] master: Add release notes about ghc-pkg change, and Cabal dep removal (6d8c70c) Message-ID: <20140829140426.0966224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6d8c70c1262a0f8b02ee685905f469f94d742af2/ghc >--------------------------------------------------------------- commit 6d8c70c1262a0f8b02ee685905f469f94d742af2 Author: Duncan Coutts Date: Thu Aug 28 05:52:48 2014 +0100 Add release notes about ghc-pkg change, and Cabal dep removal That ghc-pkg doesn't support single-file style databases, and that the ghc library does not depend on Cabal any more. We don't need to document the ghc-pkg change in the ghc-pkg section itself, since ghc-pkg init is already described there, and that is the right thing. The old deprecated approach was not documented. >--------------------------------------------------------------- 6d8c70c1262a0f8b02ee685905f469f94d742af2 docs/users_guide/7.10.1-notes.xml | 43 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/docs/users_guide/7.10.1-notes.xml b/docs/users_guide/7.10.1-notes.xml index 0af4c31..404d239 100644 --- a/docs/users_guide/7.10.1-notes.xml +++ b/docs/users_guide/7.10.1-notes.xml @@ -118,6 +118,39 @@ + + + Package system + + + + TODO: cover module renaming, thinning, re-export etc + + + + + ghc-pkg (and ghc) have dropped support for single-file style + package databases. Since version 6.12, ghc-pkg has defaulted + to a new database format (using a directory of files, one per + package plus a binary cache). + + + This change will not affect programs and scripts that use + ghc-pkg init to create package databases. + + + This will affect scripts that create package databases + using tricks like + +echo "[]" > package.conf + + Such scripts will need to be modified to use + ghc-pkg init, and to delete databases + by directory removal, rather than simple file delete. + + + + @@ -251,6 +284,16 @@ package ID. + + + The ghc library no longer depends on the Cabal library. This means + that users of the ghc library are no longer forced to use the same + version of Cabal as ghc did. It also means that Cabal is freed up + to be able to depend on packages that ghc does not want to depend + on (which for example may enable improvements to Cabal's parsing + infrastructure). + + From git at git.haskell.org Fri Aug 29 14:04:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:04:28 +0000 (UTC) Subject: [commit: ghc] master: Fix a few minor issues spotted in code review (616dd87) Message-ID: <20140829140428.E856224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/616dd87f60b99d8843058366304e2b9f2475eb57/ghc >--------------------------------------------------------------- commit 616dd87f60b99d8843058366304e2b9f2475eb57 Author: Duncan Coutts Date: Thu Aug 28 05:24:04 2014 +0100 Fix a few minor issues spotted in code review >--------------------------------------------------------------- 616dd87f60b99d8843058366304e2b9f2475eb57 compiler/main/PackageConfig.hs | 0 compiler/main/Packages.lhs | 3 ++- utils/ghc-pkg/Main.hs | 3 +-- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 37ddd84..01c75c0 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -1363,7 +1363,8 @@ add_package pkg_db ipid_map ps (p, mb_parent) | Just pid <- Map.lookup ipid ipid_map = add_package pkg_db ipid_map ps (pid, Just p) | otherwise - = Failed (missingPackageMsg ipid <> missingDependencyMsg mb_parent) + = Failed (missingPackageMsg ipid + <> missingDependencyMsg mb_parent) missingPackageErr :: Outputable pkgid => DynFlags -> pkgid -> IO a missingPackageErr dflags p diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index fdb255a..ac958da 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -57,7 +57,6 @@ import Control.Concurrent import qualified Data.ByteString.Char8 as BS import Data.Binary as Bin ---import qualified Data.Binary.Get as Bin #if defined(mingw32_HOST_OS) -- mingw32 needs these for getExecDir @@ -2141,4 +2140,4 @@ instance Binary PackageKey where case n of 0 -> do a <- get; b <- get; c <- get; return (PackageKey a b c) 1 -> do a <- get; return (OldPackageKey a) - _ -> error ("Binary PackageKey: bad branch " ++ show n) + _ -> fail ("Binary PackageKey: bad branch " ++ show n) From git at git.haskell.org Fri Aug 29 14:04:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:04:31 +0000 (UTC) Subject: [commit: ghc] master: Change testsuite to not use old-style file package databases (da72898) Message-ID: <20140829140431.827D924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/da7289882610ccae3f16c74be7440d19c29ecd20/ghc >--------------------------------------------------------------- commit da7289882610ccae3f16c74be7440d19c29ecd20 Author: Duncan Coutts Date: Wed Aug 27 16:33:20 2014 +0100 Change testsuite to not use old-style file package databases Now uses ghc-pkg init. The file-style databases are no longer supported. >--------------------------------------------------------------- da7289882610ccae3f16c74be7440d19c29ecd20 testsuite/tests/driver/T1372/Makefile | 4 ++-- testsuite/tests/driver/T3007/Makefile | 4 ++-- testsuite/tests/ghci/linking/Makefile | 6 +++--- testsuite/tests/plugins/simple-plugin/Makefile | 2 +- testsuite/tests/rename/prog006/Makefile | 3 ++- testsuite/tests/simplCore/should_compile/T7702plugin/Makefile | 2 +- testsuite/tests/typecheck/bug1465/Makefile | 4 ++-- 7 files changed, 13 insertions(+), 12 deletions(-) diff --git a/testsuite/tests/driver/T1372/Makefile b/testsuite/tests/driver/T1372/Makefile index 91ef6d5..acd6b66 100644 --- a/testsuite/tests/driver/T1372/Makefile +++ b/testsuite/tests/driver/T1372/Makefile @@ -15,7 +15,7 @@ clean: rm -f *.o *.hi rm -f clean.out prep.out rm -f p1/A.hs - rm -f $(LOCAL_PKGCONF) + rm -rf $(LOCAL_PKGCONF) T1372: $(MAKE) clean @@ -26,7 +26,7 @@ T1372: $(MAKE) clean prep: - echo "[]" >$(LOCAL_PKGCONF) + "$(GHC_PKG)" init $(LOCAL_PKGCONF) cp p1/A1.hs p1/A.hs $(MAKE) prep.p1 $(MAKE) prep.p2 diff --git a/testsuite/tests/driver/T3007/Makefile b/testsuite/tests/driver/T3007/Makefile index 7161225..8b78a49 100644 --- a/testsuite/tests/driver/T3007/Makefile +++ b/testsuite/tests/driver/T3007/Makefile @@ -6,11 +6,11 @@ clean: rm -f A/Setup A/Setup.o A/Setup.hi rm -f B/Setup B/Setup.o B/Setup.hi rm -rf A/dist B/dist - rm -f package.conf + rm -rf package.conf T3007: $(MAKE) clean - echo '[]' > package.conf + '$(GHC_PKG)' init package.conf cd A && '$(TEST_HC)' -v0 --make Setup cd A && ./Setup configure -v0 --with-compiler='$(TEST_HC)' --ghc-pkg-option=--global-package-db=../package.conf --ghc-option=-package-db../package.conf cd A && ./Setup build -v0 diff --git a/testsuite/tests/ghci/linking/Makefile b/testsuite/tests/ghci/linking/Makefile index 08c5158..5b8e23c 100644 --- a/testsuite/tests/ghci/linking/Makefile +++ b/testsuite/tests/ghci/linking/Makefile @@ -63,7 +63,7 @@ ghcilink004 : echo 'key: test-1.0' >>$(PKG004) echo 'library-dirs: $${pkgroot}' >>$(PKG004) echo 'extra-libraries: foo' >>$(PKG004) - echo '[]' >$(LOCAL_PKGCONF004) + '$(GHC_PKG)' init $(LOCAL_PKGCONF004) '$(GHC_PKG)' --no-user-package-db -f $(LOCAL_PKGCONF004) register $(PKG004) -v0 # "$(TEST_HC)" -c f.c -o dir004/foo.o @@ -91,7 +91,7 @@ ghcilink005 : echo 'key: test-1.0' >>$(PKG005) echo 'library-dirs: $${pkgroot}' >>$(PKG005) echo 'extra-libraries: foo' >>$(PKG005) - echo '[]' >$(LOCAL_PKGCONF005) + '$(GHC_PKG)' init $(LOCAL_PKGCONF005) '$(GHC_PKG)' --no-user-package-db -f $(LOCAL_PKGCONF005) register $(PKG005) -v0 # "$(TEST_HC)" -c -dynamic f.c -o dir005/foo.o @@ -115,7 +115,7 @@ ghcilink006 : echo "id: test-XXX" >>$(PKG006) echo "key: test-1.0" >>$(PKG006) echo "extra-libraries: stdc++" >>$(PKG006) - echo "[]" >$(LOCAL_PKGCONF006) + '$(GHC_PKG)' init $(LOCAL_PKGCONF006) '$(GHC_PKG)' --no-user-package-db -f $(LOCAL_PKGCONF006) register $(PKG006) -v0 # echo ":q" | "$(TEST_HC)" --interactive -ignore-dot-ghci -v0 -package-db $(LOCAL_PKGCONF006) -package test diff --git a/testsuite/tests/plugins/simple-plugin/Makefile b/testsuite/tests/plugins/simple-plugin/Makefile index 17588bf..eb7cc6a 100644 --- a/testsuite/tests/plugins/simple-plugin/Makefile +++ b/testsuite/tests/plugins/simple-plugin/Makefile @@ -13,7 +13,7 @@ package.%: mkdir pkg.$* "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs - echo "[]" > pkg.$*/local.package.conf + "$(GHC_PKG)" init pkg.$*/local.package.conf pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf pkg.$*/setup build --distdir pkg.$*/dist -v0 diff --git a/testsuite/tests/rename/prog006/Makefile b/testsuite/tests/rename/prog006/Makefile index 4124fec..e5d35e1 100644 --- a/testsuite/tests/rename/prog006/Makefile +++ b/testsuite/tests/rename/prog006/Makefile @@ -36,7 +36,8 @@ rn.prog006: echo "key: test-1.0" >>pkg.conf echo "import-dirs: `./pwd`" >>pkg.conf echo "exposed-modules: B.C" >>pkg.conf - echo "[]" >$(LOCAL_PKGCONF) + rm -rf $(LOCAL_PKGCONF) + $(GHC_PKG) init $(LOCAL_PKGCONF) $(LOCAL_GHC_PKG) register pkg.conf -v0 '$(TEST_HC)' $(TEST_HC_OPTS) -c -package-db $(LOCAL_PKGCONF) -package test -fforce-recomp A.hs -i # The -i clears the search path, so A.hs will find B.C from package test diff --git a/testsuite/tests/simplCore/should_compile/T7702plugin/Makefile b/testsuite/tests/simplCore/should_compile/T7702plugin/Makefile index 42c56c9..beba0dd 100644 --- a/testsuite/tests/simplCore/should_compile/T7702plugin/Makefile +++ b/testsuite/tests/simplCore/should_compile/T7702plugin/Makefile @@ -13,7 +13,7 @@ package.%: mkdir pkg.$* "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs - echo "[]" > pkg.$*/local.package.conf + "$(GHC_PKG)" init pkg.$*/local.package.conf pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf pkg.$*/setup build --distdir pkg.$*/dist -v0 diff --git a/testsuite/tests/typecheck/bug1465/Makefile b/testsuite/tests/typecheck/bug1465/Makefile index c082cb6..78cdd51 100644 --- a/testsuite/tests/typecheck/bug1465/Makefile +++ b/testsuite/tests/typecheck/bug1465/Makefile @@ -11,7 +11,7 @@ clean: rm -f v2/setup v2/Setup.o v2/Setup.hi rm -rf v1/dist v2/dist rm -f *.o *.hi - rm -f $(LOCAL_PKGCONF) + rm -rf $(LOCAL_PKGCONF) bug1465: $(MAKE) clean @@ -20,7 +20,7 @@ bug1465: $(MAKE) clean prep: - echo "[]" >$(LOCAL_PKGCONF) + '$(GHC_PKG)' init $(LOCAL_PKGCONF) $(MAKE) prep.v1 $(MAKE) prep.v2 '$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(LOCAL_PKGCONF) -c -package $(PKG)-1.0 B1.hs From git at git.haskell.org Fri Aug 29 14:04:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:04:34 +0000 (UTC) Subject: [commit: ghc] master: Fix failing test on BINDIST=YES (020bd49) Message-ID: <20140829140434.7E72124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/020bd49a4b55d6e354c5df9f67455fac1991fbe1/ghc >--------------------------------------------------------------- commit 020bd49a4b55d6e354c5df9f67455fac1991fbe1 Author: Edward Z. Yang Date: Fri Aug 29 13:35:09 2014 +0100 Fix failing test on BINDIST=YES Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 020bd49a4b55d6e354c5df9f67455fac1991fbe1 testsuite/tests/rename/prog006/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/rename/prog006/Makefile b/testsuite/tests/rename/prog006/Makefile index e5d35e1..41c33c8 100644 --- a/testsuite/tests/rename/prog006/Makefile +++ b/testsuite/tests/rename/prog006/Makefile @@ -37,7 +37,7 @@ rn.prog006: echo "import-dirs: `./pwd`" >>pkg.conf echo "exposed-modules: B.C" >>pkg.conf rm -rf $(LOCAL_PKGCONF) - $(GHC_PKG) init $(LOCAL_PKGCONF) + '$(GHC_PKG)' init $(LOCAL_PKGCONF) $(LOCAL_GHC_PKG) register pkg.conf -v0 '$(TEST_HC)' $(TEST_HC_OPTS) -c -package-db $(LOCAL_PKGCONF) -package test -fforce-recomp A.hs -i # The -i clears the search path, so A.hs will find B.C from package test From git at git.haskell.org Fri Aug 29 14:08:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:08:31 +0000 (UTC) Subject: [commit: ghc] wip/cabal-head-updates: Update to Cabal head, update ghc-pkg to use new module re-export types (efb4375) Message-ID: <20140829140831.0FCAE24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/cabal-head-updates Link : http://ghc.haskell.org/trac/ghc/changeset/efb43758065f5311a51b12a6f8126c008aade5a7/ghc >--------------------------------------------------------------- commit efb43758065f5311a51b12a6f8126c008aade5a7 Author: Duncan Coutts Date: Fri Aug 29 13:53:52 2014 +0100 Update to Cabal head, update ghc-pkg to use new module re-export types The main change is that Cabal changed the representation of module re-exports to distinguish reexports in source .cabal files versus re-exports in installed package registraion files. Cabal now also does the resolution of re-exports to specific installed packages itself, so ghc-pkg no longer has to do this. This is a cleaner design overall because re-export resolution can fail so it is better to do it during package configuration rather than package registration. It also simplifies the re-export representation that ghc-pkg has to use. >--------------------------------------------------------------- efb43758065f5311a51b12a6f8126c008aade5a7 libraries/Cabal | 2 +- utils/ghc-cabal/Main.hs | 12 +++----- utils/ghc-pkg/Main.hs | 82 +++++++++++++------------------------------------ 3 files changed, 28 insertions(+), 68 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 8d59dc9..2ce3838 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 8d59dc9fba584a9fdb810f4d84f7f3ccb089dd08 +Subproject commit 2ce3838f97f66f03e952333f8c23129f00ebf6cb diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs index 47eb1de..fc97111 100644 --- a/utils/ghc-cabal/Main.hs +++ b/utils/ghc-cabal/Main.hs @@ -346,13 +346,11 @@ generate directory distdir dll0Modules config_args withLibLBI pd lbi $ \lib clbi -> do cwd <- getCurrentDirectory let ipid = InstalledPackageId (display (packageId pd) ++ "-inplace") - let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir - pd lib lbi clbi - final_ipi = installedPkgInfo { - Installed.installedPackageId = ipid, - Installed.haddockHTMLs = [] - } - content = Installed.showInstalledPackageInfo final_ipi ++ "\n" + let installedPkgInfo = (inplaceInstalledPackageInfo cwd distdir + pd ipid lib lbi clbi) + { Installed.haddockHTMLs = [] } + content = Installed.showInstalledPackageInfo installedPkgInfo + ++ "\n" writeFileAtomic (distdir "inplace-pkg-config") (BS.pack $ toUTF8 content) let diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index ac958da..4d4f8e9 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -20,8 +20,7 @@ import Distribution.InstalledPackageInfo as Cabal import Distribution.License import Distribution.Compat.ReadP hiding (get) import Distribution.ParseUtils -import Distribution.ModuleExport -import Distribution.Package hiding (depends) +import Distribution.Package hiding (depends, installedPackageId) import Distribution.Text import Distribution.Version import Distribution.Simple.Utils (fromUTF8, toUTF8) @@ -38,8 +37,6 @@ import System.Console.GetOpt import qualified Control.Exception as Exception import Data.Maybe -import qualified Data.Set as Set - import Data.Char ( isSpace, toLower ) import Data.Ord (comparing) import Control.Applicative (Applicative(..)) @@ -899,9 +896,6 @@ registerPackage input verbosity my_flags auto_ghci_libs multi_instance validatePackageConfig pkg_expanded verbosity truncated_stack auto_ghci_libs multi_instance update force - -- postprocess the package - pkg' <- resolveReexports truncated_stack pkg - let -- In the normal mode, we only allow one version of each package, so we -- remove all instances with the same source package id as the one we're @@ -912,7 +906,7 @@ registerPackage input verbosity my_flags auto_ghci_libs multi_instance p <- packages db_to_operate_on, sourcePackageId p == sourcePackageId pkg ] -- - changeDB verbosity (removes ++ [AddPackage pkg']) db_to_operate_on + changeDB verbosity (removes ++ [AddPackage pkg]) db_to_operate_on parsePackageInfo :: String @@ -935,47 +929,6 @@ mungePackageInfo ipi = ipi { packageKey = packageKey' } = OldPackageKey (sourcePackageId ipi) | otherwise = packageKey ipi --- | Takes the "reexported-modules" field of an InstalledPackageInfo --- and resolves the references so they point to the original exporter --- of a module (i.e. the module is in exposed-modules, not --- reexported-modules). This is done by maintaining an invariant on --- the installed package database that a reexported-module field always --- points to the original exporter. -resolveReexports :: PackageDBStack - -> InstalledPackageInfo - -> IO InstalledPackageInfo -resolveReexports db_stack pkg = do - let dep_mask = Set.fromList (depends pkg) - deps = filter (flip Set.member dep_mask . installedPackageId) - (allPackagesInStack db_stack) - matchExposed pkg_dep m = map ((,) (installedPackageId pkg_dep)) - (filter (==m) (exposedModules pkg_dep)) - worker ModuleExport{ exportOrigPackageName = Just pnm } pkg_dep - | pnm /= packageName (sourcePackageId pkg_dep) = [] - -- Now, either the package matches, *or* we were asked to search the - -- true location ourselves. - worker ModuleExport{ exportOrigName = m } pkg_dep = - matchExposed pkg_dep m ++ - map (fromMaybe (error $ "Impossible! Missing true location in " ++ - display (installedPackageId pkg_dep)) - . exportCachedTrueOrig) - (filter ((==m) . exportName) (reexportedModules pkg_dep)) - self_reexports ModuleExport{ exportOrigPackageName = Just pnm } - | pnm /= packageName (sourcePackageId pkg) = [] - self_reexports ModuleExport{ exportName = m', exportOrigName = m } - -- Self-reexport without renaming doesn't make sense - | m == m' = [] - -- *Only* match against exposed modules! - | otherwise = matchExposed pkg m - - r <- forM (reexportedModules pkg) $ \me -> do - case nub (concatMap (worker me) deps ++ self_reexports me) of - [c] -> return me { exportCachedTrueOrig = Just c } - [] -> die $ "Couldn't resolve reexport " ++ display me - cs -> die $ "Found multiple possible ways to resolve reexport " ++ - display me ++ ": " ++ show cs - return (pkg { reexportedModules = r }) - -- ----------------------------------------------------------------------------- -- Making changes to a package database @@ -1068,16 +1021,25 @@ convertPackageInfoToCacheFormat pkg = GhcPkg.haddockHTMLs = haddockHTMLs pkg, GhcPkg.exposedModules = exposedModules pkg, GhcPkg.hiddenModules = hiddenModules pkg, - GhcPkg.reexportedModules = [ GhcPkg.ModuleExport m ipid' m' - | ModuleExport { - exportName = m, - exportCachedTrueOrig = - Just (InstalledPackageId ipid', m') - } <- reexportedModules pkg - ], + GhcPkg.reexportedModules = map convertModuleReexport + (reexportedModules pkg), GhcPkg.exposed = exposed pkg, GhcPkg.trusted = trusted pkg } + where + convertModuleReexport :: ModuleReexport + -> GhcPkg.ModuleExport String ModuleName + convertModuleReexport + ModuleReexport { + moduleReexportName = m, + moduleReexportDefiningPackage = ipid', + moduleReexportDefiningName = m' + } + = GhcPkg.ModuleExport { + exportModuleName = m, + exportOriginalPackageId = display ipid', + exportOriginalModuleName = m' + } instance GhcPkg.BinaryStringRep ModuleName where fromStringRep = ModuleName.fromString . fromUTF8 . BS.unpack @@ -2128,10 +2090,10 @@ instance Binary ModuleName where put = put . display get = fmap ModuleName.fromString get -instance Binary m => Binary (ModuleExport m) where - put (ModuleExport a b c d) = do put a; put b; put c; put d - get = do a <- get; b <- get; c <- get; d <- get; - return (ModuleExport a b c d) +instance Binary ModuleReexport where + put (ModuleReexport a b c) = do put a; put b; put c + get = do a <- get; b <- get; c <- get + return (ModuleReexport a b c) instance Binary PackageKey where put (PackageKey a b c) = do putWord8 0; put a; put b; put c From git at git.haskell.org Fri Aug 29 14:08:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:08:33 +0000 (UTC) Subject: [commit: ghc] wip/cabal-head-updates: Add extra ghc-pkg sanity check for module re-exports and duplicates (7efde4c) Message-ID: <20140829140833.9969924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/cabal-head-updates Link : http://ghc.haskell.org/trac/ghc/changeset/7efde4c1d6433eab349ab38ffa8540c21af3f796/ghc >--------------------------------------------------------------- commit 7efde4c1d6433eab349ab38ffa8540c21af3f796 Author: Duncan Coutts Date: Fri Aug 29 14:00:57 2014 +0100 Add extra ghc-pkg sanity check for module re-exports and duplicates For re-exports, check that the defining package exists and that it exposes the defining module (or for self-rexport exposed or hidden modules). Also check that the defining package is actually a direct or indirect dependency of the package doing the re-exporting. Also add a check for duplicate modules in a package, including re-exported modules. >--------------------------------------------------------------- 7efde4c1d6433eab349ab38ffa8540c21af3f796 utils/ghc-pkg/Main.hs | 66 +++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 62 insertions(+), 4 deletions(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 4d4f8e9..f063db4 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -14,6 +14,7 @@ module Main (main) where import Version ( version, targetOS, targetARCH ) import qualified GHC.PackageDb as GhcPkg import qualified Distribution.Simple.PackageIndex as PackageIndex +import qualified Data.Graph as Graph import qualified Distribution.ModuleName as ModuleName import Distribution.ModuleName (ModuleName) import Distribution.InstalledPackageInfo as Cabal @@ -1519,7 +1520,9 @@ checkPackageConfig pkg verbosity db_stack auto_ghci_libs mapM_ (checkDir True "framework-dirs") (frameworkDirs pkg) mapM_ (checkFile True "haddock-interfaces") (haddockInterfaces pkg) mapM_ (checkDirURL True "haddock-html") (haddockHTMLs pkg) - checkModules pkg + checkDuplicateModules pkg + checkModuleFiles pkg + checkModuleReexports db_stack pkg mapM_ (checkHSLib verbosity (libraryDirs pkg) auto_ghci_libs) (hsLibraries pkg) -- ToDo: check these somehow? -- extra_libraries :: [String], @@ -1653,9 +1656,8 @@ doesFileExistOnPath filenames paths = go fullFilenames go ((p, fp) : xs) = do b <- doesFileExist fp if b then return (Just p) else go xs --- XXX maybe should check reexportedModules too -checkModules :: InstalledPackageInfo -> Validate () -checkModules pkg = do +checkModuleFiles :: InstalledPackageInfo -> Validate () +checkModuleFiles pkg = do mapM_ findModule (exposedModules pkg ++ hiddenModules pkg) where findModule modl = @@ -1667,6 +1669,62 @@ checkModules pkg = do when (isNothing m) $ verror ForceFiles ("cannot find any of " ++ show files) +checkDuplicateModules :: InstalledPackageInfo -> Validate () +checkDuplicateModules pkg + | null dups = return () + | otherwise = verror ForceAll ("package has duplicate modules: " ++ + unwords (map display dups)) + where + dups = [ m | (m:_:_) <- group (sort mods) ] + mods = exposedModules pkg ++ hiddenModules pkg + ++ map moduleReexportName (reexportedModules pkg) + +checkModuleReexports :: PackageDBStack -> InstalledPackageInfo -> Validate () +checkModuleReexports db_stack pkg = + mapM_ checkReexport (reexportedModules pkg) + where + all_pkgs = allPackagesInStack db_stack + ipix = PackageIndex.fromList all_pkgs + + checkReexport ModuleReexport { + moduleReexportDefiningPackage = definingPkgId, + moduleReexportDefiningName = definingModule + } = case PackageIndex.lookupInstalledPackageId ipix definingPkgId of + Nothing + -> verror ForceAll ("module re-export refers to a non-existant " ++ + "(or not visible) defining package: " ++ + display definingPkgId) + + Just definingPkg + | not (isIndirectDependency definingPkgId) + -> verror ForceAll ("module re-export refers to a defining " ++ + "package that is not a direct (or indirect) " ++ + "dependency of this package: " ++ + display definingPkgId) + + | definingPkgId == installedPackageId pkg + && definingModule `notElem` (exposedModules definingPkg + ++ hiddenModules definingPkg) + -> verror ForceAll ("module (self) re-export refers to a module " ++ + "that is not defined in this package " ++ + display definingModule) + + | definingPkgId /= installedPackageId pkg + && definingModule `notElem` exposedModules definingPkg + -> verror ForceAll ("module re-export refers to a module that is " ++ + "not exposed by the defining package " ++ + display definingModule) + + | otherwise + -> return () + + isIndirectDependency pkgid = fromMaybe False $ do + thispkg <- graphVertex (installedPackageId pkg) + otherpkg <- graphVertex pkgid + return (Graph.path depgraph thispkg otherpkg) + (depgraph, _, graphVertex) = PackageIndex.dependencyGraph ipix + + checkGHCiLib :: Verbosity -> String -> String -> String -> Bool -> IO () checkGHCiLib verbosity batch_lib_dir batch_lib_file lib auto_build | auto_build = autoBuildGHCiLib verbosity batch_lib_dir batch_lib_file ghci_lib_file From git at git.haskell.org Fri Aug 29 14:08:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:08:35 +0000 (UTC) Subject: [commit: ghc] wip/cabal-head-updates's head updated: Add extra ghc-pkg sanity check for module re-exports and duplicates (7efde4c) Message-ID: <20140829140835.D45E224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/cabal-head-updates' now includes: d333c03 Enable GHC API tests by default. ff9f4ad testsuite: T7815 requires SMP support from ghc fcdd58d testsuite: disable gcc's warnings about casts of incompatible prototypes in UNREG eb64be7 testsuite: disable memcpy asm comparison tests on UNREG 2fcb36e testsuite: mark testwsdeque mark as faulty on NOSMP builds 104a66a rts/Linker.c: declare 'deRefStablePtr' as an exported 'rts' symbol cfd08a9 Add MO_AddIntC, MO_SubIntC MachOps and implement in X86 backend e1d77a1 testsuite: added 'bytes allocated' for T9339 wordsize(32) 78ba9f0 Declare official GitHub home of libraries/{directory,process} 5295cd2 testsuite: add 16-byte case for T9329 9f8754e Use DumpStyle rather than UserStyle for pprTrace output c0fe1d9 Introduce the Call data types af4bc31 Do not duplicate call information in SpecConstr (Trac #8852) 5c4df28 More refactoring in SpecConstr 8ff4671 Make Core Lint check for un-saturated type applications ee4501b Check for un-saturated type family applications 06600e7 Two buglets in record wild-cards (Trac #9436 and #9437) 67a6ade Improve documentation of record wildcards 43f1b2e UNREG: fix emission of large Integer literals in C codegen a93ab43 driver: pass '-fPIC' option to assembler as well 78863ed Revert "disable shared libs on sparc (linux/solaris) (fixes #8857)" e9cd1d5 Less voluminous output when printing continuations 6e0f6ed Refactor unfoldings 3af1adf Kill unused setUnfoldingTemplate 8f09937 Make maybeUnfoldingTemplate respond to DFunUnfoldings 9cf5906 Make worker/wrapper work on INLINEABLE things 4c03791 Specialise Eq, Ord, Read, Show at Int, Char, String 3436333 Move the Enum Word instance into GHC.Enum 949ad67 Don't float out (classop dict e1 e2) 2ef997b Slightly improve fusion rules for 'take' 99178c1 Specialise monad functions, and make them INLINEABLE baa3c9a Wibbles to "...plus N others" error message about instances in scope a3e207f More SPEC rules fire dce7095 Compiler performance increases -- yay! b9e49d3 Add -fspecialise-aggressively fa582cc Fix an egregious bug in the NonRec case of bindFreeVars 6d48ce2 Make tidyProgram discard speculative specialisation rules 86a2ebf Comments only 1122857 Run float-inwards immediately before the strictness analyser. 082e41b Testsuite wibbles bb87726 Performance changes a0b2897 Simple refactor of the case-of-case transform 6c6b001 Remove dead lookup_dfun_id (merge-o) 39ccdf9 White space only a1a400e Testsuite wibbles 1145568 testsuite: disable T367_letnoescape on 'optllvm' 75d998b testsuite: disable 'rdynamic' for 'ghci' way 94926b1 Add an interesting type-family/GADT example of deletion for red-black trees 87c1568 Comments only b7bdf13 Temporary fix to the crash aa49892 [ci skip] ghc-prim: Update .gitignore 8270ff3 [ci skip] Update .gitignore 9072f2f PprC: cleanup: don't emit 'FB_' / 'FE_' in via-C 49370ce Improve trimming of auto-rules 4a87142 Fix syntax in perf/compiler/all.T 7eae141 White space only 2da63c6 Better compiler performance (30% less allocation) for T783! dfc9d30 Define mapUnionVarSet, and use it 8df3159 Rename red-black test in indexed-types to red-black-delete db5868c In GHC.Real, specialise 'even' and 'odd' to Int and Integer 9fae691 Improve "specImport discarding" message b2affa0 Testsuite wibbles 69e9f6e Simplify conversion in binary serialisation of ghc-pkg db 557c8b8 Drop support for single-file style package databases ce29a26 Improve the ghc-pkg warnings for missing and out of date package cache files 8d7a1dc Introduce new file format for the package database binary cache 27d6c08 Use ghc-local types for packages, rather than Cabal types 0af7d0c Move Cabal Binary instances from bin-package-db to ghc-pkg itself 9597a25 Drop ghc library dep on Cabal 227205e Make binary a boot package 6930a88 Fix warnings arising from the package db refactoring 29f84d3 Fix long lines and trailing whitespace 8955b5e Remove a TODO that is now done a4cb9a6 Add a ghc -show-packages mode to display ghc's view of the package env 1bc2a55 Make mkFastStringByteString pure and fix up uses c72efd7 Switch the package id types to use FastString (rather than String) b00deb7 Fix string conversions in ghc-pkg to be correct w.r.t. Unicode 42f99e9 Address a number of Edward's code review comments 9d6fbcc Fix validation error in Linker arising from package rep changes 01461ce Update Cabal and haddock submodules to follow the Canal-dep removal changes da72898 Change testsuite to not use old-style file package databases 616dd87 Fix a few minor issues spotted in code review 6d8c70c Add release notes about ghc-pkg change, and Cabal dep removal 020bd49 Fix failing test on BINDIST=YES efb4375 Update to Cabal head, update ghc-pkg to use new module re-export types 7efde4c Add extra ghc-pkg sanity check for module re-exports and duplicates From git at git.haskell.org Fri Aug 29 14:56:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 14:56:38 +0000 (UTC) Subject: [commit: ghc] master: Suppress binary warnings for bootstrapping as well as stage1. (cb2ac47) Message-ID: <20140829145638.92A2224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cb2ac479d58ed8b762611c1b594c00d892e6b796/ghc >--------------------------------------------------------------- commit cb2ac479d58ed8b762611c1b594c00d892e6b796 Author: Edward Z. Yang Date: Fri Aug 29 15:55:59 2014 +0100 Suppress binary warnings for bootstrapping as well as stage1. This was missed when we added binary to the list of boot packages. But note: the warnings binary are *legitimate* and really should be fixed! Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- cb2ac479d58ed8b762611c1b594c00d892e6b796 mk/validate-settings.mk | 1 + 1 file changed, 1 insertion(+) diff --git a/mk/validate-settings.mk b/mk/validate-settings.mk index cac938d..4ccef07 100644 --- a/mk/validate-settings.mk +++ b/mk/validate-settings.mk @@ -117,6 +117,7 @@ libraries/haskeline_dist-install_EXTRA_HC_OPTS += -fno-warn-deprecations libraries/haskeline_dist-install_EXTRA_HC_OPTS += -fno-warn-unused-imports # binary upstream has some warnings, so don't use -Werror for it +libraries/binary_dist-boot_EXTRA_HC_OPTS += -Wwarn libraries/binary_dist-install_EXTRA_HC_OPTS += -Wwarn # temporarily turn off -Werror for mtl From git at git.haskell.org Fri Aug 29 16:09:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 16:09:37 +0000 (UTC) Subject: [commit: ghc] master: Include pattern synonyms as AConLikes in the type environment, even for simplified/boot ModDetails (fixes #9417) (f0db185) Message-ID: <20140829160937.6563F24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f0db1857b053597e9ac43d9ce578e5f5fa0545cb/ghc >--------------------------------------------------------------- commit f0db1857b053597e9ac43d9ce578e5f5fa0545cb Author: Dr. ERDI Gergo Date: Fri Aug 29 21:15:22 2014 +0800 Include pattern synonyms as AConLikes in the type environment, even for simplified/boot ModDetails (fixes #9417) >--------------------------------------------------------------- f0db1857b053597e9ac43d9ce578e5f5fa0545cb compiler/basicTypes/PatSyn.lhs | 8 +------- compiler/main/TidyPgm.lhs | 15 +++++++++------ 2 files changed, 10 insertions(+), 13 deletions(-) diff --git a/compiler/basicTypes/PatSyn.lhs b/compiler/basicTypes/PatSyn.lhs index cba8427..2081b5a 100644 --- a/compiler/basicTypes/PatSyn.lhs +++ b/compiler/basicTypes/PatSyn.lhs @@ -17,7 +17,7 @@ module PatSyn ( patSynWrapper, patSynMatcher, patSynExTyVars, patSynSig, patSynInstArgTys, patSynInstResTy, - tidyPatSynIds, patSynIds + tidyPatSynIds ) where #include "HsVersions.h" @@ -267,12 +267,6 @@ patSynWrapper = psWrapper patSynMatcher :: PatSyn -> Id patSynMatcher = psMatcher -patSynIds :: PatSyn -> [Id] -patSynIds (MkPatSyn { psMatcher = match_id, psWrapper = mb_wrap_id }) - = case mb_wrap_id of - Nothing -> [match_id] - Just wrap_id -> [match_id, wrap_id] - tidyPatSynIds :: (Id -> Id) -> PatSyn -> PatSyn tidyPatSynIds tidy_fn ps@(MkPatSyn { psMatcher = match_id, psWrapper = mb_wrap_id }) = ps { psMatcher = tidy_fn match_id, psWrapper = fmap tidy_fn mb_wrap_id } diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index c92b593..55efca1 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -141,12 +141,12 @@ mkBootModDetailsTc hsc_env ; showPass dflags CoreTidy ; let { insts' = map (tidyClsInstDFun globaliseAndTidyId) insts - ; pat_syns' = map (tidyPatSynIds globaliseAndTidyId) pat_syns - ; dfun_ids = map instanceDFunId insts' - ; pat_syn_ids = concatMap patSynIds pat_syns' ; type_env1 = mkBootTypeEnv (availsToNameSet exports) (typeEnvIds type_env) tcs fam_insts - ; type_env' = extendTypeEnvWithIds type_env1 (pat_syn_ids ++ dfun_ids) + ; pat_syns' = map (tidyPatSynIds globaliseAndTidyId) pat_syns + ; type_env2 = extendTypeEnvWithPatSyns pat_syns' type_env1 + ; dfun_ids = map instanceDFunId insts' + ; type_env' = extendTypeEnvWithIds type_env2 dfun_ids } ; return (ModDetails { md_types = type_env' , md_insts = insts' @@ -357,8 +357,7 @@ tidyProgram hsc_env (ModGuts { mg_module = mod -- This is really the only reason we keep mg_patsyns at all; otherwise -- they could just stay in type_env ; tidy_patsyns = map (tidyPatSynIds (lookup_aux_id tidy_type_env)) patsyns - ; type_env2 = extendTypeEnvList type_env1 - [AConLike (PatSynCon ps) | ps <- tidy_patsyns ] + ; type_env2 = extendTypeEnvWithPatSyns tidy_patsyns type_env1 ; tidy_type_env = tidyTypeEnv omit_prags type_env2 @@ -456,6 +455,10 @@ trimThing (AnId id) trimThing other_thing = other_thing + +extendTypeEnvWithPatSyns :: [PatSyn] -> TypeEnv -> TypeEnv +extendTypeEnvWithPatSyns tidy_patsyns type_env + = extendTypeEnvList type_env [AConLike (PatSynCon ps) | ps <- tidy_patsyns ] \end{code} \begin{code} From git at git.haskell.org Fri Aug 29 16:17:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 16:17:10 +0000 (UTC) Subject: [commit: ghc] master: Comments, white space, and rename "InlineRule" to "stable unfolding" (ab4c27e) Message-ID: <20140829161710.827B024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ab4c27e917e959778726b82fa6cc8b80eca28e74/ghc >--------------------------------------------------------------- commit ab4c27e917e959778726b82fa6cc8b80eca28e74 Author: Simon Peyton Jones Date: Fri Aug 29 15:16:16 2014 +0100 Comments, white space, and rename "InlineRule" to "stable unfolding" The "InlineRule" is gone now, so this is just making the comments line up with the code. A function does change its name though: updModeForInlineRules --> updModeForStableUnfoldings >--------------------------------------------------------------- ab4c27e917e959778726b82fa6cc8b80eca28e74 compiler/simplCore/OccurAnal.lhs | 10 +++---- compiler/simplCore/SimplUtils.lhs | 62 +++++++++++++++++++-------------------- compiler/simplCore/Simplify.lhs | 12 ++++---- compiler/stranal/WorkWrap.lhs | 4 +-- 4 files changed, 44 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 ab4c27e917e959778726b82fa6cc8b80eca28e74 From git at git.haskell.org Fri Aug 29 16:17:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 16:17:12 +0000 (UTC) Subject: [commit: ghc] master: Fix a bug in CSE, for INLINE/INLNEABLE things (4e0e774) Message-ID: <20140829161712.E561724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4e0e7746344ca684af3dde216fa95a76df380cf1/ghc >--------------------------------------------------------------- commit 4e0e7746344ca684af3dde216fa95a76df380cf1 Author: Simon Peyton Jones Date: Fri Aug 29 15:11:19 2014 +0100 Fix a bug in CSE, for INLINE/INLNEABLE things Previusly we simply weren't doing CSE at all on things whose unfolding were not always-active, for reasons explained in Note [CSE for INLINE and NOINLINE]. But that was bad! Making something INLNEABLE meant that its RHS was no longer CSE'd, and that made some nofib programs worse. And it's entirely unnecessary. I thoguht it through again, wrote new comments (under the same Note), and things are better again. >--------------------------------------------------------------- 4e0e7746344ca684af3dde216fa95a76df380cf1 compiler/simplCore/CSE.lhs | 84 ++++++++++++++++++++++------------------------ 1 file changed, 40 insertions(+), 44 deletions(-) diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs index 9071573..f47c89b 100644 --- a/compiler/simplCore/CSE.lhs +++ b/compiler/simplCore/CSE.lhs @@ -90,26 +90,16 @@ to the substitution Note [CSE for INLINE and NOINLINE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We are careful to do no CSE inside functions that the user has marked as -INLINE or NOINLINE. In terms of Core, that means +We are careful to with CSE inside functions that the user has marked as +INLINE or NOINLINE. (Examples from Roman Leshchinskiy.) Consider - a) we do not do CSE inside an InlineRule - - b) we do not do CSE on the RHS of a binding b=e - unless b's InlinePragma is AlwaysActive - -Here's why (examples from Roman Leshchinskiy). Consider - - yes :: Int - {-# NOINLINE yes #-} + yes :: Int {-# NOINLINE yes #-} yes = undefined - no :: Int - {-# NOINLINE no #-} + no :: Int {-# NOINLINE no #-} no = undefined - foo :: Int -> Int -> Int - {-# NOINLINE foo #-} + foo :: Int -> Int -> Int {-# NOINLINE foo #-} foo m n = n {-# RULES "foo/no" foo no = id #-} @@ -117,35 +107,36 @@ Here's why (examples from Roman Leshchinskiy). Consider bar :: Int -> Int bar = foo yes -We do not expect the rule to fire. But if we do CSE, then we get -yes=no, and the rule does fire. Worse, whether we get yes=no or -no=yes depends on the order of the definitions. +We do not expect the rule to fire. But if we do CSE, then we risk +getting yes=no, and the rule does fire. Actually, it won't becuase +NOINLINE means that 'yes' will never be inlined, not even if we have +yes=no. So that's fine (now; perhpas in the olden days, yes=no would +have substituted even if 'yes' was NOINLINE. -In general, CSE should probably never touch things with INLINE pragmas -as this could lead to surprising results. Consider - - {-# INLINE foo #-} - foo = +But we do need to take care. Consider {-# NOINLINE bar #-} bar = -- Same rhs as foo + foo = + If CSE produces foo = bar -then foo will never be inlined (when it should be); but if it produces - bar = foo -bar will be inlined (when it should not be). Even if we remove INLINE foo, -we'd still like foo to be inlined if rhs is small. This won't happen -with foo = bar. - -Not CSE-ing inside INLINE also solves an annoying bug in CSE. Consider -a worker/wrapper, in which the worker has turned into a single variable: - $wf = h - f = \x -> ...$wf... -Now CSE may transform to - f = \x -> ...h... -But the WorkerInfo for f still says $wf, which is now dead! This won't -happen now that we don't look inside INLINEs (which wrappers are). +then foo will never be inlined to (when it should be, if +is small). The conclusion here is this: + + We should not add + :-> bar + to the CSEnv if 'bar' has any constraints on when it can inline; + that is, if its 'activation' not always active. Otherwise we + might replace by 'bar', and then later be unable to see that it + really was . + +Note that we do not (currently) do CSE on the unfolding stored inside +an Id, even if is a 'stable' unfolding. That means that when an +unfolding happens, it is always faithful to what the stable unfolding +originally was. + Note [CSE for case expressions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -188,8 +179,12 @@ cseBind env (Rec pairs) cseRhs :: CSEnv -> (OutBndr, InExpr) -> (CSEnv, OutExpr) cseRhs env (id',rhs) = case lookupCSEnv env rhs' of - Nothing -> (extendCSEnv env rhs' id', rhs') - Just id -> (extendCSSubst env id' id, Var id) + Nothing + | always_active -> (extendCSEnv env rhs' id', rhs') + | otherwise -> (env, rhs') + Just id + | always_active -> (extendCSSubst env id' id, Var id) + | otherwise -> (env, Var id) -- In the Just case, we have -- x = rhs -- ... @@ -199,9 +194,10 @@ cseRhs env (id',rhs) -- that subsequent uses of x' are replaced with x, -- See Trac #5996 where - rhs' | isAlwaysActive (idInlineActivation id') = cseExpr env rhs - | otherwise = rhs - -- See Note [CSE for INLINE and NOINLINE] + rhs' = cseExpr env rhs + + always_active = isAlwaysActive (idInlineActivation id') + -- See Note [CSE for INLINE and NOINLINE] tryForCSE :: CSEnv -> InExpr -> OutExpr tryForCSE env expr @@ -259,8 +255,8 @@ cseAlts env scrut' bndr bndr' alts = (DataAlt con, args', tryForCSE new_env rhs) where (env', args') = addBinders alt_env args - new_env = extendCSEnv env' (mkAltExpr (DataAlt con) args' arg_tys) - con_target + new_env = extendCSEnv env' con_expr con_target + con_expr = mkAltExpr (DataAlt con) args' arg_tys cse_alt (con, args, rhs) = (con, args', tryForCSE env' rhs) From git at git.haskell.org Fri Aug 29 16:17:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 16:17:15 +0000 (UTC) Subject: [commit: ghc] master: Better specImport discarding message (again) (7af33e9) Message-ID: <20140829161715.C5A0B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7af33e9ab43bb46d7ddb53193884d5bed11a12a9/ghc >--------------------------------------------------------------- commit 7af33e9ab43bb46d7ddb53193884d5bed11a12a9 Author: Simon Peyton Jones Date: Fri Aug 29 15:28:15 2014 +0100 Better specImport discarding message (again) >--------------------------------------------------------------- 7af33e9ab43bb46d7ddb53193884d5bed11a12a9 compiler/specialise/Specialise.lhs | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs index 517f022..cbce63f 100644 --- a/compiler/specialise/Specialise.lhs +++ b/compiler/specialise/Specialise.lhs @@ -643,8 +643,8 @@ specImport dflags this_mod done rb fn calls_for_fn | null calls_for_fn -- We filtered out all the calls in deleteCallsMentioning = return ([], []) - | wantSpecImport dflags fn - , Just rhs <- maybeUnfoldingTemplate (realIdUnfolding fn) + | wantSpecImport dflags unfolding + , Just rhs <- maybeUnfoldingTemplate unfolding = do { -- Get rules from the external package state -- We keep doing this in case we "page-fault in" -- more rules as we go along @@ -669,21 +669,25 @@ specImport dflags this_mod done rb fn calls_for_fn ; return (rules2 ++ rules1, spec_binds2 ++ spec_binds1) } | otherwise - = WARN( True, hang (ptext (sLit "specImport discarding:")) - 2 (vcat (map (pprCallInfo fn) calls_for_fn)) ) + = WARN( True, hang (ptext (sLit "specImport discarding:") <+> ppr fn <+> dcolon <+> ppr (idType fn)) + 2 ( (text "want:" <+> ppr (wantSpecImport dflags unfolding)) + $$ (text "stable:" <+> ppr (isStableUnfolding unfolding)) + $$ (text "calls:" <+> vcat (map (pprCallInfo fn) calls_for_fn)) ) ) return ([], []) + where + unfolding = realIdUnfolding fn -- We want to see the unfolding even for loop breakers -wantSpecImport :: DynFlags -> Id -> Bool +wantSpecImport :: DynFlags -> Unfolding -> Bool -- See Note [Specialise imported INLINABLE things] -wantSpecImport dflags fn - = case idUnfolding fn of +wantSpecImport dflags unf + = case unf of NoUnfolding -> False OtherCon {} -> False DFunUnfolding {} -> True CoreUnfolding { uf_src = src, uf_guidance = _guidance } | gopt Opt_SpecialiseAggressively dflags -> True | isStableSource src -> True - -- Specialise even INILNE things; it hasn't inlined yet, + -- Specialise even INLINE things; it hasn't inlined yet, -- so perhaps it never will. Moreover it may have calls -- inside it that we want to specialise | otherwise -> False -- Stable, not INLINE, hence INLINEABLE @@ -1614,8 +1618,8 @@ instance Outputable CallInfoSet where pprCallInfo :: Id -> CallInfo -> SDoc pprCallInfo fn (CallKey mb_tys, (dxs, _)) - = hang (ppr fn <+> dcolon <+> ppr (idType fn)) - 2 (ptext (sLit "args:") <+> fsep (map ppr_call_key_ty mb_tys ++ map pprParendExpr dxs)) + = hang (ppr fn) + 2 (fsep (map ppr_call_key_ty mb_tys ++ map pprParendExpr dxs)) ppr_call_key_ty :: Maybe Type -> SDoc ppr_call_key_ty Nothing = char '_' From git at git.haskell.org Fri Aug 29 16:17:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 16:17:18 +0000 (UTC) Subject: [commit: ghc] master: When finding loop breakers, distinguish INLINE from INLINEABLE (3521c50) Message-ID: <20140829161718.B33E224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3521c5078dace81b23a72d1e463f9c31d07f3816/ghc >--------------------------------------------------------------- commit 3521c5078dace81b23a72d1e463f9c31d07f3816 Author: Simon Peyton Jones Date: Fri Aug 29 15:18:08 2014 +0100 When finding loop breakers, distinguish INLINE from INLINEABLE Previously INLINE and INLINEABLE were treated identically, but it's crucial that we don't choose a wrapper (INLINE) as a loop breaker, when it is mutually recursive with an INLINEABLE worker. >--------------------------------------------------------------- 3521c5078dace81b23a72d1e463f9c31d07f3816 compiler/coreSyn/CoreSyn.lhs | 17 +++++++++---- compiler/simplCore/OccurAnal.lhs | 55 ++++++++++++++-------------------------- 2 files changed, 31 insertions(+), 41 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index 6627ab0..babece4 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -58,7 +58,7 @@ module CoreSyn ( maybeUnfoldingTemplate, otherCons, isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding, - isStableUnfolding, isStableCoreUnfolding_maybe, + isStableUnfolding, hasStableCoreUnfolding_maybe, isClosedUnfolding, hasSomeUnfolding, canUnfold, neverUnfoldGuidance, isStableSource, @@ -929,10 +929,17 @@ expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs expandUnfolding_maybe _ = Nothing -isStableCoreUnfolding_maybe :: Unfolding -> Maybe UnfoldingSource -isStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src }) - | isStableSource src = Just src -isStableCoreUnfolding_maybe _ = Nothing +hasStableCoreUnfolding_maybe :: Unfolding -> Maybe Bool +-- Just True <=> has stable inlining, very keen to inline (eg. INLINE pragma) +-- Just False <=> has stable inlining, open to inlining it (eg. INLINEABLE pragma) +-- Nothing <=> not table, or cannot inline it anyway +hasStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide }) + | isStableSource src + = case guide of + UnfWhen {} -> Just True + UnfIfGoodArgs {} -> Just False + UnfNever -> Nothing +hasStableCoreUnfolding_maybe _ = Nothing isCompulsoryUnfolding :: Unfolding -> Bool isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs index 7a237c8..ca0fc22 100644 --- a/compiler/simplCore/OccurAnal.lhs +++ b/compiler/simplCore/OccurAnal.lhs @@ -879,13 +879,14 @@ reOrderNodes depth bndr_set weak_fvs (node : nodes) binds | isDFunId bndr = 9 -- Never choose a DFun as a loop breaker -- Note [DFuns should not be loop breakers] - | Just _ <- isStableCoreUnfolding_maybe (idUnfolding bndr) - = 3 -- Note [INLINE pragmas] + | Just be_very_keen <- hasStableCoreUnfolding_maybe (idUnfolding bndr) + = if be_very_keen then 6 -- Note [Loop breakers and INLINE/INLINEABLE pragmas] + else 3 -- Data structures are more important than INLINE pragmas -- so that dictionary/method recursion unravels - -- Note that this case hits all InlineRule things, so we - -- never look at 'rhs' for InlineRule stuff. That's right, because - -- 'rhs' is irrelevant for inlining things with an InlineRule + -- Note that this case hits all stable unfoldings, so we + -- never look at 'rhs' for stable unfoldings. That's right, because + -- 'rhs' is irrelevant for inlining things with a stable unfolding | is_con_app rhs = 5 -- Data types help with cases: Note [Constructor applications] @@ -962,43 +963,25 @@ The RULES stuff means that we can't choose $dm as a loop breaker opInt *and* opBool, and so on. The number of loop breakders is linear in the number of instance declarations. -Note [INLINE pragmas] -~~~~~~~~~~~~~~~~~~~~~ +Note [Loop breakers and INLINE/INLINEABLE pragmas] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Avoid choosing a function with an INLINE pramga as the loop breaker! If such a function is mutually-recursive with a non-INLINE thing, then the latter should be the loop-breaker. - ----> Historical note, dating from when strictness wrappers - were generated from the strictness signatures: +It's vital to distinguish between INLINE and INLINEABLE (the +Bool returned by hasStableCoreUnfolding_maybe). If we start with + Rec { {-# INLINEABLE f #-} + f x = ...f... } +and then worker/wrapper it through strictness analysis, we'll get + Rec { {-# INLINEABLE $wf #-} + $wf p q = let x = (p,q) in ...f... - Usually this is just a question of optimisation. But a particularly - bad case is wrappers generated by the demand analyser: if you make - then into a loop breaker you may get an infinite inlining loop. For - example: - rec { - $wfoo x = ....foo x.... + {-# INLINE f #-} + f x = case x of (p,q) -> $wf p q } - {-loop brk-} foo x = ...$wfoo x... - } - The interface file sees the unfolding for $wfoo, and sees that foo is - strict (and hence it gets an auto-generated wrapper). Result: an - infinite inlining in the importing scope. So be a bit careful if you - change this. A good example is Tree.repTree in - nofib/spectral/minimax. If the repTree wrapper is chosen as the loop - breaker then compiling Game.hs goes into an infinite loop. This - happened when we gave is_con_app a lower score than inline candidates: - - Tree.repTree - = __inline_me (/\a. \w w1 w2 -> - case Tree.$wrepTree @ a w w1 w2 of - { (# ww1, ww2 #) -> Branch @ a ww1 ww2 }) - Tree.$wrepTree - = /\a w w1 w2 -> - (# w2_smP, map a (Tree a) (Tree.repTree a w1 w) (w w2) #) - - Here we do *not* want to choose 'repTree' as the loop breaker. - - -----> End of historical note +Now it is vital that we choose $wf as the loop breaker, so we can +inline 'f' in '$wf'. Note [DFuns should not be loop breakers] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Fri Aug 29 16:17:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 16:17:21 +0000 (UTC) Subject: [commit: ghc] master: Give the worker for an INLINABLE function a suitably-phased Activation (e5f766c) Message-ID: <20140829161723.64CDF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e5f766c392c8c1cb329e1409102b5655c3c253c9/ghc >--------------------------------------------------------------- commit e5f766c392c8c1cb329e1409102b5655c3c253c9 Author: Simon Peyton Jones Date: Fri Aug 29 15:34:19 2014 +0100 Give the worker for an INLINABLE function a suitably-phased Activation See Note [Activation for INLINABLE worker]. This was preventing Trac #6056 from working. >--------------------------------------------------------------- e5f766c392c8c1cb329e1409102b5655c3c253c9 compiler/stranal/WorkWrap.lhs | 54 ++++++++++++---------- .../tests/simplCore/should_compile/T3717.stderr | 3 +- .../tests/simplCore/should_compile/T4908.stderr | 4 +- .../simplCore/should_compile/spec-inline.stderr | 4 +- 4 files changed, 35 insertions(+), 30 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e5f766c392c8c1cb329e1409102b5655c3c253c9 From git at git.haskell.org Fri Aug 29 16:17:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 16:17:25 +0000 (UTC) Subject: [commit: ghc] master: Finally! Test Trac #6056 (3935062) Message-ID: <20140829161725.7C11924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/393506269315bca66aae91517b75e0a003470c84/ghc >--------------------------------------------------------------- commit 393506269315bca66aae91517b75e0a003470c84 Author: Simon Peyton Jones Date: Fri Aug 29 15:37:16 2014 +0100 Finally! Test Trac #6056 >--------------------------------------------------------------- 393506269315bca66aae91517b75e0a003470c84 testsuite/tests/simplCore/should_compile/T6056.hs | 8 ++++++++ .../tests/simplCore/should_compile/T6056.stderr | 20 ++++++++++++++++++++ testsuite/tests/simplCore/should_compile/T6056a.hs | 8 ++++++++ testsuite/tests/simplCore/should_compile/all.T | 1 + 4 files changed, 37 insertions(+) diff --git a/testsuite/tests/simplCore/should_compile/T6056.hs b/testsuite/tests/simplCore/should_compile/T6056.hs new file mode 100644 index 0000000..e24631d --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T6056.hs @@ -0,0 +1,8 @@ +module T6056 where +import T6056a + +foo1 :: Int -> (Maybe Int, [Int]) +foo1 x = smallerAndRest x [x] + +foo2 :: Integer -> (Maybe Integer, [Integer]) +foo2 x = smallerAndRest x [x] diff --git a/testsuite/tests/simplCore/should_compile/T6056.stderr b/testsuite/tests/simplCore/should_compile/T6056.stderr new file mode 100644 index 0000000..10226d8 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T6056.stderr @@ -0,0 +1,20 @@ +Rule fired: foldr/nil +Rule fired: foldr/nil +Rule fired: + SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Integer.Type.Integer +Rule fired: + SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Types.Int +Rule fired: Class op < +Rule fired: Class op < +Rule fired: + SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Integer.Type.Integer +Rule fired: + SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Integer.Type.Integer +Rule fired: + SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Types.Int +Rule fired: + SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Types.Int +Rule fired: + SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Types.Int +Rule fired: + SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Integer.Type.Integer diff --git a/testsuite/tests/simplCore/should_compile/T6056a.hs b/testsuite/tests/simplCore/should_compile/T6056a.hs new file mode 100644 index 0000000..c83f74f --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T6056a.hs @@ -0,0 +1,8 @@ +module T6056a where + +smallerAndRest :: Ord a => a -> [a] -> (Maybe a, [a]) +smallerAndRest x [] = (Nothing, []) +smallerAndRest x (y:ys) | y < x = (Just y, ys) + | otherwise = smallerAndRest x ys + +{-# INLINABLE smallerAndRest #-} diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index d8518f6..88d1022 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -205,3 +205,4 @@ test('T8832', test('T8848', only_ways(['optasm']), compile, ['-ddump-rule-firings -dsuppress-uniques']) test('T8848a', only_ways(['optasm']), compile, ['-ddump-rules']) test('T8331', only_ways(['optasm']), compile, ['-ddump-rules']) +test('T6056', only_ways(['optasm']), multimod_compile, ['T6056', '-v0 -ddump-rule-firings']) From git at git.haskell.org Fri Aug 29 16:17:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 16:17:28 +0000 (UTC) Subject: [commit: ghc] master: Performance improvement of the compiler itself (5da580b) Message-ID: <20140829161728.6BD4F24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5da580beacb0da1f7bf8e300e074e5cad88b8bbc/ghc >--------------------------------------------------------------- commit 5da580beacb0da1f7bf8e300e074e5cad88b8bbc Author: Simon Peyton Jones Date: Fri Aug 29 17:16:36 2014 +0100 Performance improvement of the compiler itself This is a result of one of these, or a combination 002b7a2b * Give the worker for an INLINABLE function a suitably-phased Activation ca666b8b * When finding loop breakers, distinguish INLINE from INLINEABLE a98c9c5e * Fix a bug in CSE, for INLINE/INLNEABLE things Some changes are quite big: for bytes_allocated we have T6048: 13% below expected T5837: 15% below expected T3064: 5% below expected Of course, these might have already been close to their lower threshold, so perhaps not all the improvement is from here. But it is good news all the same. >--------------------------------------------------------------- 5da580beacb0da1f7bf8e300e074e5cad88b8bbc testsuite/tests/perf/compiler/all.T | 9 ++++++--- testsuite/tests/perf/haddock/all.T | 8 ++++++-- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 1cf4287..cc635ff 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -235,7 +235,7 @@ test('T3064', # 2012-10-30: 111189536 (x86/Windows) # 2013-11-13: 146626504 (x86/Windows, 64bit machine) # 2014-01-22: 162457940 (x86/Linux) - (wordsize(64), 332702112, 5)]), + (wordsize(64), 313638592, 5)]), # (amd64/Linux) (28/06/2011): 73259544 # (amd64/Linux) (07/02/2013): 224798696 # (amd64/Linux) (02/08/2013): 236404384, increase from roles @@ -245,6 +245,7 @@ test('T3064', # (amd64/Linux) (11/02/2014): 308422280, optimize Coercions in simpleOptExpr # (amd64/Linux) (23/05/2014): 324022680, unknown cause # (amd64/Linux) (2014-07-17): 332702112, general round of updates + # (amd64/Linux) (2014-08-29): 313638592, w/w for INLINABLE things compiler_stats_num_field('max_bytes_used', [(wordsize(32), 11202304, 20), @@ -413,13 +414,14 @@ test('T5837', [(wordsize(32), 45520936 , 10), # 40000000 (x86/Linux) # 2013-11-13: 45520936 (x86/Windows, 64bit machine) - (wordsize(64), 86795752, 10)]) + (wordsize(64), 73639840, 10)]) # sample: 3926235424 (amd64/Linux, 15/2/2012) # 2012-10-02 81879216 # 2012-09-20 87254264 amd64/Linux # 2013-09-18 90587232 amd64/Linux # 2013-11-21 86795752 amd64/Linux, GND via Coercible and counters # for constraints solving + # 2041-08-29 73639840 amd64/Linux, w/w for INLINABLE things ], compile_fail,['-ftype-function-depth=50']) @@ -430,13 +432,14 @@ test('T6048', # prev: 38000000 (x86/Linux) # 2012-10-08: 48887164 (x86/Linux) # 2014-04-04: 62618072 (x86 Windows, 64 bit machine) - (wordsize(64), 125431448, 12)]) + (wordsize(64), 108354472, 12)]) # 18/09/2012 97247032 amd64/Linux # 16/01/2014 108578664 amd64/Linux (unknown, likely foldl-via-foldr) # 18/01/2014 95960720 amd64/Linux Call Arity improvements # 28/02/2014 105556793 amd64/Linux (unknown, tweak in base/4d9e7c9e3 resulted in change) # 05/03/2014 110646312 amd64/Linux Call Arity became more elaborate # 14/07/2014 125431448 amd64/Linux unknown reason. Even worse in GHC-7.8.3. *shurg* + # 29/08/2014 108354472 amd64/Linux w/w for INLINABLE things ], compile,['']) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 1ef4fbc..80a55d1 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -17,7 +17,7 @@ test('haddock.base', # 2014-01-22: 168 (x86/Linux - new haddock) # 2014-06-29: 156 (x86/Linux) ,stats_num_field('max_bytes_used', - [(wordsize(64), 127954488, 10) + [(wordsize(64), 112286208, 10) # 2012-08-14: 87374568 (amd64/Linux) # 2012-08-21: 86428216 (amd64/Linux) # 2012-09-20: 84794136 (amd64/Linux) @@ -25,6 +25,7 @@ test('haddock.base', # 2013-01-29: 96022312 (amd64/Linux) # 2013-10-18: 115113864 (amd64/Linux) # 2014-07-31: 127954488 (amd64/Linux), correlates with 1ae5fa45 + # 2014-08-29: 112286208 (amd64/Linux), w/w for INLINABLE things ,(platform('i386-unknown-mingw32'), 58557136, 10) # 2013-02-10: 47988488 (x86/Windows) # 2013-11-13: 58557136 (x86/Windows, 64bit machine) @@ -103,7 +104,7 @@ test('haddock.Cabal', # 2014-01-22: 52718512 (x86/Linux) # 2014-06-29: 66411508 (x86/Linux) ,stats_num_field('bytes allocated', - [(wordsize(64), 4493770224, 5) + [(wordsize(64), 4267311856, 5) # 2012-08-14: 3255435248 (amd64/Linux) # 2012-08-29: 3324606664 (amd64/Linux, new codegen) # 2012-10-08: 3373401360 (amd64/Linux) @@ -116,12 +117,15 @@ test('haddock.Cabal', # 2014-01-12: 3979151552 (amd64/Linux) new parser # 2014-06-29: 4200993768 (amd64/Linux) # 2014-08-05: 4493770224 (x86_64/Linux - bugfix for #314, Haddock now parses more URLs) + # 2014-08-29: 4267311856 (x86_64/Linux - w/w for INLINABLE things) + ,(platform('i386-unknown-mingw32'), 2052220292, 5) # 2012-10-30: 1733638168 (x86/Windows) # 2013-02-10: 1906532680 (x86/Windows) # 2014-01-28: 1966911336 (x86/Windows) # 2014-04-24: 2052220292 (x86/Windows) # 2014-08-05: XXX TODO UPDATE ME XXX + ,(wordsize(32), 2127198484, 1)]) # 2012-08-14: 1648610180 (x86/OSX) # 2014-01-22: 1986290624 (x86/Linux) From git at git.haskell.org Fri Aug 29 16:54:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 16:54:11 +0000 (UTC) Subject: [commit: ghc] master: Do not say we cannot when we clearly can (fa9dd06) Message-ID: <20140829165411.4B38E24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fa9dd0679ec6b75a22213433e860ccb39e89b975/ghc >--------------------------------------------------------------- commit fa9dd0679ec6b75a22213433e860ccb39e89b975 Author: Gabor Greif Date: Thu Aug 28 19:14:39 2014 +0200 Do not say we cannot when we clearly can >--------------------------------------------------------------- fa9dd0679ec6b75a22213433e860ccb39e89b975 .../indexed-types/should_compile/red-black-delete.hs | 18 +++--------------- 1 file changed, 3 insertions(+), 15 deletions(-) diff --git a/testsuite/tests/indexed-types/should_compile/red-black-delete.hs b/testsuite/tests/indexed-types/should_compile/red-black-delete.hs index 9873463..c1ce0fb 100644 --- a/testsuite/tests/indexed-types/should_compile/red-black-delete.hs +++ b/testsuite/tests/indexed-types/should_compile/red-black-delete.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE InstanceSigs,GADTs, DataKinds, KindSignatures, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-} +{-# LANGUAGE InstanceSigs, GADTs, StandaloneDeriving, DataKinds, KindSignatures, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-} -- Implementation of deletion for red black trees by Matt Might -- Editing to preserve the red/black tree invariants by Stephanie Weirich, @@ -12,7 +12,6 @@ module MightRedBlackGADT where import Prelude hiding (max) --- import Test.QuickCheck hiding (elements) import Data.List(nub,sort) import Control.Monad(liftM) import Data.Type.Equality @@ -61,19 +60,8 @@ type instance Incr NegativeBlack (S n) = n data RBSet a where Root :: (CT n Black a) -> RBSet a --- We can't automatically derive show and equality --- methods for GADTs. -instance Show (SColor c) where - show R = "R" - show B = "B" - show BB = "BB" - show NB = "NB" - -instance Show a => Show (CT n c a) where - show E = "E" - show (T c l x r) = - "(T " ++ show c ++ " " ++ show l ++ " " - ++ show x ++ " " ++ show r ++ ")" +deriving instance Show (SColor c) +deriving instance Show a => Show (CT n c a) instance Show a => Show (RBSet a) where show (Root x) = show x From git at git.haskell.org Fri Aug 29 16:54:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 16:54:13 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (9491fea) Message-ID: <20140829165413.CE4FF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9491fea2e8c034ed1ed4b2d8bb916a56b41ab796/ghc >--------------------------------------------------------------- commit 9491fea2e8c034ed1ed4b2d8bb916a56b41ab796 Author: Gabor Greif Date: Fri Aug 29 18:49:01 2014 +0200 Typos in comments >--------------------------------------------------------------- 9491fea2e8c034ed1ed4b2d8bb916a56b41ab796 compiler/deSugar/DsBinds.lhs | 2 +- compiler/rename/RnPat.lhs | 2 +- compiler/simplCore/CSE.lhs | 4 ++-- compiler/typecheck/TcEnv.lhs | 2 +- docs/users_guide/glasgow_exts.xml | 2 +- 5 files changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs index 18b6856..37c1632 100644 --- a/compiler/deSugar/DsBinds.lhs +++ b/compiler/deSugar/DsBinds.lhs @@ -694,7 +694,7 @@ drop_dicts drops dictionary bindings on the LHS where possible. will be simple NonRec bindings. We don't handle recursive dictionaries! - NB3: In the common case of a non-overloaded, but perhpas-polymorphic + NB3: In the common case of a non-overloaded, but perhaps-polymorphic specialisation, we don't need to bind *any* dictionaries for use in the RHS. For example (Trac #8331) {-# SPECIALIZE INLINE useAbstractMonad :: ReaderST s Int #-} diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs index 0d9668e..a3f34b2 100644 --- a/compiler/rename/RnPat.lhs +++ b/compiler/rename/RnPat.lhs @@ -527,7 +527,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) ; dotdot_flds <- rn_dotdot dotdot mb_con flds1 -- Check for an empty record update e {} - -- NB: don't complain about e { .. }, becuase rn_dotdot has done that already + -- NB: don't complain about e { .. }, because rn_dotdot has done that already ; case ctxt of HsRecFieldUpd | Nothing <- dotdot , null flds diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs index f47c89b..740aa5f 100644 --- a/compiler/simplCore/CSE.lhs +++ b/compiler/simplCore/CSE.lhs @@ -108,9 +108,9 @@ INLINE or NOINLINE. (Examples from Roman Leshchinskiy.) Consider bar = foo yes We do not expect the rule to fire. But if we do CSE, then we risk -getting yes=no, and the rule does fire. Actually, it won't becuase +getting yes=no, and the rule does fire. Actually, it won't because NOINLINE means that 'yes' will never be inlined, not even if we have -yes=no. So that's fine (now; perhpas in the olden days, yes=no would +yes=no. So that's fine (now; perhaps in the olden days, yes=no would have substituted even if 'yes' was NOINLINE. But we do need to take care. Consider diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index f4c7c10..e02bd37 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -426,7 +426,7 @@ Note especially that * It does not extend the local RdrEnv (tcl_rdr), because the things are already in the GlobalRdrEnv. Extending the local RdrEnv isn't terrible, but it means there is an entry for the same Name in both global and local - RdrEnvs, and that lead to duplicate "perhpas you meant..." suggestions + RdrEnvs, and that lead to duplicate "perhaps you meant..." suggestions (e.g. T5564). We don't bother with the tcl_th_bndrs environment either. diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index befaf4d..7cfc2be 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -5358,7 +5358,7 @@ is extended thus: defaulting applies when all the unresolved constraints involve So, for example, the expression length "foo" will give rise -to an ambiguous use of IsString a0 which, becuase of the above +to an ambiguous use of IsString a0 which, because of the above rules, will default to String. From git at git.haskell.org Fri Aug 29 17:24:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 17:24:42 +0000 (UTC) Subject: [commit: packages/dph] branch 'wip/dph-fix' created Message-ID: <20140829172442.E5BEB24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/dph New branch : wip/dph-fix Referencing: 97b52d96c845f58a83dac03d1de6d85fcadf3f13 From git at git.haskell.org Fri Aug 29 17:24:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 17:24:44 +0000 (UTC) Subject: [commit: packages/dph] wip/dph-fix: Applicative-Monad fixes. (33a0c42) Message-ID: <20140829172445.0104124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/dph On branch : wip/dph-fix Link : http://git.haskell.org/packages/dph.git/commitdiff/33a0c42e76a258f63b1812d7c4e3ac7990c9cf5d >--------------------------------------------------------------- commit 33a0c42e76a258f63b1812d7c4e3ac7990c9cf5d Author: Geoffrey Mainland Date: Wed Aug 27 15:45:54 2014 -0400 Applicative-Monad fixes. >--------------------------------------------------------------- 33a0c42e76a258f63b1812d7c4e3ac7990c9cf5d dph-lifted-base/Data/Array/Parallel/PArray/Reference.hs | 2 +- dph-lifted-boxed/Data/Array/Parallel/PArray.hs | 2 +- .../Data/Array/Parallel/Unlifted/Distributed/Primitive/DistST.hs | 1 + 3 files changed, 3 insertions(+), 2 deletions(-) diff --git a/dph-lifted-base/Data/Array/Parallel/PArray/Reference.hs b/dph-lifted-base/Data/Array/Parallel/PArray/Reference.hs index a98ffdc..3bcf736 100644 --- a/dph-lifted-base/Data/Array/Parallel/PArray/Reference.hs +++ b/dph-lifted-base/Data/Array/Parallel/PArray/Reference.hs @@ -55,7 +55,7 @@ import Data.Array.Parallel.Base (Tag) import Data.Vector (Vector) import qualified Data.Array.Parallel.Unlifted as U import qualified Data.Vector as V -import Control.Monad hiding ( empty ) +import Control.Monad import Prelude hiding ( replicate, length, concat , enumFromTo diff --git a/dph-lifted-boxed/Data/Array/Parallel/PArray.hs b/dph-lifted-boxed/Data/Array/Parallel/PArray.hs index 3b6b6f1..d19b795 100644 --- a/dph-lifted-boxed/Data/Array/Parallel/PArray.hs +++ b/dph-lifted-boxed/Data/Array/Parallel/PArray.hs @@ -59,7 +59,7 @@ import Data.Vector (Vector) import qualified Data.Array.Parallel.Unlifted as U import qualified Data.Array.Parallel.Array as A import qualified Data.Vector as V -import Control.Monad hiding (empty) +import Control.Monad import GHC.Exts (Int(I#), (+#)) import qualified Prelude as P import Prelude hiding diff --git a/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Primitive/DistST.hs b/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Primitive/DistST.hs index cdabbda..4349df4 100644 --- a/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Primitive/DistST.hs +++ b/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Primitive/DistST.hs @@ -31,6 +31,7 @@ import Data.Array.Parallel.Unlifted.Distributed.Primitive.DT import Data.Array.Parallel.Unlifted.Distributed.Primitive.Gang import Data.Array.Parallel.Unlifted.Distributed.Data.Tuple import Data.Array.Parallel.Base (ST, runST) +import Control.Applicative (Applicative(..)) import Control.Monad (liftM, ap) From git at git.haskell.org Fri Aug 29 17:24:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 17:24:46 +0000 (UTC) Subject: [commit: packages/dph] wip/dph-fix: Adapt to new version of the vector library. (97b52d9) Message-ID: <20140829172446.EF09524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/dph On branch : wip/dph-fix Link : http://git.haskell.org/packages/dph.git/commitdiff/97b52d96c845f58a83dac03d1de6d85fcadf3f13 >--------------------------------------------------------------- commit 97b52d96c845f58a83dac03d1de6d85fcadf3f13 Author: Geoffrey Mainland Date: Sun Oct 28 18:06:16 2012 +0000 Adapt to new version of the vector library. >--------------------------------------------------------------- 97b52d96c845f58a83dac03d1de6d85fcadf3f13 dph-base/dph-base.cabal | 2 +- dph-examples/dph-examples.cabal | 40 ++--- dph-lifted-base/dph-lifted-base.cabal | 2 +- dph-lifted-boxed/dph-lifted-boxed.cabal | 2 +- dph-lifted-copy/dph-lifted-copy.cabal | 2 +- .../Data/Array/Parallel/PArray/PData/Tuple7.hs | 25 +-- dph-lifted-vseg/dph-lifted-vseg.cabal | 3 +- dph-prim-interface/dph-prim-interface.cabal | 2 +- .../Array/Parallel/Unlifted/Parallel/Segmented.hs | 17 +- dph-prim-par/dph-prim-par.cabal | 3 +- .../Array/Parallel/Unlifted/Sequential/Basics.hs | 2 +- .../Array/Parallel/Unlifted/Sequential/USel.hs | 10 +- .../Array/Parallel/Unlifted/Sequential/Vector.hs | 43 ++--- .../Data/Array/Parallel/Unlifted/Stream/Elems.hs | 17 +- .../Data/Array/Parallel/Unlifted/Stream/Ixs.hs | 15 +- .../Data/Array/Parallel/Unlifted/Stream/Locked.hs | 195 +++++++++++---------- .../Array/Parallel/Unlifted/Stream/Segmented.hs | 126 ++++++------- .../Array/Parallel/Unlifted/Stream/Segments.hs | 23 +-- .../Data/Array/Parallel/Unlifted/Stream/Swallow.hs | 43 ++--- dph-prim-seq/dph-prim-seq.cabal | 2 +- 20 files changed, 296 insertions(+), 278 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 97b52d96c845f58a83dac03d1de6d85fcadf3f13 From git at git.haskell.org Fri Aug 29 17:25:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 17:25:46 +0000 (UTC) Subject: [commit: ghc] branch 'wip/dph-fix' created Message-ID: <20140829172546.53B5924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/dph-fix Referencing: 16ad04bdec5df45bd666ea9b840dfb962c4b410d From git at git.haskell.org Fri Aug 29 17:25:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 17:25:49 +0000 (UTC) Subject: [commit: ghc] wip/dph-fix: Update primitive, vector, and dph. (16ad04b) Message-ID: <20140829172549.5DC1624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/dph-fix Link : http://ghc.haskell.org/trac/ghc/changeset/16ad04bdec5df45bd666ea9b840dfb962c4b410d/ghc >--------------------------------------------------------------- commit 16ad04bdec5df45bd666ea9b840dfb962c4b410d Author: Geoffrey Mainland Date: Wed Aug 27 22:33:44 2014 -0400 Update primitive, vector, and dph. >--------------------------------------------------------------- 16ad04bdec5df45bd666ea9b840dfb962c4b410d libraries/dph | 2 +- libraries/primitive | 2 +- libraries/vector | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/dph b/libraries/dph index 3ebad52..97b52d9 160000 --- a/libraries/dph +++ b/libraries/dph @@ -1 +1 @@ -Subproject commit 3ebad521cd1e3b5573d97b483305ca465a9cba69 +Subproject commit 97b52d96c845f58a83dac03d1de6d85fcadf3f13 diff --git a/libraries/primitive b/libraries/primitive index be63ee1..06fb8df 160000 --- a/libraries/primitive +++ b/libraries/primitive @@ -1 +1 @@ -Subproject commit be63ee15d961dc1b08bc8853b9ff97708551ef36 +Subproject commit 06fb8df6ab255ea5171e99da87e673c23faaf4b7 diff --git a/libraries/vector b/libraries/vector index a6049ab..0618f4b 160000 --- a/libraries/vector +++ b/libraries/vector @@ -1 +1 @@ -Subproject commit a6049abce040713e9a5f175887cf70d12b9057c6 +Subproject commit 0618f4b1545cc6f63df7f026c2524284d890961b From git at git.haskell.org Fri Aug 29 21:09:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Aug 2014 21:09:12 +0000 (UTC) Subject: [commit: ghc] master: Fix to bin-package-db for ming32-only code (eac8728) Message-ID: <20140829210913.153B924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eac8728691db95085d0530b748388de0f8f5732b/ghc >--------------------------------------------------------------- commit eac8728691db95085d0530b748388de0f8f5732b Author: Simon Peyton Jones Date: Fri Aug 29 22:06:56 2014 +0100 Fix to bin-package-db for ming32-only code Patch written by Pali Gabor Janos >--------------------------------------------------------------- eac8728691db95085d0530b748388de0f8f5732b libraries/bin-package-db/GHC/PackageDb.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/bin-package-db/GHC/PackageDb.hs b/libraries/bin-package-db/GHC/PackageDb.hs index 5039a01..76fa697 100644 --- a/libraries/bin-package-db/GHC/PackageDb.hs +++ b/libraries/bin-package-db/GHC/PackageDb.hs @@ -261,15 +261,15 @@ writeFileAtomic targetPath content = do #if mingw32_HOST_OS || mingw32_TARGET_OS renameFile tmpPath targetPath -- If the targetPath exists then renameFile will fail - `catchIO` \err -> do + `catch` \err -> do exists <- doesFileExist targetPath if exists then do removeFile targetPath -- Big fat hairy race condition - renameFile newFile targetPath + renameFile tmpPath targetPath -- If the removeFile succeeds and the renameFile fails -- then we've lost the atomic property. - else throwIOIO err + else throwIO (err :: IOException) #else renameFile tmpPath targetPath #endif From git at git.haskell.org Sat Aug 30 07:32:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 Aug 2014 07:32:52 +0000 (UTC) Subject: [commit: ghc] master: testsuite: normalise integer library name for T8958 (985e367) Message-ID: <20140830073252.A743624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/985e367948a33a4a50629ea9d2523317f2311a3b/ghc >--------------------------------------------------------------- commit 985e367948a33a4a50629ea9d2523317f2311a3b Author: Sergei Trofimovich Date: Fri Aug 29 19:06:14 2014 +0300 testsuite: normalise integer library name for T8958 Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 985e367948a33a4a50629ea9d2523317f2311a3b testsuite/driver/testlib.py | 6 ++---- testsuite/tests/roles/should_compile/T8958.stderr | 2 +- testsuite/tests/roles/should_compile/all.T | 2 +- 3 files changed, 4 insertions(+), 6 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 9a6951b..e3562f7 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1596,10 +1596,8 @@ def normalise_errmsg( str ): # The inplace ghc's are called ghc-stage[123] to avoid filename # collisions, so we need to normalise that to just "ghc" str = re.sub('ghc-stage[123]', 'ghc', str) - # We sometimes see the name of the integer-gmp package on stderr, - # but this can change (either the implementation name or the - # version number), so we canonicalise it here - str = re.sub('integer-[a-z]+', 'integer-impl', str) + # Error messages simetimes contain integer implementation package + str = re.sub('integer-(gmp|simple)-[0-9.]+', 'integer--', str) return str # normalise a .prof file, so that we can reasonably compare it against diff --git a/testsuite/tests/roles/should_compile/T8958.stderr b/testsuite/tests/roles/should_compile/T8958.stderr index 5c144c2..a01cc05 100644 --- a/testsuite/tests/roles/should_compile/T8958.stderr +++ b/testsuite/tests/roles/should_compile/T8958.stderr @@ -17,7 +17,7 @@ INSTANCES -- Defined at T8958.hs:10:10 Dependent modules: [] Dependent packages: [base-4.7.1.0, ghc-prim-0.3.1.0, - integer-gmp-0.5.1.0] + integer--] ==================== Typechecker ==================== AbsBinds [a] [] diff --git a/testsuite/tests/roles/should_compile/all.T b/testsuite/tests/roles/should_compile/all.T index 681092b..744b934 100644 --- a/testsuite/tests/roles/should_compile/all.T +++ b/testsuite/tests/roles/should_compile/all.T @@ -5,4 +5,4 @@ test('Roles4', only_ways('normal'), compile, ['-ddump-tc']) test('Roles13', only_ways('normal'), compile, ['-ddump-simpl -dsuppress-uniques']) test('Roles14', only_ways('normal'), compile, ['-ddump-tc']) test('RolesIArray', only_ways('normal'), compile, ['']) -test('T8958', only_ways('normal'), compile, ['-ddump-tc -dsuppress-uniques']) +test('T8958', [normalise_fun(normalise_errmsg), only_ways('normal')], compile, ['-ddump-tc -dsuppress-uniques']) From git at git.haskell.org Sat Aug 30 09:53:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 Aug 2014 09:53:12 +0000 (UTC) Subject: [commit: ghc] master: Revert "Comment why the include is necessary" (54db6fa) Message-ID: <20140830095312.3236224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/54db6fa95ec97286ea20994b4a886320c72e3b9e/ghc >--------------------------------------------------------------- commit 54db6fa95ec97286ea20994b4a886320c72e3b9e Author: Gabor Greif Date: Sat Aug 30 00:30:07 2014 +0200 Revert "Comment why the include is necessary" This reverts commit 15df6d98afb8c3813013c5b97efffe0ba8020d32. >--------------------------------------------------------------- 54db6fa95ec97286ea20994b4a886320c72e3b9e rts/Capability.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/Capability.c b/rts/Capability.c index fda9f4f..542df32 100644 --- a/rts/Capability.c +++ b/rts/Capability.c @@ -26,7 +26,7 @@ #include "sm/GC.h" // for gcWorkerThread() #include "STM.h" #include "RtsUtils.h" -#include "rts/IOManager.h" // for setIOManagerControlFd() +#include "rts/IOManager.h" #include From git at git.haskell.org Sat Aug 30 09:53:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 Aug 2014 09:53:14 +0000 (UTC) Subject: [commit: ghc] master: Some typos (0dc2426) Message-ID: <20140830095314.F2BDF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0dc24269819f6b00e5c46a88bdb781d348e046aa/ghc >--------------------------------------------------------------- commit 0dc24269819f6b00e5c46a88bdb781d348e046aa Author: Gabor Greif Date: Fri Aug 29 23:51:20 2014 +0200 Some typos >--------------------------------------------------------------- 0dc24269819f6b00e5c46a88bdb781d348e046aa compiler/coreSyn/CoreSyn.lhs | 2 +- testsuite/tests/perf/compiler/all.T | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index babece4..d739738 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -932,7 +932,7 @@ expandUnfolding_maybe _ = hasStableCoreUnfolding_maybe :: Unfolding -> Maybe Bool -- Just True <=> has stable inlining, very keen to inline (eg. INLINE pragma) -- Just False <=> has stable inlining, open to inlining it (eg. INLINEABLE pragma) --- Nothing <=> not table, or cannot inline it anyway +-- Nothing <=> not stable, or cannot inline it anyway hasStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide }) | isStableSource src = case guide of diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index cc635ff..f53787a 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -88,7 +88,7 @@ test('T1969', # 12/11/2012 658786936 (amd64/Linux) UNKNOWN REASON # 17/1/13: 667160192 (x86_64/Linux) new demand analyser # 18/10/2013 698612512 (x86_64/Linux) fix for #8456 - # 10/02/2014 660922376 (x86_64/Linux) call artiy analysis + # 10/02/2014 660922376 (x86_64/Linux) call arity analysis # 17/07/2014 651626680 (x86_64/Linux) roundabout update only_ways(['normal']), From git at git.haskell.org Sat Aug 30 09:53:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 Aug 2014 09:53:17 +0000 (UTC) Subject: [commit: ghc] master: Revert "Make sure that a prototype is included for 'setIOManagerControlFd'" (b760cc5) Message-ID: <20140830095317.A775B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b760cc59b26a407dcd5715920c64f53513e65f14/ghc >--------------------------------------------------------------- commit b760cc59b26a407dcd5715920c64f53513e65f14 Author: Gabor Greif Date: Sat Aug 30 00:30:39 2014 +0200 Revert "Make sure that a prototype is included for 'setIOManagerControlFd'" This reverts commit 7bf49f86a20f3beda0ee5fbea2db64cfef730d74. >--------------------------------------------------------------- b760cc59b26a407dcd5715920c64f53513e65f14 rts/Capability.c | 1 - 1 file changed, 1 deletion(-) diff --git a/rts/Capability.c b/rts/Capability.c index 542df32..29c5270 100644 --- a/rts/Capability.c +++ b/rts/Capability.c @@ -26,7 +26,6 @@ #include "sm/GC.h" // for gcWorkerThread() #include "STM.h" #include "RtsUtils.h" -#include "rts/IOManager.h" #include From git at git.haskell.org Sun Aug 31 10:27:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 10:27:13 +0000 (UTC) Subject: [commit: ghc] master: Re-export Word from Prelude (re #9531) (393b820) Message-ID: <20140831102713.209A124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/393b820233caa00e428affc28e090b496d181664/ghc >--------------------------------------------------------------- commit 393b820233caa00e428affc28e090b496d181664 Author: Herbert Valerio Riedel Date: Sun Aug 31 11:40:50 2014 +0200 Re-export Word from Prelude (re #9531) The original proposal text can be found at http://www.haskell.org/pipermail/libraries/2014-August/023491.html The proposal passed with a clear majority, and was additionally confirmed by the core libraries committee. *Compatibility Note* Only code that imports `Data.Word` for the sole purpose of using `Word` *and* requires to be `-Werror`-clean (due to `-fwarn-unused-imports`) is affected by this change. In order to write warning-free forward/backward compatible against `base`, a variant of the following CPP-based snippet can be used: -- Starting with base>4.7.0 or GHC>7.8 Prelude re-exports 'Word' -- The following is needed, if 'Word' is the *only* entity needed from Data.Word #ifdef MIN_VERSION_base # if !MIN_VERSION_base(4,7,1) import Data.Word (Word) # endif -- no cabal_macros.h -- fallback to __GLASGOW_HASKELL__ #elif __GLASGOW_HASKELL__ < 709 import Data.Word (Word) #endif This also updates the haddock submodule in order to avoid a compile warning >--------------------------------------------------------------- 393b820233caa00e428affc28e090b496d181664 compiler/coreSyn/MkCore.lhs | 4 +++- libraries/base/Prelude.hs | 2 +- libraries/base/changelog.md | 2 ++ mk/validate-settings.mk | 3 +++ testsuite/tests/lib/integer/IntegerConversionRules.hs | 5 ++++- testsuite/tests/numeric/should_run/T7014.hs | 6 +++++- testsuite/tests/typecheck/should_fail/T5095.stderr | 2 +- utils/haddock | 2 +- 8 files changed, 20 insertions(+), 6 deletions(-) diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs index 3ba8b1d..08c3eed 100644 --- a/compiler/coreSyn/MkCore.lhs +++ b/compiler/coreSyn/MkCore.lhs @@ -92,7 +92,9 @@ import DynFlags import Data.Char ( ord ) import Data.List import Data.Ord -import Data.Word +#if __GLASGOW_HASKELL__ < 709 +import Data.Word ( Word ) +#endif infixl 4 `mkCoreApp`, `mkCoreApps` \end{code} diff --git a/libraries/base/Prelude.hs b/libraries/base/Prelude.hs index 9b1119e..3a3cc4d 100644 --- a/libraries/base/Prelude.hs +++ b/libraries/base/Prelude.hs @@ -48,7 +48,7 @@ module Prelude ( -- *** Numeric types Int, Integer, Float, Double, - Rational, + Rational, Word, -- *** Numeric type classes Num((+), (-), (*), negate, abs, signum, fromInteger), diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 28005f8..b976811 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -20,6 +20,8 @@ * Make `abs` and `signum` handle (-0.0) correctly per IEEE-754. + * Re-export `Data.Word.Word` from `Prelude` + ## 4.7.0.1 *Jul 2014* * Bundled with GHC 7.8.3 diff --git a/mk/validate-settings.mk b/mk/validate-settings.mk index 4ccef07..bd3e3bc 100644 --- a/mk/validate-settings.mk +++ b/mk/validate-settings.mk @@ -96,6 +96,9 @@ libraries/containers_dist-install_EXTRA_HC_OPTS += -fno-warn-incomplete-patterns # Temporarily turn off pointless-pragma warnings for containers libraries/containers_dist-install_EXTRA_HC_OPTS += -fno-warn-pointless-pragmas +# Temporarily turn off unused-imports warnings for containers +libraries/containers_dist-install_EXTRA_HC_OPTS += -fno-warn-unused-imports + # bytestring has identities at the moment libraries/bytestring_dist-install_EXTRA_HC_OPTS += -fno-warn-identities diff --git a/testsuite/tests/lib/integer/IntegerConversionRules.hs b/testsuite/tests/lib/integer/IntegerConversionRules.hs index cb5269f..56949e7 100644 --- a/testsuite/tests/lib/integer/IntegerConversionRules.hs +++ b/testsuite/tests/lib/integer/IntegerConversionRules.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE CPP #-} module IntegerConversionRules where -import Data.Word +#if __GLASGOW_HASKELL__ < 709 +import Data.Word (Word) +#endif f1 :: Int -> Double f1 = fi diff --git a/testsuite/tests/numeric/should_run/T7014.hs b/testsuite/tests/numeric/should_run/T7014.hs index 8237538..222b33b 100644 --- a/testsuite/tests/numeric/should_run/T7014.hs +++ b/testsuite/tests/numeric/should_run/T7014.hs @@ -1,7 +1,11 @@ +{-# LANGUAGE CPP #-} + module Main where import Data.Bits -import Data.Word +#if __GLASGOW_HASKELL__ < 705 +import Data.Word (Word) +#endif test_and1 :: Word -> Word test_and1 x = x .&. 0 diff --git a/testsuite/tests/typecheck/should_fail/T5095.stderr b/testsuite/tests/typecheck/should_fail/T5095.stderr index e8d2b71..55342cd 100644 --- a/testsuite/tests/typecheck/should_fail/T5095.stderr +++ b/testsuite/tests/typecheck/should_fail/T5095.stderr @@ -53,7 +53,7 @@ T5095.hs:9:11: instance Eq Float -- Defined in ?GHC.Classes? instance Eq Int -- Defined in ?GHC.Classes? instance Eq Ordering -- Defined in ?GHC.Classes? - instance Eq GHC.Types.Word -- Defined in ?GHC.Classes? + instance Eq Word -- Defined in ?GHC.Classes? instance Eq a => Eq [a] -- Defined in ?GHC.Classes? instance Eq Integer -- Defined in ?integer-gmp-0.5.1.0:GHC.Integer.Type? diff --git a/utils/haddock b/utils/haddock index b2a807d..eee52f6 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit b2a807da55d197c648fd2df1f156f9862711d92b +Subproject commit eee52f697233f99e23c1d8183511229fb93e3f3e From git at git.haskell.org Sun Aug 31 11:05:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 11:05:46 +0000 (UTC) Subject: [commit: ghc] wip/T8584: Update baseline shift/reduce conflict number (9874f3c) Message-ID: <20140831110546.E82A024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/9874f3c2aae204ba5b9d8f208e6c6a5b6386b728/ghc >--------------------------------------------------------------- commit 9874f3c2aae204ba5b9d8f208e6c6a5b6386b728 Author: Dr. ERDI Gergo Date: Wed Jul 2 19:18:43 2014 +0800 Update baseline shift/reduce conflict number >--------------------------------------------------------------- 9874f3c2aae204ba5b9d8f208e6c6a5b6386b728 compiler/parser/Parser.y.pp | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 72dfc88..3de21a3 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -72,6 +72,12 @@ import Control.Monad ( mplus ) {- ----------------------------------------------------------------------------- +25 June 2014 + +Conflicts: 47 shift/reduce + 1 reduce/reduce + +----------------------------------------------------------------------------- 12 October 2012 Conflicts: 43 shift/reduce From git at git.haskell.org Sun Aug 31 11:05:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 11:05:49 +0000 (UTC) Subject: [commit: ghc] wip/T8584: Add TcPatSynInfo to store the typechecked representation of a pattern synonym type signature (a4fa9fe) Message-ID: <20140831110549.641B124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/a4fa9fe3a41e23f929aadeae215b1a7019fb718a/ghc >--------------------------------------------------------------- commit a4fa9fe3a41e23f929aadeae215b1a7019fb718a Author: Dr. ERDI Gergo Date: Wed Jul 30 10:07:30 2014 +0200 Add TcPatSynInfo to store the typechecked representation of a pattern synonym type signature >--------------------------------------------------------------- a4fa9fe3a41e23f929aadeae215b1a7019fb718a compiler/typecheck/TcBinds.lhs | 43 +++++++++++++--- compiler/typecheck/TcClassDcl.lhs | 4 +- compiler/typecheck/TcPat.lhs | 11 +++++ compiler/typecheck/TcPatSyn.lhs | 96 ++++++++++++++++++++++++++---------- compiler/typecheck/TcPatSyn.lhs-boot | 7 +++ 5 files changed, 127 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 a4fa9fe3a41e23f929aadeae215b1a7019fb718a From git at git.haskell.org Sun Aug 31 11:05:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 11:05:52 +0000 (UTC) Subject: [commit: ghc] wip/T8584: Renamer for PatSynSigs: handle type variable bindings (c98a7fd) Message-ID: <20140831110552.14E1F24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/c98a7fd86543e97dea140f6548a2b443027ddd70/ghc >--------------------------------------------------------------- commit c98a7fd86543e97dea140f6548a2b443027ddd70 Author: Dr. ERDI Gergo Date: Sun Jul 20 12:49:21 2014 +0800 Renamer for PatSynSigs: handle type variable bindings >--------------------------------------------------------------- c98a7fd86543e97dea140f6548a2b443027ddd70 compiler/rename/RnBinds.lhs | 49 +++++++++++++++++++++++++++++---------------- 1 file changed, 32 insertions(+), 17 deletions(-) diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index 0f9f44a..807a05c 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -35,7 +35,7 @@ import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts ) import HsSyn import TcRnMonad import TcEvidence ( emptyTcEvBinds ) -import RnTypes ( bindSigTyVarsFV, rnHsSigType, rnLHsType, checkPrecMatch, rnContext ) +import RnTypes import RnPat import RnNames import RnEnv @@ -832,22 +832,37 @@ renameSig ctxt sig@(MinimalSig bf) return (MinimalSig new_bf, emptyFVs) renameSig ctxt sig@(PatSynSig v args ty prov req) - = do v' <- lookupSigOccRn ctxt sig v - let doc = quotes (ppr v) - rn_type = rnHsSigType doc - (ty', fvs1) <- rn_type ty - (args', fvs2) <- case args of - PrefixPatSyn tys -> - do (tys, fvs) <- unzip <$> mapM rn_type tys - return (PrefixPatSyn tys, plusFVs fvs) - InfixPatSyn left right -> - do (left', fvs1) <- rn_type left - (right', fvs2) <- rn_type right - return (InfixPatSyn left' right', fvs1 `plusFV` fvs2) - (prov', fvs3) <- rnContext (TypeSigCtx doc) prov - (req', fvs4) <- rnContext (TypeSigCtx doc) req - let fvs = plusFVs [fvs1, fvs2, fvs3, fvs4] - return (PatSynSig v' args' ty' prov' req', fvs) + = do { v' <- lookupSigOccRn ctxt sig v + ; let doc = TypeSigCtx $ quotes (ppr v) + ; loc <- getSrcSpanM + + ; let (ty_kvs, ty_tvs) = extractHsTysRdrTyVars (ty:unLoc req) + ; let ty_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ ty_tvs + + ; bindHsTyVars doc Nothing ty_kvs ty_tv_bndrs $ \ _new_tyvars -> do + { (req', fvs1) <- rnContext doc req + ; (ty', fvs2) <- rnLHsType doc ty + + ; let (arg_tys, rnArgs) = case args of + PrefixPatSyn tys -> + let rnArgs = do + (tys', fvs) <- mapFvRn (rnLHsType doc) tys + return (PrefixPatSyn tys', fvs) + in (tys, rnArgs) + InfixPatSyn ty1 ty2 -> + let rnArgs = do + (ty1', fvs1) <- rnLHsType doc ty1 + (ty2', fvs2) <- rnLHsType doc ty2 + return (InfixPatSyn ty1' ty2', fvs1 `plusFV` fvs2) + in ([ty1, ty2], rnArgs) + ; let (arg_kvs, arg_tvs) = extractHsTysRdrTyVars (arg_tys ++ unLoc prov) + ; let arg_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ arg_tvs + + ; bindHsTyVars doc Nothing arg_kvs arg_tv_bndrs $ \ _new_tyvars -> do + { (prov', fvs3) <- rnContext doc prov + ; (args', fvs4) <- rnArgs + + ; return (PatSynSig v' args' ty' prov' req', plusFVs [fvs1, fvs2, fvs3, fvs4]) }}} ppr_sig_bndrs :: [Located RdrName] -> SDoc ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs) From git at git.haskell.org Sun Aug 31 11:05:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 11:05:54 +0000 (UTC) Subject: [commit: ghc] wip/T8584: Split tcPatSynDecl into inferring function and general workhorse function (7fd7f6d) Message-ID: <20140831110554.9118324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/7fd7f6d60cb8da7d7f11f921ccb9e3688d5bedcc/ghc >--------------------------------------------------------------- commit 7fd7f6d60cb8da7d7f11f921ccb9e3688d5bedcc Author: Dr. ERDI Gergo Date: Sun Jul 27 14:10:34 2014 +0200 Split tcPatSynDecl into inferring function and general workhorse function >--------------------------------------------------------------- 7fd7f6d60cb8da7d7f11f921ccb9e3688d5bedcc compiler/typecheck/TcBinds.lhs | 4 ++-- compiler/typecheck/TcPatSyn.lhs | 11 +++++++++-- compiler/typecheck/TcPatSyn.lhs-boot | 4 ++-- 3 files changed, 13 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 9db4125..441ea14 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -16,7 +16,7 @@ module TcBinds ( tcLocalBinds, tcTopBinds, tcRecSelBinds, import {-# SOURCE #-} TcMatches ( tcGRHSsPat, tcMatchesFun ) import {-# SOURCE #-} TcExpr ( tcMonoExpr ) -import {-# SOURCE #-} TcPatSyn ( tcPatSynDecl, tcPatSynWrapper ) +import {-# SOURCE #-} TcPatSyn ( tcInferPatSynDecl, tcPatSynWrapper ) import DynFlags import HsSyn @@ -419,7 +419,7 @@ tc_single :: forall thing. -> LHsBind Name -> TcM thing -> TcM (LHsBinds TcId, thing) tc_single _top_lvl _sig_fn _prag_fn (L _ (PatSynBind psb)) thing_inside - = do { (pat_syn, aux_binds) <- tcPatSynDecl psb + = do { (pat_syn, aux_binds) <- tcInferPatSynDecl psb ; let tything = AConLike (PatSynCon pat_syn) implicit_ids = (patSynMatcher pat_syn) : diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs index b5fbc29..40efbfe 100644 --- a/compiler/typecheck/TcPatSyn.lhs +++ b/compiler/typecheck/TcPatSyn.lhs @@ -7,7 +7,7 @@ \begin{code} {-# LANGUAGE CPP #-} -module TcPatSyn (tcPatSynDecl, tcPatSynWrapper) where +module TcPatSyn (tcInferPatSynDecl, tcPatSynWrapper) where import HsSyn import TcPat @@ -40,13 +40,20 @@ import TypeRep \end{code} \begin{code} +tcInferPatSynDecl :: PatSynBind Name Name + -> TcM (PatSyn, LHsBinds Id) +tcInferPatSynDecl psb + = do { pat_ty <- newFlexiTyVarTy openTypeKind + ; tcPatSynDecl psb pat_ty } + tcPatSynDecl :: PatSynBind Name Name + -> TcType -> TcM (PatSyn, LHsBinds Id) tcPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details, psb_def = lpat, psb_dir = dir } + pat_ty = do { traceTc "tcPatSynDecl {" $ ppr name $$ ppr lpat ; tcCheckPatSynPat lpat - ; pat_ty <- newFlexiTyVarTy openTypeKind ; let (arg_names, is_infix) = case details of PrefixPatSyn names -> (map unLoc names, False) diff --git a/compiler/typecheck/TcPatSyn.lhs-boot b/compiler/typecheck/TcPatSyn.lhs-boot index 700137c..0f77400 100644 --- a/compiler/typecheck/TcPatSyn.lhs-boot +++ b/compiler/typecheck/TcPatSyn.lhs-boot @@ -7,8 +7,8 @@ import HsSyn ( PatSynBind, LHsBinds ) import TcRnTypes ( TcM ) import PatSyn ( PatSyn ) -tcPatSynDecl :: PatSynBind Name Name - -> TcM (PatSyn, LHsBinds Id) +tcInferPatSynDecl :: PatSynBind Name Name + -> TcM (PatSyn, LHsBinds Id) tcPatSynWrapper :: PatSynBind Name Name -> TcM (LHsBinds Id) From git at git.haskell.org Sun Aug 31 11:05:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 11:05:57 +0000 (UTC) Subject: [commit: ghc] wip/T8584: Add parser for pattern synonym type signatures. Syntax is of the form (1b08992) Message-ID: <20140831110557.90EB124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/1b08992c1469d1dcad937896b57bb2192aa22f3a/ghc >--------------------------------------------------------------- commit 1b08992c1469d1dcad937896b57bb2192aa22f3a Author: Dr. ERDI Gergo Date: Mon Jul 14 18:18:44 2014 +0800 Add parser for pattern synonym type signatures. Syntax is of the form pattern type Eq a => P a T b :: Num b => R a b which declares a pattern synonym called P, with argument types a, T, and b. >--------------------------------------------------------------- 1b08992c1469d1dcad937896b57bb2192aa22f3a compiler/hsSyn/HsBinds.lhs | 1 + compiler/hsSyn/HsTypes.lhs | 2 +- compiler/parser/Parser.y.pp | 9 +++++++-- compiler/parser/RdrHsSyn.lhs | 29 ++++++++++++++++++++++++++++- 4 files changed, 37 insertions(+), 4 deletions(-) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index 04a7222..a90ea66 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -723,6 +723,7 @@ pprPatSynSig :: (OutputableBndr a) => a -> Bool -> HsPatSynDetails SDoc -> SDoc -> Maybe SDoc -> Maybe SDoc -> SDoc pprPatSynSig ident is_bidir args rhs_ty prov_theta req_theta = sep [ ptext (sLit "pattern") + , ptext (sLit "type") , thetaOpt prov_theta, name_and_args , colon , thetaOpt req_theta, rhs_ty diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index 0cf8455..14837f6 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -31,7 +31,7 @@ module HsTypes ( hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, splitLHsInstDeclTy_maybe, splitHsClassTy_maybe, splitLHsClassTy_maybe, - splitHsFunType, + splitHsFunType, splitLHsForAllTy, splitHsAppTys, hsTyGetAppHead_maybe, mkHsAppTys, mkHsOpTy, -- Printing diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 3de21a3..f24599c 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -856,8 +856,7 @@ role : VARID { L1 $ Just $ getVARID $1 } pattern_synonym_decl :: { LHsDecl RdrName } : 'pattern' pat '=' pat {% do { (name, args) <- splitPatSyn $2 - ; return $ LL . ValD $ mkPatSynBind name args $4 ImplicitBidirectional - }} + ; return $ LL . ValD $ mkPatSynBind name args $4 ImplicitBidirectional }} | 'pattern' pat '<-' pat {% do { (name, args) <- splitPatSyn $2 ; return $ LL . ValD $ mkPatSynBind name args $4 Unidirectional @@ -873,6 +872,11 @@ where_decls :: { Located (OrdList (LHsDecl RdrName)) } : 'where' '{' decls '}' { $3 } | 'where' vocurly decls close { $3 } +pattern_synonym_sig :: { LSig RdrName } + : 'pattern' 'type' ctype '::' ctype + {% do { (name, details, ty, prov, req) <- splitPatSynSig $3 $5 + ; return . LL $ PatSynSig name details ty prov req }} + vars0 :: { [Located RdrName] } : {- empty -} { [] } | varid vars0 { $1 : $2 } @@ -1482,6 +1486,7 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) } { LL $ toOL [ LL $ SigD (TypeSig ($1 : reverse (unLoc $3)) $5) ] } | infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1)))) | n <- unLoc $3 ] } + | pattern_synonym_sig { LL . unitOL $ LL . SigD . unLoc $ $1 } | '{-# INLINE' activation qvar '#-}' { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlinePragma (getINLINE $1) $2))) } | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}' diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 2f95116..0d72cb1 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -17,7 +17,7 @@ module RdrHsSyn ( mkTyFamInst, mkFamDecl, splitCon, mkInlinePragma, - splitPatSyn, toPatSynMatchGroup, + splitPatSyn, splitPatSynSig, toPatSynMatchGroup, mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp mkTyLit, mkTyClD, mkInstD, @@ -479,6 +479,33 @@ toPatSynMatchGroup (L _ patsyn_name) (L _ decls) = text "pattern synonym 'where' clause must bind the pattern synonym's name" <+> quotes (ppr patsyn_name) $$ ppr decl +-- Given two types like +-- Eq a => P a T b +-- and +-- Num b => R a b +-- +-- This returns +-- P as the name, +-- PrefixPatSyn [a, T, b] as the details, +-- R a b as the result type, +-- and (Eq a) and (Num b) as the provided and required thetas (respectively) +splitPatSynSig :: LHsType RdrName + -> LHsType RdrName + -> P (Located RdrName, HsPatSynDetails (LHsType RdrName), LHsType RdrName, LHsContext RdrName, LHsContext RdrName) +splitPatSynSig lty1 lty2 = do + (name, details) <- splitCon pat_ty + details' <- case details of + PrefixCon tys -> return $ PrefixPatSyn tys + InfixCon ty1 ty2 -> return $ InfixPatSyn ty1 ty2 + RecCon{} -> parseErrorSDoc (getLoc lty1) $ + text "record syntax not supported for pattern synonym declarations:" $$ ppr lty1 + return (name, details', res_ty, prov', req') + where + (_, prov, pat_ty) = splitLHsForAllTy lty1 + (_, req, res_ty) = splitLHsForAllTy lty2 + prov' = L (getLoc lty1) prov + req' = L (getLoc lty2) req + mkDeprecatedGadtRecordDecl :: SrcSpan -> Located RdrName -> [ConDeclField RdrName] From git at git.haskell.org Sun Aug 31 11:05:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 11:05:59 +0000 (UTC) Subject: [commit: ghc] wip/T8584: PatSynSig: Add type variable binders (3defd32) Message-ID: <20140831110559.DF64B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/3defd32e5f56eebf6b9637f438b2d30cfca64201/ghc >--------------------------------------------------------------- commit 3defd32e5f56eebf6b9637f438b2d30cfca64201 Author: Dr. ERDI Gergo Date: Mon Jul 21 19:40:34 2014 +0800 PatSynSig: Add type variable binders >--------------------------------------------------------------- 3defd32e5f56eebf6b9637f438b2d30cfca64201 compiler/hsSyn/HsBinds.lhs | 8 ++++---- compiler/hsSyn/HsTypes.lhs | 19 +++++++++++++------ compiler/parser/RdrHsSyn.lhs | 10 ++++++---- compiler/rename/RnBinds.lhs | 17 +++++++++-------- 4 files changed, 32 insertions(+), 22 deletions(-) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index a90ea66..673a269 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -549,12 +549,12 @@ data Sig name TypeSig [Located name] (LHsType name) -- | A pattern synonym type signature - -- @pattern (Eq b) => P a b :: (Num a) => T a + -- @pattern type forall b. (Eq b) => P a b :: forall a. (Num a) => T a | PatSynSig (Located name) (HsPatSynDetails (LHsType name)) (LHsType name) -- Type - (LHsContext name) -- Provided context - (LHsContext name) -- Required contex + (HsExplicitFlag, LHsTyVarBndrs name, LHsContext name) -- Provided context + (HsExplicitFlag, LHsTyVarBndrs name, LHsContext name) -- Required contex -- | A type signature for a default method inside a class -- @@ -710,7 +710,7 @@ ppr_sig (SpecSig var ty inl) = pragBrackets (pprSpec (unLoc var) (ppr ty) i ppr_sig (InlineSig var inl) = pragBrackets (ppr inl <+> pprPrefixOcc (unLoc var)) ppr_sig (SpecInstSig ty) = pragBrackets (ptext (sLit "SPECIALIZE instance") <+> ppr ty) ppr_sig (MinimalSig bf) = pragBrackets (pprMinimalSig bf) -ppr_sig (PatSynSig name arg_tys ty prov req) +ppr_sig (PatSynSig name arg_tys ty (_, _, prov) (_, _, req)) = pprPatSynSig (unLoc name) False args (ppr ty) (pprCtx prov) (pprCtx req) where args = fmap ppr arg_tys diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index 14837f6..9777e0d 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -31,7 +31,7 @@ module HsTypes ( hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames, splitLHsInstDeclTy_maybe, splitHsClassTy_maybe, splitLHsClassTy_maybe, - splitHsFunType, splitLHsForAllTy, + splitHsFunType, splitLHsForAllTyFlag, splitLHsForAllTy, splitHsAppTys, hsTyGetAppHead_maybe, mkHsAppTys, mkHsOpTy, -- Printing @@ -485,15 +485,22 @@ splitLHsInstDeclTy_maybe inst_ty = do (cls, tys) <- splitLHsClassTy_maybe ty return (tvs, cxt, cls, tys) +splitLHsForAllTyFlag + :: LHsType name + -> (HsExplicitFlag, LHsTyVarBndrs name, HsContext name, LHsType name) +splitLHsForAllTyFlag poly_ty + = case unLoc poly_ty of + HsParTy ty -> splitLHsForAllTyFlag ty + HsForAllTy flag tvs cxt ty -> (flag, tvs, unLoc cxt, ty) + _ -> (Implicit, emptyHsQTvs, [], poly_ty) + -- The type vars should have been computed by now, even if they were implicit + splitLHsForAllTy :: LHsType name -> (LHsTyVarBndrs name, HsContext name, LHsType name) splitLHsForAllTy poly_ty - = case unLoc poly_ty of - HsParTy ty -> splitLHsForAllTy ty - HsForAllTy _ tvs cxt ty -> (tvs, unLoc cxt, ty) - _ -> (emptyHsQTvs, [], poly_ty) - -- The type vars should have been computed by now, even if they were implicit + = let (_, tvs, cxt, ty) = splitLHsForAllTyFlag poly_ty + in (tvs, cxt, ty) splitHsClassTy_maybe :: HsType name -> Maybe (name, [LHsType name]) splitHsClassTy_maybe ty = fmap (\(L _ n, tys) -> (n, tys)) $ splitLHsClassTy_maybe (noLoc ty) diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 0d72cb1..2abcb08 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -491,7 +491,9 @@ toPatSynMatchGroup (L _ patsyn_name) (L _ decls) = -- and (Eq a) and (Num b) as the provided and required thetas (respectively) splitPatSynSig :: LHsType RdrName -> LHsType RdrName - -> P (Located RdrName, HsPatSynDetails (LHsType RdrName), LHsType RdrName, LHsContext RdrName, LHsContext RdrName) + -> P (Located RdrName, HsPatSynDetails (LHsType RdrName), LHsType RdrName, + (HsExplicitFlag, LHsTyVarBndrs RdrName, LHsContext RdrName), + (HsExplicitFlag, LHsTyVarBndrs RdrName, LHsContext RdrName)) splitPatSynSig lty1 lty2 = do (name, details) <- splitCon pat_ty details' <- case details of @@ -499,10 +501,10 @@ splitPatSynSig lty1 lty2 = do InfixCon ty1 ty2 -> return $ InfixPatSyn ty1 ty2 RecCon{} -> parseErrorSDoc (getLoc lty1) $ text "record syntax not supported for pattern synonym declarations:" $$ ppr lty1 - return (name, details', res_ty, prov', req') + return (name, details', res_ty, (ex_flag, ex_tvs, prov'), (univ_flag, univ_tvs, req')) where - (_, prov, pat_ty) = splitLHsForAllTy lty1 - (_, req, res_ty) = splitLHsForAllTy lty2 + (ex_flag, ex_tvs, prov, pat_ty) = splitLHsForAllTyFlag lty1 + (univ_flag, univ_tvs, req, res_ty) = splitLHsForAllTyFlag lty2 prov' = L (getLoc lty1) prov req' = L (getLoc lty2) req diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index 807a05c..f649e27 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -831,15 +831,15 @@ renameSig ctxt sig@(MinimalSig bf) = do new_bf <- traverse (lookupSigOccRn ctxt sig) bf return (MinimalSig new_bf, emptyFVs) -renameSig ctxt sig@(PatSynSig v args ty prov req) +renameSig ctxt sig@(PatSynSig v args ty (ex_flag, _ex_tvs, prov) (univ_flag, _univ_tvs, req)) = do { v' <- lookupSigOccRn ctxt sig v ; let doc = TypeSigCtx $ quotes (ppr v) ; loc <- getSrcSpanM - ; let (ty_kvs, ty_tvs) = extractHsTysRdrTyVars (ty:unLoc req) - ; let ty_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ ty_tvs + ; let (univ_kvs, univ_tvs) = extractHsTysRdrTyVars (ty:unLoc req) + ; let univ_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ univ_tvs - ; bindHsTyVars doc Nothing ty_kvs ty_tv_bndrs $ \ _new_tyvars -> do + ; bindHsTyVars doc Nothing univ_kvs univ_tv_bndrs $ \ univ_tyvars -> do { (req', fvs1) <- rnContext doc req ; (ty', fvs2) <- rnLHsType doc ty @@ -855,14 +855,15 @@ renameSig ctxt sig@(PatSynSig v args ty prov req) (ty2', fvs2) <- rnLHsType doc ty2 return (InfixPatSyn ty1' ty2', fvs1 `plusFV` fvs2) in ([ty1, ty2], rnArgs) - ; let (arg_kvs, arg_tvs) = extractHsTysRdrTyVars (arg_tys ++ unLoc prov) - ; let arg_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ arg_tvs + ; let (ex_kvs, ex_tvs) = extractHsTysRdrTyVars (arg_tys ++ unLoc prov) + ; let ex_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ ex_tvs - ; bindHsTyVars doc Nothing arg_kvs arg_tv_bndrs $ \ _new_tyvars -> do + ; bindHsTyVars doc Nothing ex_kvs ex_tv_bndrs $ \ ex_tyvars -> do { (prov', fvs3) <- rnContext doc prov ; (args', fvs4) <- rnArgs - ; return (PatSynSig v' args' ty' prov' req', plusFVs [fvs1, fvs2, fvs3, fvs4]) }}} + ; return (PatSynSig v' args' ty' (ex_flag, ex_tyvars, prov') (univ_flag, univ_tyvars, req'), + plusFVs [fvs1, fvs2, fvs3, fvs4]) }}} ppr_sig_bndrs :: [Located RdrName] -> SDoc ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs) From git at git.haskell.org Sun Aug 31 11:06:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 11:06:02 +0000 (UTC) Subject: [commit: ghc] wip/T8584: Show foralls (when requested) in pattern synonym types (14a7ab7) Message-ID: <20140831110602.7385B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/14a7ab72f1eab0a38c3edcc56902a435de4c2e7f/ghc >--------------------------------------------------------------- commit 14a7ab72f1eab0a38c3edcc56902a435de4c2e7f Author: Dr. ERDI Gergo Date: Sun Aug 3 15:26:13 2014 +0200 Show foralls (when requested) in pattern synonym types >--------------------------------------------------------------- 14a7ab72f1eab0a38c3edcc56902a435de4c2e7f compiler/hsSyn/HsBinds.lhs | 21 ++++++--------------- compiler/iface/IfaceSyn.lhs | 9 +++++---- 2 files changed, 11 insertions(+), 19 deletions(-) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index 673a269..74b5187 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -710,24 +710,18 @@ ppr_sig (SpecSig var ty inl) = pragBrackets (pprSpec (unLoc var) (ppr ty) i ppr_sig (InlineSig var inl) = pragBrackets (ppr inl <+> pprPrefixOcc (unLoc var)) ppr_sig (SpecInstSig ty) = pragBrackets (ptext (sLit "SPECIALIZE instance") <+> ppr ty) ppr_sig (MinimalSig bf) = pragBrackets (pprMinimalSig bf) -ppr_sig (PatSynSig name arg_tys ty (_, _, prov) (_, _, req)) +ppr_sig (PatSynSig name arg_tys ty prov req) = pprPatSynSig (unLoc name) False args (ppr ty) (pprCtx prov) (pprCtx req) where args = fmap ppr arg_tys - pprCtx lctx = case unLoc lctx of - [] -> Nothing - ctx -> Just (pprHsContextNoArrow ctx) + pprCtx (flag, tvs, lctx) = pprHsForAll flag tvs lctx pprPatSynSig :: (OutputableBndr a) - => a -> Bool -> HsPatSynDetails SDoc -> SDoc -> Maybe SDoc -> Maybe SDoc -> SDoc -pprPatSynSig ident is_bidir args rhs_ty prov_theta req_theta - = sep [ ptext (sLit "pattern") - , ptext (sLit "type") - , thetaOpt prov_theta, name_and_args - , colon - , thetaOpt req_theta, rhs_ty - ] + => a -> Bool -> HsPatSynDetails SDoc -> SDoc -> SDoc -> SDoc -> SDoc +pprPatSynSig ident is_bidir args rhs_ty prov req + = ptext (sLit "pattern type") <+> + prov <+> name_and_args <+> colon <+> req <+> rhs_ty where name_and_args = case args of PrefixPatSyn arg_tys -> @@ -735,9 +729,6 @@ pprPatSynSig ident is_bidir args rhs_ty prov_theta req_theta InfixPatSyn left_ty right_ty -> left_ty <+> pprInfixOcc ident <+> right_ty - -- TODO: support explicit foralls - thetaOpt = maybe empty (<+> darrow) - colon = if is_bidir then dcolon else dcolon -- TODO instance OutputableBndr name => Outputable (FixitySig name) where diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index 935b8ed..e595266 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -771,11 +771,13 @@ pprIfaceDecl ss (IfaceSyn { ifName = tycon, ifTyVars = tyvars pprIfaceDecl _ (IfacePatSyn { ifName = name, ifPatWrapper = wrapper, ifPatIsInfix = is_infix, - ifPatUnivTvs = _univ_tvs, ifPatExTvs = _ex_tvs, + ifPatUnivTvs = univ_tvs, ifPatExTvs = ex_tvs, ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt, ifPatArgs = args, ifPatTy = ty }) - = pprPatSynSig name has_wrap args' ty' (pprCtxt prov_ctxt) (pprCtxt req_ctxt) + = pprPatSynSig name has_wrap args' ty' + (pprCtxt ex_tvs prov_ctxt) + (pprCtxt univ_tvs req_ctxt) where has_wrap = isJust wrapper args' = case (is_infix, args) of @@ -786,8 +788,7 @@ pprIfaceDecl _ (IfacePatSyn { ifName = name, ifPatWrapper = wrapper, ty' = pprParendIfaceType ty - pprCtxt [] = Nothing - pprCtxt ctxt = Just $ pprIfaceContext ctxt + pprCtxt tvs ctxt = pprIfaceForAllPart tvs ctxt empty pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty, ifIdDetails = details, ifIdInfo = info }) From git at git.haskell.org Sun Aug 31 11:06:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 11:06:04 +0000 (UTC) Subject: [commit: ghc] wip/T8584: universially-bound tyvars are in scope when renaming existentially-bound tyvars in a pattern synonym signature (494cdec) Message-ID: <20140831110604.E9F4C24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/494cdec622a1ff5b07f4abe563f71bbddda6890f/ghc >--------------------------------------------------------------- commit 494cdec622a1ff5b07f4abe563f71bbddda6890f Author: Dr. ERDI Gergo Date: Mon Jul 28 16:42:30 2014 +0200 universially-bound tyvars are in scope when renaming existentially-bound tyvars in a pattern synonym signature >--------------------------------------------------------------- 494cdec622a1ff5b07f4abe563f71bbddda6890f compiler/rename/RnBinds.lhs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index f649e27..666a270 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -56,6 +56,7 @@ import Data.List ( partition, sort ) import Maybes ( orElse ) import Control.Monad import Data.Traversable ( traverse ) +import Util ( filterOut ) \end{code} -- ToDo: Put the annotations into the monad, so that they arrive in the proper @@ -855,10 +856,14 @@ renameSig ctxt sig@(PatSynSig v args ty (ex_flag, _ex_tvs, prov) (univ_flag, _un (ty2', fvs2) <- rnLHsType doc ty2 return (InfixPatSyn ty1' ty2', fvs1 `plusFV` fvs2) in ([ty1, ty2], rnArgs) + ; let (ex_kvs, ex_tvs) = extractHsTysRdrTyVars (arg_tys ++ unLoc prov) - ; let ex_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ ex_tvs + ex_kvs' = filterOut (`elem` univ_kvs) ex_kvs + ex_tvs' = filterOut (`elem` univ_tvs) ex_tvs + + ; let ex_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ ex_tvs' - ; bindHsTyVars doc Nothing ex_kvs ex_tv_bndrs $ \ ex_tyvars -> do + ; bindHsTyVars doc Nothing ex_kvs' ex_tv_bndrs $ \ ex_tyvars -> do { (prov', fvs3) <- rnContext doc prov ; (args', fvs4) <- rnArgs From git at git.haskell.org Sun Aug 31 11:06:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 11:06:07 +0000 (UTC) Subject: [commit: ghc] wip/T8584: Add TcPatSynInfo as a separate type (same pattern as PatSynBind being a separate type) (bba5041) Message-ID: <20140831110607.65EA624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/bba5041c19e067a316195354474ddb405137a37c/ghc >--------------------------------------------------------------- commit bba5041c19e067a316195354474ddb405137a37c Author: Dr. ERDI Gergo Date: Sun Aug 31 19:04:17 2014 +0800 Add TcPatSynInfo as a separate type (same pattern as PatSynBind being a separate type) >--------------------------------------------------------------- bba5041c19e067a316195354474ddb405137a37c compiler/typecheck/TcBinds.lhs | 19 ++++++++++--------- compiler/typecheck/TcPat.lhs | 22 ++++++++++++++++------ compiler/typecheck/TcPatSyn.lhs | 11 ++++++----- compiler/typecheck/TcPatSyn.lhs-boot | 6 ++---- 4 files changed, 34 insertions(+), 24 deletions(-) diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 8ee53db..86f3cb5 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -431,11 +431,9 @@ tc_single _top_lvl sig_fn _prag_fn (L _ (PatSynBind psb at PSB{ psb_id = L _ name } } where tc_pat_syn_decl = case sig_fn name of - Nothing -> - tcInferPatSynDecl psb - Just TcPatSynInfo{ patsig_tau = tau, patsig_prov = prov, patsig_req = req } -> - tcCheckPatSynDecl psb tau prov req - Just _ -> panic "tc_single" + Nothing -> tcInferPatSynDecl psb + Just (TcPatSynInfo tpsi) -> tcCheckPatSynDecl psb tpsi + Just _ -> panic "tc_single" tc_single top_lvl sig_fn prag_fn lbind thing_inside = do { (binds1, ids, closed) <- tcPolyBinds top_lvl sig_fn prag_fn @@ -1318,10 +1316,13 @@ tcTySig (L loc (PatSynSig (L _ name) args ty (_, ex_tvs, prov) (_, univ_tvs, req InfixPatSyn ty1 ty2 -> [ty1, ty2] ; prov' <- tcHsContext prov ; traceTc "tcTySig" $ ppr ty' $$ ppr args' $$ ppr (ex_tvs', prov') $$ ppr (univ_tvs', req') - ; return [TcPatSynInfo{ patsig_name = name, - patsig_tau = mkFunTys args' ty', - patsig_prov = (ex_tvs', prov'), - patsig_req = (univ_tvs', req') }]}}} + ; let tpsi = TPSI{ patsig_name = name, + patsig_tau = mkFunTys args' ty', + patsig_ex = ex_tvs', + patsig_prov = prov', + patsig_univ = univ_tvs', + patsig_req = req' } + ; return [TcPatSynInfo tpsi]}}} tcTySig _ = return [] instTcTySigFromId :: SrcSpan -> Id -> TcM TcSigInfo diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs index c044e31..7ca4fdb 100644 --- a/compiler/typecheck/TcPat.lhs +++ b/compiler/typecheck/TcPat.lhs @@ -15,7 +15,8 @@ TcPat: Typechecking patterns -- for details module TcPat ( tcLetPat, TcSigFun, TcPragFun - , TcSigInfo(..), findScopedTyVars + , TcSigInfo(..), TcPatSynInfo(..) + , findScopedTyVars , LetBndrSpec(..), addInlinePrags, warnPrags , tcPat, tcPats, newNoSigLetBndr , addDataConStupidTheta, badFieldCon, polyPatSig ) where @@ -158,11 +159,16 @@ data TcSigInfo sig_loc :: SrcSpan -- The location of the signature } - | TcPatSynInfo { + | TcPatSynInfo TcPatSynInfo + +data TcPatSynInfo + = TPSI { patsig_name :: Name, patsig_tau :: TcSigmaType, - patsig_prov :: ([TcTyVar], TcThetaType), - patsig_req :: ([TcTyVar], TcThetaType) + patsig_ex :: [TcTyVar], + patsig_prov :: TcThetaType, + patsig_univ :: [TcTyVar], + patsig_req :: TcThetaType } findScopedTyVars -- See Note [Binding scoped type variables] @@ -185,13 +191,17 @@ findScopedTyVars hs_ty sig_ty inst_tvs instance NamedThing TcSigInfo where getName TcSigInfo{ sig_id = id } = idName id - getName TcPatSynInfo { patsig_name = name } = name + getName (TcPatSynInfo tpsi) = patsig_name tpsi instance Outputable TcSigInfo where ppr (TcSigInfo { sig_id = id, sig_tvs = tyvars, sig_theta = theta, sig_tau = tau}) = ppr id <+> dcolon <+> vcat [ pprSigmaType (mkSigmaTy (map snd tyvars) theta tau) , ppr (map fst tyvars) ] - ppr (TcPatSynInfo { patsig_name = name}) = text "TcPatSynInfo" <+> ppr name + ppr (TcPatSynInfo tpsi) = text "TcPatSynInfo" <+> ppr tpsi + +instance Outputable TcPatSynInfo where + ppr (TPSI{ patsig_name = name}) = ppr name + \end{code} Note [Binding scoped type variables] diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs index 3ae6303..e60cfb6 100644 --- a/compiler/typecheck/TcPatSyn.lhs +++ b/compiler/typecheck/TcPatSyn.lhs @@ -92,14 +92,15 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details, ; return (patSyn, matcher_bind) } tcCheckPatSynDecl :: PatSynBind Name Name - -> TcType - -> ([TyVar], ThetaType) -> ([TyVar], ThetaType) + -> TcPatSynInfo -> TcM (PatSyn, LHsBinds Id) tcCheckPatSynDecl PSB{ psb_id = lname@(L loc name), psb_args = details, psb_def = lpat, psb_dir = dir } - tau (ex_tvs, prov_theta) (univ_tvs, req_theta) - = do { tcCheckPatSynPat lpat - + TPSI{ patsig_tau = tau, + patsig_ex = ex_tvs, patsig_univ = univ_tvs, + patsig_prov = prov_theta, patsig_req = req_theta } + = setSrcSpan loc $ + do { tcCheckPatSynPat lpat ; prov_dicts <- newEvVars prov_theta ; req_dicts <- newEvVars req_theta diff --git a/compiler/typecheck/TcPatSyn.lhs-boot b/compiler/typecheck/TcPatSyn.lhs-boot index 2129c33..1b2356a 100644 --- a/compiler/typecheck/TcPatSyn.lhs-boot +++ b/compiler/typecheck/TcPatSyn.lhs-boot @@ -6,15 +6,13 @@ import Id ( Id ) import HsSyn ( PatSynBind, LHsBinds ) import TcRnTypes ( TcM ) import PatSyn ( PatSyn ) -import TcType ( TcType, ThetaType ) -import Var ( TyVar ) +import TcPat ( TcPatSynInfo ) tcInferPatSynDecl :: PatSynBind Name Name -> TcM (PatSyn, LHsBinds Id) tcCheckPatSynDecl :: PatSynBind Name Name - -> TcType - -> ([TyVar], ThetaType) -> ([TyVar], ThetaType) + -> TcPatSynInfo -> TcM (PatSyn, LHsBinds Id) tcPatSynWrapper :: PatSynBind Name Name From git at git.haskell.org Sun Aug 31 11:06:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 11:06:09 +0000 (UTC) Subject: [commit: ghc] wip/T8584: WIP #STASH (5505920) Message-ID: <20140831110609.D0ECF24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/5505920db97ec7e3e9b8643b6c37d9dee3e8c6cf/ghc >--------------------------------------------------------------- commit 5505920db97ec7e3e9b8643b6c37d9dee3e8c6cf Author: Dr. ERDI Gergo Date: Sun Aug 31 19:05:19 2014 +0800 WIP #STASH >--------------------------------------------------------------- 5505920db97ec7e3e9b8643b6c37d9dee3e8c6cf compiler/typecheck/TcBinds.lhs | 18 ++++--- compiler/typecheck/TcPatSyn.lhs | 113 ++++++++++++++++++++++++++++------------ 2 files changed, 92 insertions(+), 39 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5505920db97ec7e3e9b8643b6c37d9dee3e8c6cf From git at git.haskell.org Sun Aug 31 11:06:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 11:06:12 +0000 (UTC) Subject: [commit: ghc] wip/T8584's head updated: WIP #STASH (5505920) Message-ID: <20140831110613.063E524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T8584' now includes: 6640635 Fix variable name typo from commit 3021fb b06e83d Make mod73 test insensitive to minor variations (#9325) a2439c7 Add .gitignore line for stage=1 testsuite generated file 1837b2f comment update da70f9e Allow multiple entry points when allocating recursive groups (#9303) ab8f254 Comments and white space 49333bf Comments and minor refactoring 6fa6caa Compiler perf has improved a bit a0ff1eb [backpack] Package selection 0be7c2c Comments and white space dc7d3c2 Test Trac #9380 7381cee Add a fast-path in TcInteract.kickOutRewritable fe2d807 Comments only bfaa179 Add comments about the {-# INCOHERENT #-} for Typeable (f a) 1ae5fa4 Complete work on new OVERLAPPABLE/OVERLAPPING pragmas (Trac #9242) c97f853 Typo in comment fd47e26 Fix up ghci044 bdf0ef0 Minor wordsmithing of comments 58ed1cc Small tweaks to comment 1c1ef82 Typo fixes 52188ad Unbreak build. 3b9fe0c refactor to fix 80column overflow 6483b8a panic message fix 9d9a554 interruptible() was not returning true for BlockedOnSTM (#9379) 028630a Fix reference to note aab5937 update comment 6c06db1 add a comment 2989ffd A panic in CmmBuildInfoTables.bundle shouldn't be a panic (#9329) d4d4bef Improve the desugaring of RULES, esp those from SPECIALISE pragmas 8df7fea Bump haddock.base max_bytes_used 3faff73 [backpack] More revisions to various pieces. 0336588 Two new executables to ignore. 02975c9 Fix-up to d4d4bef2 'Improve the desugaring of RULES' 578fbec Dont allow hand-written Generic instances in Safe Haskell. e69619e Allow warning if could have been infered safe instead of explicit Trustworthy label. 105602f Update Safe Haskell typeable test outputs. fbd0586 Infer safety of modules correctly with new overlapping pragmas. ab90bf2 Add in (disabled for now) test of a Safe Haskell bug. f293931 Add missing *.stderr files 44853a1 Terminate in forkProcess like in real_main df1e775 docs: fix typo: 'OVERLAPPINGP' -> 'OVERLAPPING' 637978f Use 'install' command for 'inplace/' install as we do in 'make install' 65e5dbc fix linker_unload test on Solaris/i386 platform f686682 ghc --make: add nicer names to RTS threads (threaded IO manager, make workers) 7328deb fix openFile003 test on Solaris/i386 (platform output is not needed anymore) 1f24a03 fix topHandler03 execution on Solaris where shell signals SIGTERM correctly edff1ef Disable package auto-hiding if -hide-all-packages is passed 66218d1 Package keys (for linking/type equality) separated from package IDs. 3663791 Disable ghc-pkg accepting multiple package IDs (differing package keys) for now. de3f064 Make PackageState an abstract type. 00b8f8c Refactor package state, also fixing a module reexport bug. 4accf60 Refactor PackageFlags so that ExposePackage is a single constructor. 2078752 Thinning and renaming modules from packages on the command line. 94b2b22 [no-ci] Minor bugfixes in Backpack docs. 7479df6 configure.ac: drop unused VOID_INT_SIGNALS 56ca32c Update Haddock submodule to know about profiling. d360d44 Filter out null bytes from trace, and warn accordingly, fixing #9395. c88559b Temporarily bump Haddock numbers; I'm going to fix it. 8e400d2 Revert "fix linker_unload test on Solaris/i386 platform" f4904fb Mark type-rep not as expect_broken when debugged f42fa9b fix linker_unload test _FILE_OFFSET_BITS redefined warning on Solaris/i386 2b3c621 fix linker_unload test for ghc configurations with --with-gmp-libraries 24a2e49 fix T658b/T5776 to use POSIX grep -c instead of GNU's --count 61baf71 Comments and white space 31399be Move Outputable instance for FloatBind to the data type definition d3fafbb Tiny refactoring, plus comments; no change in behaviour 93b1a43 Add Output instance for OrdList 6b96557 Make Core Lint check the let/app invariant 1736082 Don't float into unlifted function arguments 1fc60ea When desugaring Use the smart mkCoreConApps and friends d174f49 Make buildToArrPReprs obey the let/app invariant db17d58 Document the maintenance of the let/app invariant in the simplifier ab6480b Extensive Notes on can_fail and has_side_effects 8367f06 Refactor the handling of case-elimination 0957a9b Add has_side_effets to the raise# primop 2990e97 Test Trac #9390 18ac546 Fix some typos in recent comments/notes 4855be0 Give the Unique generated by strings a tag '$', fixes #9413. d026e9e Permanently accept the Haddock performance number bump, and add some TODOs c51498b [no-ci] Track Haddock submodule change: ignore TAGS. af1fc53 ghci: tweak option list indentation in ':show packages' 2cca0c0 testsuite: add signal_exit_code function to the driver d0ee4eb Update perf number for T5642 7d52e62 Update Haddock to attoparsec-0.12.1. Adjust perf. dff0623 Implement the final change to INCOHERENT from Trac #9242 ca3fc66 Fix path in cabal file 16776e9 configure.ac: drop unused HAVE_BIN_SH a2ac57b Tweak Haddock markup in GHC.Magic 4e020b3 Tweak Haddock in GHC.Types 44c1e3f testsuite: add list of llvm_ways caa9c8aa Add test case for #9013 8e01ca6 Remove obsolete "-- #hide" Haddock pragmas b7b7633 Add a test for plusWord2#, addIntC#, subIntC# e83e873 Clarify documentation of addIntC#, subIntC# 3260467 systools info: fix warning about C compiler (message said about linker) ba9277c Tweak linting rules. 02be4ff fix T4201 to avoid GNU grep specific -B option by usage of pure POSIX tools 2396940 fix T4981-V3 and T9208 tests for no newline at end of file warning ba3650c fix T4981-V3 to avoid DOS line endings bb00308 Don't build or test dph by default 238fd05 change topHandler02/topHandler03 tests to use signal_exit_code function 7a754a9 rts/Printer.c: drop zcode mangling/demangling support in C code b02fa3b rts: Remove trailing whitespace and tabs from Printer.c 8d90ffa fix darwin threaded static linking by removing -lpthread option #9189 cbfa107 Improve seq documentation; part of trac issue #9390 c80d238 Eliminate some code duplication in x86 backend (genCCall32/64) 5f5d662 Make IntAddCOp, IntSubCOp into GenericOps 71bd4e3 x86: Always generate add instruction in MO_Add2 (#9013) 8e64151 stg/Prim.h: drop redundant #ifdef 6e3c44e Unbreak travis by not passing --no-dph 0a3944c testsuite/base: update .gitignore 3694d87 Re-add `--no-dph` option to ./validate 3669b60 Add bit scan {forward,reverse} insns to x86 NCG 9f285fa Add CMOVcc insns to x86 NCG 6415191 x86: zero extend the result of 16-bit popcnt instructions (#9435) a09508b Test #9371 (indexed-types/should_fail/T9371) f29bdfb Fix Trac #9371. 1b13886 Fix #9415. 1a3e19d Test #9415 (typecheck/should_fail/T9415) 8d27c76 Test #9200. (polykinds/T9200) 6485930 Change definition of CUSK for data and class definitions (#9200). 3dfd3c3 Added more testing for #9200. (polykinds/T9200b) b2c6167 Change treatment of CUSKs for synonyms and families (#9200). 578377c Remove NonParametricKinds (#9200) 1c66b3d Update manual (#9200). 91a48c5 Testsuite wibbles around #9200 6f862df shouldInlinePrimOp: Fix Int overflow a6fd7b5 Add some Haddocks to SMRep 4342049 StgCmmPrim: add note to stop using fixed size signed types for sizes 5e46e1f Have ghc-pkg use an old-style package key when it's not provided. 2272c50 Explicitly version test for package key support. 6b5ea61 Remove out of date TODO e0c1767 Implement new CLZ and CTZ primops (re #9340) 03a8003 Declare `ghc-head` to be haddock's upstream branch 5895f2b LlvmMangler: Be more selective when mangling object types d39c434 Make configure's sed(1) expression for GHC_LDFLAGS more BSD-friendly. 246436f Implement {resize,shrink}MutableByteArray# primops 425d517 Fix typos 'resizze' 53cc943 Revert "Fix typos 'resizze'" this is z-encoding (as hvr tells me) 6375934 Workaround GCC `__ctzdi2` intrinsic linker errors 96d0418 Remove obsolete `digitsTyConKey :: Unique` 2d42564 workaround Solaris 11 GNU C CPP issue by using GNU C 3.4 as CPP 2aabda1 Fix quasi-quoter documentation (#9448) daef885 Fix broken link in Data.Data to SYB home page (Trac #9455) b287bc9 Update list of flags implied by -XGADTs in User's Guide section on GADTs a72614c Make T8832 operative on 32-bit systems (#8832) 3a67aba ghci/scripts/ghci016: Add implementation for negate 5b11b04 concurrent/should_run/throwto002: DoRec -> RecursiveDo 5d5655e Fix three problems with occurrence analysis on case alternatives. 88b1f99 testsuite/T9379: Use GHC.Conc instead of Control.Concurrent.STM 6f6ee6e Make Prelude.abs handle -0.0 correctly (#7858) d9a2057 Make Prelude.signum handle -0.0 correctly (#7858) bbd0311 Bug #9439: Ensure that stage 0 compiler isn't affected 9a708d3 UNREG: fix PackageKey emission into .hc files 0138110 Implement -rdynamic in Linux and Windows/MinGW32. d2f0100 Have the RTS linker search symbols in the originating windows binary. 955dfcb This note's name has been fixed 4333a91 includes/stg/Prim.h: add matching 'hs_atomic_*' prototypes e3c3586 Use absolute links to Cabal docs from the GHC users guide (#9154) 89f5f31 Explain how to clone GitHub forks. Ticket #8379. 2fc2294 Mention that `Data.Ix` uses row-major indexing 527bcc4 build: require GHC 7.6 for bootstrapping defc42e Add test case for #9046 806d823 Correct checkStrictBinds for generalised type 7012ed8 Check if file is present instead of directory 51a0b60 travis: Use hvr?s multi-ghc-PPA f9f89b7 rts/base: Fix #9423 f328890 validate: add simple CPU count autodetection 15faa0e Fix prepositions in the documentation of -rdynamic. 7bf49f8 Make sure that a prototype is included for 'setIOManagerControlFd' 27c99a1 Comments fix to Trac #9140 11f05c5 coreSyn: detabify/dewhitespace TrieMap 236e2ea stranal: detabify/dewhitespace WorkWrap 96c3599 simplCore: detabify/dewhitespace SAT fb9bc40 utils: detabify/dewhitespace BufWrite a9f5c81 utils: detabify/dewhitespace GraphBase e3a5bad utils: detabify/dewhitespace GraphPpr 6f01f0b simplCore: detabify/dewhitespace SetLevels 28a8cd1 simplCore: detabify/dewhitespace LiberateCase ef9dd9f prelude: detabify/dewhitespace TysPrim fbdc21b coreSyn: detabify/dewhitespace CoreTidy ffc1afe coreSyn: detabify/dewhitespace CoreSubst 8396e44 deSugar: detabify/dewhitespace DsCCall 07d01c9 stranal: detabify/dewhitespace DmdAnal 8a8ead0 hsSyn: detabify/dewhitespace HsLit 99f6224 basicTypes: detabify/dewhitespace Var 1ad35f4 basicTypes: detabify/dewhitespace NameSet 1b55153 basicTypes: detabify/dewhitespace NameEnv 37743a1 basicTypes: detabify/dewhitespace IdInfo a2d2546 genprimopcode: Don't output tabs 067bb0d Update a comment in base cbits 92bb7be Add a missing newline to a GHCi linker debugBelch ff4f844 rts: detabify/dewhitespace Ticky.c b4c7bcd rts: detabify/dewhitespace Weak.c dea58de rts: detabify/dewhitespace Updates.h 514a631 rts: detabify/dewhitespace Timer.c 43c68d6 rts: detabify/dewhitespace Trace.c 221c231 rts: detabify/dewhitespace STM.c c49f2e7 rts: reflow some comments in STM.c 4cbf966 rts: detabify/dewhitespace Task.c 684be04 rts: detabify/dewhitespace sm/Storage.h f20708c rts: detabify/dewhitespace sm/BlockAlloc.c 2f3649e rts: detabify/dewhitespace sm/MarkWeak.c 08093a9 rts: detabify/dewhitespace sm/GCAux.c 7e60787 rts: detabify/dewhitespace sm/GCUtils.h 7318aab rts: detabify/dewhitespace sm/GCUtils.c b7b427f rts: detabify/dewhitespace sm/MBlock.c 870cca8 rts: detabify/dewhitespace Apply.cmm 93ec914 rts: detabify/dewhitespace Hpc.c 219785b rts: detabify/dewhitespace Printer.h ee0e47d rts: detabify/dewhitespace Task.h c71ab57 rts: detabify/dewhitespace AutoApply.h ef02edc rts: detabify/dewhitespace StgStdThunks.cmm 1a6a610 rts: detabify/dewhitespace StgStartup.cmm 2f34ab2 rts: detabify/dewhitespace StgPrimFloat.c 584d459 rts: detabify/dewhitespace StgPrimFloat.h 7d48356 rts: detabify/dewhitespace Sparks.c 8f3611e rts: detabify/dewhitespace RtsMain.c b9ee7e8 rts: detabify/dewhitespace RtsAPI.c 00878c5 rts: detabify/dewhitespace RtsStartup.c 646f214 rts: detabify/dewhitespace RtsUtils.c f2864e9 rts: detabify/dewhitespace Disassembler.c 7200edf rts: detabify/dewhitespace LdvProfile.c 15df6d9 Comment why the include is necessary c867cbc [ci skip] includes: detabify/dewhitespace Stg.h 772ffbe [ci skip] includes: detabify/dewhitespace RtsAPI.h 6f3dd98 [ci skip] includes: detabify/dewhitespace Rts.h a784afc [ci skip] includes: detabify/dewhitespace HsFFI.h e183e35 [ci skip] includes: detabify/dewhitespace Cmm.h e232967 [ci skip] includes: detabify/dewhitespace stg/Regs.h efcf0ab [ci skip] includes: detabify/dewhitespace stg/SMP.h e7dd073 [ci skip] includes: detabify/dewhitespace stg/Types.h c607500 [ci skip] includes: detabify/dewhitespace rts/Ticky.h a739416 [ci skip] includes: detabify/dewhitespace rts/Threads.h 2957736 [ci skip] includes: detabify/dewhitespace rts/Stable.h 7d26398 [ci skip] includes: detabify/dewhitespace rts/OSThreads.h bb70e33 [ci skip] includes: detabify/dewhitespace rts/Hpc.h 1c43f62 [ci skip] includes: detabify/dewhitespace rts/prof/CCS.h f20c663 [ci skip] includes: detabify/dewhitespace rts/prof/LDV.h aa045e5 [ci skip] includes: detabify/dewhitespace rts/storage/MBlock.h e57a29a [ci skip] includes: detabify/dewhitespace rts/storage/TSO.h f6cdf04 [ci skip] includes: detabify/dewhitespace rts/storage/Closures.h b4ec067 [ci skip] includes: detabify/dewhitespace rts/storage/GC.h e9e3cf5 [ci skip] includes: detabify/dewhitespace rts/storage/Block.h 98b1b13 [ci skip] includes: detabify/dewhitespace rts/storage/InfoTables.h 840a1cb includes: detabify/dewhitespace rts/storage/ClosureMacros.h 955db0d T8832: fix no newline at end of file warning 030549a Fix #9465. f9e9e71 gitignore: Ignore tests/rts/rdynamic bf1b117 submodule update hpc/stm with gitignore. 22520cd Do not zero out version number when processing wired-in packages. 4748f59 Revert "rts/base: Fix #9423" 2719526 Normalise GHC version number to make tests less fragile. d333c03 Enable GHC API tests by default. ff9f4ad testsuite: T7815 requires SMP support from ghc fcdd58d testsuite: disable gcc's warnings about casts of incompatible prototypes in UNREG eb64be7 testsuite: disable memcpy asm comparison tests on UNREG 2fcb36e testsuite: mark testwsdeque mark as faulty on NOSMP builds 104a66a rts/Linker.c: declare 'deRefStablePtr' as an exported 'rts' symbol cfd08a9 Add MO_AddIntC, MO_SubIntC MachOps and implement in X86 backend e1d77a1 testsuite: added 'bytes allocated' for T9339 wordsize(32) 78ba9f0 Declare official GitHub home of libraries/{directory,process} 5295cd2 testsuite: add 16-byte case for T9329 9f8754e Use DumpStyle rather than UserStyle for pprTrace output c0fe1d9 Introduce the Call data types af4bc31 Do not duplicate call information in SpecConstr (Trac #8852) 5c4df28 More refactoring in SpecConstr 8ff4671 Make Core Lint check for un-saturated type applications ee4501b Check for un-saturated type family applications 06600e7 Two buglets in record wild-cards (Trac #9436 and #9437) 67a6ade Improve documentation of record wildcards 43f1b2e UNREG: fix emission of large Integer literals in C codegen a93ab43 driver: pass '-fPIC' option to assembler as well 78863ed Revert "disable shared libs on sparc (linux/solaris) (fixes #8857)" e9cd1d5 Less voluminous output when printing continuations 6e0f6ed Refactor unfoldings 3af1adf Kill unused setUnfoldingTemplate 8f09937 Make maybeUnfoldingTemplate respond to DFunUnfoldings 9cf5906 Make worker/wrapper work on INLINEABLE things 4c03791 Specialise Eq, Ord, Read, Show at Int, Char, String 3436333 Move the Enum Word instance into GHC.Enum 949ad67 Don't float out (classop dict e1 e2) 2ef997b Slightly improve fusion rules for 'take' 99178c1 Specialise monad functions, and make them INLINEABLE baa3c9a Wibbles to "...plus N others" error message about instances in scope a3e207f More SPEC rules fire dce7095 Compiler performance increases -- yay! b9e49d3 Add -fspecialise-aggressively fa582cc Fix an egregious bug in the NonRec case of bindFreeVars 6d48ce2 Make tidyProgram discard speculative specialisation rules 86a2ebf Comments only 1122857 Run float-inwards immediately before the strictness analyser. 082e41b Testsuite wibbles bb87726 Performance changes a0b2897 Simple refactor of the case-of-case transform 6c6b001 Remove dead lookup_dfun_id (merge-o) 39ccdf9 White space only a1a400e Testsuite wibbles 1145568 testsuite: disable T367_letnoescape on 'optllvm' 75d998b testsuite: disable 'rdynamic' for 'ghci' way 94926b1 Add an interesting type-family/GADT example of deletion for red-black trees 87c1568 Comments only b7bdf13 Temporary fix to the crash aa49892 [ci skip] ghc-prim: Update .gitignore 8270ff3 [ci skip] Update .gitignore 9072f2f PprC: cleanup: don't emit 'FB_' / 'FE_' in via-C 49370ce Improve trimming of auto-rules 4a87142 Fix syntax in perf/compiler/all.T 7eae141 White space only 2da63c6 Better compiler performance (30% less allocation) for T783! dfc9d30 Define mapUnionVarSet, and use it 8df3159 Rename red-black test in indexed-types to red-black-delete db5868c In GHC.Real, specialise 'even' and 'odd' to Int and Integer 9fae691 Improve "specImport discarding" message b2affa0 Testsuite wibbles 69e9f6e Simplify conversion in binary serialisation of ghc-pkg db 557c8b8 Drop support for single-file style package databases ce29a26 Improve the ghc-pkg warnings for missing and out of date package cache files 8d7a1dc Introduce new file format for the package database binary cache 27d6c08 Use ghc-local types for packages, rather than Cabal types 0af7d0c Move Cabal Binary instances from bin-package-db to ghc-pkg itself 9597a25 Drop ghc library dep on Cabal 227205e Make binary a boot package 6930a88 Fix warnings arising from the package db refactoring 29f84d3 Fix long lines and trailing whitespace 8955b5e Remove a TODO that is now done a4cb9a6 Add a ghc -show-packages mode to display ghc's view of the package env 1bc2a55 Make mkFastStringByteString pure and fix up uses c72efd7 Switch the package id types to use FastString (rather than String) b00deb7 Fix string conversions in ghc-pkg to be correct w.r.t. Unicode 42f99e9 Address a number of Edward's code review comments 9d6fbcc Fix validation error in Linker arising from package rep changes 01461ce Update Cabal and haddock submodules to follow the Canal-dep removal changes da72898 Change testsuite to not use old-style file package databases 616dd87 Fix a few minor issues spotted in code review 6d8c70c Add release notes about ghc-pkg change, and Cabal dep removal 020bd49 Fix failing test on BINDIST=YES cb2ac47 Suppress binary warnings for bootstrapping as well as stage1. f0db185 Include pattern synonyms as AConLikes in the type environment, even for simplified/boot ModDetails (fixes #9417) 4e0e774 Fix a bug in CSE, for INLINE/INLNEABLE things ab4c27e Comments, white space, and rename "InlineRule" to "stable unfolding" 3521c50 When finding loop breakers, distinguish INLINE from INLINEABLE 7af33e9 Better specImport discarding message (again) e5f766c Give the worker for an INLINABLE function a suitably-phased Activation 3935062 Finally! Test Trac #6056 5da580b Performance improvement of the compiler itself fa9dd06 Do not say we cannot when we clearly can 9491fea Typos in comments eac8728 Fix to bin-package-db for ming32-only code 9874f3c Update baseline shift/reduce conflict number 1b08992 Add parser for pattern synonym type signatures. Syntax is of the form c98a7fd Renamer for PatSynSigs: handle type variable bindings 3defd32 PatSynSig: Add type variable binders 7fd7f6d Split tcPatSynDecl into inferring function and general workhorse function a4fa9fe Add TcPatSynInfo to store the typechecked representation of a pattern synonym type signature 494cdec universially-bound tyvars are in scope when renaming existentially-bound tyvars in a pattern synonym signature 14a7ab7 Show foralls (when requested) in pattern synonym types bba5041 Add TcPatSynInfo as a separate type (same pattern as PatSynBind being a separate type) 5505920 WIP #STASH From git at git.haskell.org Sun Aug 31 11:18:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 11:18:45 +0000 (UTC) Subject: [commit: ghc] wip/T8584: WIP #STASH (3c78f61) Message-ID: <20140831111845.14BF624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T8584 Link : http://ghc.haskell.org/trac/ghc/changeset/3c78f610c253485e6f25a907ed93cae060a21f8f/ghc >--------------------------------------------------------------- commit 3c78f610c253485e6f25a907ed93cae060a21f8f Author: Dr. ERDI Gergo Date: Sun Aug 31 19:05:19 2014 +0800 WIP #STASH >--------------------------------------------------------------- 3c78f610c253485e6f25a907ed93cae060a21f8f compiler/rename/RnBinds.lhs | 0 compiler/typecheck/TcBinds.lhs | 18 ++++--- compiler/typecheck/TcPatSyn.lhs | 111 ++++++++++++++++++++++++++++------------ 3 files changed, 91 insertions(+), 38 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3c78f610c253485e6f25a907ed93cae060a21f8f From git at git.haskell.org Sun Aug 31 14:28:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 14:28:04 +0000 (UTC) Subject: [commit: ghc] master: Add `FiniteBits(count{Leading, Trailing}Zeros)` (a8a969a) Message-ID: <20140831142804.87F3024121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a8a969ae7a05e408b29961d0a2ea621a16d73d3e/ghc >--------------------------------------------------------------- commit a8a969ae7a05e408b29961d0a2ea621a16d73d3e Author: Herbert Valerio Riedel Date: Thu Aug 14 12:32:32 2014 +0200 Add `FiniteBits(count{Leading,Trailing}Zeros)` This exposes the newly added CLZ/CTZ primops from e0c1767d0ea8d12e0a4badf43682a08784e379c6 (re #9340) via two new methods `countLeadingZeros` and `countTrailingZeros` in the `Data.Bits.FiniteBits` class. The original proposal can be found at http://www.haskell.org/pipermail/libraries/2014-August/023567.html Test Plan: successful validate Reviewers: ekmett, tibbe GHC Trac Issues: #9532 Differential Revision: https://phabricator.haskell.org/D158 >--------------------------------------------------------------- a8a969ae7a05e408b29961d0a2ea621a16d73d3e libraries/base/Data/Bits.hs | 72 ++++++++++++++++- libraries/base/GHC/Int.hs | 13 ++++ libraries/base/GHC/Word.hs | 8 ++ libraries/base/changelog.md | 3 + libraries/base/tests/.gitignore | 1 + libraries/base/tests/T9532.hs | 89 ++++++++++++++++++++++ .../base/tests/T9532.stdout | 0 libraries/base/tests/all.T | 1 + 8 files changed, 185 insertions(+), 2 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a8a969ae7a05e408b29961d0a2ea621a16d73d3e From git at git.haskell.org Sun Aug 31 14:28:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 31 Aug 2014 14:28:06 +0000 (UTC) Subject: [commit: ghc] master: `M-x delete-trailing-whitespace` & `M-x untabify`... (737f368) Message-ID: <20140831142807.1759D24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/737f36823d03a6c9d92f56e3e2433a3961780e13/ghc >--------------------------------------------------------------- commit 737f36823d03a6c9d92f56e3e2433a3961780e13 Author: Herbert Valerio Riedel Date: Sun Aug 31 16:05:26 2014 +0200 `M-x delete-trailing-whitespace` & `M-x untabify`... ...some files more or less recently touched by me [ci skip] >--------------------------------------------------------------- 737f36823d03a6c9d92f56e3e2433a3961780e13 compiler/cmm/PprC.hs | 0 compiler/coreSyn/MkCore.lhs | 41 ++++++++++++++++----------------- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 0 compiler/main/DynFlags.hs | 0 compiler/nativeGen/X86/Instr.hs | 0 compiler/prelude/PrelNames.lhs | 1 - ghc/InteractiveUI.hs | 1 - ghc/Main.hs | 0 libraries/base/Data/Bits.hs | 7 +++--- libraries/base/Data/Fixed.hs | 1 - libraries/base/GHC/Int.hs | 8 +++---- libraries/base/Prelude.hs | 0 12 files changed, 27 insertions(+), 32 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 737f36823d03a6c9d92f56e3e2433a3961780e13