From git at git.haskell.org Sat Feb 1 09:42:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Feb 2014 09:42:00 +0000 (UTC) Subject: [commit: packages/integer-gmp] ghc-7.8's head updated: Improve documentation of `integer-gmp` (9744cfb) Message-ID: <20140201094200.9F2D12406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/integer-gmp Branch 'ghc-7.8' now includes: 9744cfb Improve documentation of `integer-gmp` From git at git.haskell.org Sat Feb 1 10:50:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Feb 2014 10:50:27 +0000 (UTC) Subject: [commit: packages/integer-gmp] master: Add Hackage-supported `changelog.md` (747a360) Message-ID: <20140201105027.A554A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/integer-gmp On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/747a360bf09b6c3c851ac6c884ee769180a71db7/integer-gmp >--------------------------------------------------------------- commit 747a360bf09b6c3c851ac6c884ee769180a71db7 Author: Herbert Valerio Riedel Date: Sat Feb 1 11:46:33 2014 +0100 Add Hackage-supported `changelog.md` Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 747a360bf09b6c3c851ac6c884ee769180a71db7 changelog.md | 44 ++++++++++++++++++++++++++++++++++++++++++++ integer-gmp.cabal | 1 + 2 files changed, 45 insertions(+) diff --git a/changelog.md b/changelog.md new file mode 100644 index 0000000..9be79f6 --- /dev/null +++ b/changelog.md @@ -0,0 +1,44 @@ +# Changelog for [`integer-gmp` package](http://hackage.haskell.org/package/integer-gmp) + +## 0.5.1.0 *Feb 2014* + + * Bundled with GHC 7.8.1 + + * Improved Haddock documentation + + * New [PrimBool](https://ghc.haskell.org/trac/ghc/wiki/PrimBool) + versions of comparision predicates in `GHC.Integer`: + + eqInteger# :: Integer -> Integer -> Int# + geInteger# :: Integer -> Integer -> Int# + gtInteger# :: Integer -> Integer -> Int# + leInteger# :: Integer -> Integer -> Int# + ltInteger# :: Integer -> Integer -> Int# + neqInteger# :: Integer -> Integer -> Int# + + * New `GHC.Integer.testBitInteger` primitive for use with `Data.Bits` + + * Reduce short-lived heap allocation and try to demote `J#` back + to `S#` more aggressively. See also + [#8647](https://ghc.haskell.org/trac/ghc/ticket/8647) + for more details. + + * New GMP-specific binary (de)serialization primitives added to + `GHC.Integer.GMP.Internals`: + + importIntegerFromByteArray + importIntegerFromAddr + exportIntegerToAddr + exportIntegerToMutableByteArray + sizeInBaseInteger + + * New GMP-implemented number-theoretic operations added to + `GHC.Integer.GMP.Internals`: + + gcdExtInteger + nextPrimeInteger + testPrimeInteger + powInteger + powModInteger + powModSecInteger + recipModInteger diff --git a/integer-gmp.cabal b/integer-gmp.cabal index ed1242f..2473ccb 100644 --- a/integer-gmp.cabal +++ b/integer-gmp.cabal @@ -27,6 +27,7 @@ extra-source-files: cbits/float.c cbits/gmp-wrappers.cmm cbits/longlong.c + changelog.md config.guess config.sub configure From git at git.haskell.org Sat Feb 1 10:54:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Feb 2014 10:54:24 +0000 (UTC) Subject: [commit: packages/integer-gmp] ghc-7.8's head updated: Add Hackage-supported `changelog.md` (747a360) Message-ID: <20140201105424.8AD442406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/integer-gmp Branch 'ghc-7.8' now includes: 747a360 Add Hackage-supported `changelog.md` From git at git.haskell.org Sat Feb 1 13:04:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Feb 2014 13:04:38 +0000 (UTC) Subject: [commit: ghc] master: Remove some references to deprecated -fglasgow-exts in user's guide (a2269bf) Message-ID: <20140201130438.48F332406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a2269bf81c8e95ad9a1bc3c32e425fdba7c3686a/ghc >--------------------------------------------------------------- commit a2269bf81c8e95ad9a1bc3c32e425fdba7c3686a Author: Krzysztof Gogolewski Date: Sat Feb 1 14:03:34 2014 +0100 Remove some references to deprecated -fglasgow-exts in user's guide >--------------------------------------------------------------- a2269bf81c8e95ad9a1bc3c32e425fdba7c3686a docs/users_guide/flags.xml | 13 +++++-------- docs/users_guide/glasgow_exts.xml | 4 +--- 2 files changed, 6 insertions(+), 11 deletions(-) diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index 3a69c8f..b054fd9 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -706,7 +706,7 @@ - Enable most language extensions; see for exactly which ones. + Deprecated. Enable most language extensions; see for exactly which ones. dynamic @@ -802,8 +802,7 @@ - Enable foreign function interface (implied by - ) + Enable foreign function interface. dynamic @@ -831,8 +830,7 @@ - Enable Implicit Parameters. - Implied by . + Enable Implicit Parameters. dynamic @@ -947,14 +945,13 @@ Enable lexically-scoped type variables. - Implied by . + dynamic - Enable Template Haskell. - No longer implied by . + Enable Template Haskell. dynamic diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 5117417..60f8acf 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -8212,9 +8212,7 @@ Wiki page. constructions. You need to use the flag - to switch these syntactic extensions on - ( is no longer implied by - ). + to switch these syntactic extensions on. From git at git.haskell.org Sat Feb 1 13:07:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Feb 2014 13:07:10 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Remove some references to deprecated -fglasgow-exts in user's guide (26942db) Message-ID: <20140201130710.7834B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/26942dbf47dc6d1d076869b963de9501d27a040b/ghc >--------------------------------------------------------------- commit 26942dbf47dc6d1d076869b963de9501d27a040b Author: Krzysztof Gogolewski Date: Sat Feb 1 14:03:34 2014 +0100 Remove some references to deprecated -fglasgow-exts in user's guide >--------------------------------------------------------------- 26942dbf47dc6d1d076869b963de9501d27a040b docs/users_guide/flags.xml | 13 +++++-------- docs/users_guide/glasgow_exts.xml | 4 +--- 2 files changed, 6 insertions(+), 11 deletions(-) diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index 3a69c8f..b054fd9 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -706,7 +706,7 @@ - Enable most language extensions; see for exactly which ones. + Deprecated. Enable most language extensions; see for exactly which ones. dynamic @@ -802,8 +802,7 @@ - Enable foreign function interface (implied by - ) + Enable foreign function interface. dynamic @@ -831,8 +830,7 @@ - Enable Implicit Parameters. - Implied by . + Enable Implicit Parameters. dynamic @@ -947,14 +945,13 @@ Enable lexically-scoped type variables. - Implied by . + dynamic - Enable Template Haskell. - No longer implied by . + Enable Template Haskell. dynamic diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 5117417..60f8acf 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -8212,9 +8212,7 @@ Wiki page. constructions. You need to use the flag - to switch these syntactic extensions on - ( is no longer implied by - ). + to switch these syntactic extensions on. From git at git.haskell.org Sat Feb 1 13:37:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Feb 2014 13:37:52 +0000 (UTC) Subject: [commit: ghc] master: Loopification jump between stack and heap checks (ea584ab) Message-ID: <20140201133752.C1E062406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ea584ab634b17b499138bc44dbec777de7357c19/ghc >--------------------------------------------------------------- commit ea584ab634b17b499138bc44dbec777de7357c19 Author: Jan Stolarek Date: Sat Feb 1 11:32:25 2014 +0100 Loopification jump between stack and heap checks Fixes #8585 When emmiting label of a self-recursive tail call (ie. when performing loopification optimization) we emit the loop header label after a stack check but before the heap check. The reason is that tail-recursive functions use constant amount of stack space so we don't need to repeat the check in every loop. But they can grow the heap so heap check must be repeated in every call. See Note [Self-recursive tail calls] and [Self-recursive loop header]. >--------------------------------------------------------------- ea584ab634b17b499138bc44dbec777de7357c19 compiler/codeGen/StgCmmBind.hs | 14 +++++--------- compiler/codeGen/StgCmmExpr.hs | 16 +++++++++++----- compiler/codeGen/StgCmmHeap.hs | 37 +++++++++++++++++++++++++++++++++++-- 3 files changed, 51 insertions(+), 16 deletions(-) diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 2336792..344e80a 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -472,25 +472,21 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details \(_offset, node, arg_regs) -> do -- Emit slow-entry code (for entering a closure through a PAP) { mkSlowEntryCode bndr cl_info arg_regs - ; dflags <- getDynFlags ; let node_points = nodeMustPointToIt dflags lf_info node' = if node_points then Just node else Nothing - -- Emit new label that might potentially be a header - -- of a self-recursive tail call. See Note - -- [Self-recursive tail calls] in StgCmmExpr ; loop_header_id <- newLabelC - ; emitLabel loop_header_id - ; when node_points (ldvEnterClosure cl_info (CmmLocal node)) -- Extend reader monad with information that -- self-recursive tail calls can be optimized into local - -- jumps + -- jumps. See Note [Self-recursive tail calls] in StgCmmExpr. ; withSelfLoop (bndr, loop_header_id, arg_regs) $ do { -- Main payload ; entryHeapCheck cl_info node' arity arg_regs $ do - { -- ticky after heap check to avoid double counting - tickyEnterFun cl_info + { -- emit LDV code when profiling + when node_points (ldvEnterClosure cl_info (CmmLocal node)) + -- ticky after heap check to avoid double counting + ; tickyEnterFun cl_info ; enterCostCentreFun cc (CmmMachOp (mo_wordSub dflags) [ CmmReg (CmmLocal node) -- See [NodeReg clobbered with loopification] diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index cc32a14..d94eca4 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -737,10 +737,16 @@ cgIdApp fun_id args = do -- -- * Whenever we are compiling a function, we set that information to reflect -- the fact that function currently being compiled can be jumped to, instead --- of called. We also have to emit a label to which we will be jumping. Both --- things are done in closureCodyBody in StgCmmBind. +-- of called. This is done in closureCodyBody in StgCmmBind. -- --- * When we began compilation of another closure we remove the additional +-- * We also have to emit a label to which we will be jumping. We make sure +-- that the label is placed after a stack check but before the heap +-- check. The reason is that making a recursive tail-call does not increase +-- the stack so we only need to check once. But it may grow the heap, so we +-- have to repeat the heap check in every self-call. This is done in +-- do_checks in StgCmmHeap. +-- +-- * When we begin compilation of another closure we remove the additional -- information from the environment. This is done by forkClosureBody -- in StgCmmMonad. Other functions that duplicate the environment - -- forkLneBody, forkAlts, codeOnly - duplicate that information. In other @@ -755,8 +761,8 @@ cgIdApp fun_id args = do -- arity. (d) loopification is turned on via -floopification command-line -- option. -- --- * Command line option to control turn loopification on and off is --- implemented in DynFlags +-- * Command line option to turn loopification on and off is implemented in +-- DynFlags. -- diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index 55ddfd4..077b780 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -531,7 +531,7 @@ heapStackCheckGen stk_hwm mb_bytes lretry <- newLabelC emitLabel lretry call <- mkCall generic_gc (GC, GC) [] [] updfr_sz [] - do_checks stk_hwm False mb_bytes (call <*> mkBranch lretry) + do_checks stk_hwm False mb_bytes (call <*> mkBranch lretry) -- Note [Single stack check] -- ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -615,13 +615,22 @@ do_checks mb_stk_hwm checkYield mb_alloc_lit do_gc = do Nothing -> return () Just stk_hwm -> tickyStackCheck >> (emit =<< mkCmmIfGoto (sp_oflo stk_hwm) gc_id) + -- Emit new label that might potentially be a header + -- of a self-recursive tail call. + -- See Note [Self-recursive loop header]. + self_loop_info <- getSelfLoop + case self_loop_info of + Just (_, loop_header_id, _) + | checkYield && isJust mb_stk_hwm -> emitLabel loop_header_id + _otherwise -> return () + if (isJust mb_alloc_lit) then do tickyHeapCheck emitAssign hpReg bump_hp emit =<< mkCmmIfThen hp_oflo (alloc_n <*> mkBranch gc_id) else do - when (not (gopt Opt_OmitYields dflags) && checkYield) $ do + when (checkYield && not (gopt Opt_OmitYields dflags)) $ do -- Yielding if HpLim == 0 let yielding = CmmMachOp (mo_wordEq dflags) [CmmReg (CmmGlobal HpLim), @@ -637,3 +646,27 @@ do_checks mb_stk_hwm checkYield mb_alloc_lit do_gc = do -- stack check succeeds. Otherwise we might end up -- with slop at the end of the current block, which can -- confuse the LDV profiler. + +-- Note [Self-recursive loop header] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Self-recursive loop header is required by loopification optimization (See +-- Note [Self-recursive tail calls] in StgCmmExpr). We emit it if: +-- +-- 1. There is information about self-loop in the FCode environment. We don't +-- check the binder (first component of the self_loop_info) because we are +-- certain that if the self-loop info is present then we are compiling the +-- binder body. Reason: the only possible way to get here with the +-- self_loop_info present is from closureCodeBody. +-- +-- 2. checkYield && isJust mb_stk_hwm. checkYield tells us that it is possible +-- to preempt the heap check (see #367 for motivation behind this check). It +-- is True for heap checks placed at the entry to a function and +-- let-no-escape heap checks but false for other heap checks (eg. in case +-- alternatives or created from hand-written high-level Cmm). The second +-- check (isJust mb_stk_hwm) is true for heap checks at the entry to a +-- function and some heap checks created in hand-written Cmm. Otherwise it +-- is Nothing. In other words the only situation when both conditions are +-- true is when compiling stack and heap checks at the entry to a +-- function. This is the only situation when we want to emit a self-loop +-- label. From git at git.haskell.org Sat Feb 1 15:48:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Feb 2014 15:48:51 +0000 (UTC) Subject: [commit: ghc] master: Remove unnecessary LANGUAGE pragma (c6ce808) Message-ID: <20140201154851.DB3B62406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c6ce808845cc9e403a6bd210930f8d7943b189e2/ghc >--------------------------------------------------------------- commit c6ce808845cc9e403a6bd210930f8d7943b189e2 Author: Jan Stolarek Date: Sat Feb 1 15:39:09 2014 +0100 Remove unnecessary LANGUAGE pragma >--------------------------------------------------------------- c6ce808845cc9e403a6bd210930f8d7943b189e2 compiler/cmm/CmmPipeline.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs index 5c2d54d..98b398f 100644 --- a/compiler/cmm/CmmPipeline.hs +++ b/compiler/cmm/CmmPipeline.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE NoMonoLocalBinds #-} --- Norman likes local bindings --- If this module lives on I'd like to get rid of this extension in due course - module CmmPipeline ( -- | Converts C-- with an implicit stack and native C-- calls into -- optimized, CPS converted and native-call-less C--. The latter @@ -383,4 +379,3 @@ dumpWith dflags flag txt g = do dumpIfSet_dyn dflags flag txt (ppr g) when (not (dopt flag dflags)) $ dumpIfSet_dyn dflags Opt_D_dump_cmm txt (ppr g) - From git at git.haskell.org Sat Feb 1 19:04:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Feb 2014 19:04:31 +0000 (UTC) Subject: [commit: ghc] master: Simplify Control Flow Optimisations Cmm pass (99c3ed8) Message-ID: <20140201190431.E4B002406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/99c3ed81ac53629771b00a0abbe37c989ea45cd6/ghc >--------------------------------------------------------------- commit 99c3ed81ac53629771b00a0abbe37c989ea45cd6 Author: Jan Stolarek Date: Sat Feb 1 18:00:48 2014 +0100 Simplify Control Flow Optimisations Cmm pass It turns out that one of the cases in the optimization pass was a special case of another. I remove that specialization since it does not have impact on compilation time, and the resulting Cmm is identical. >--------------------------------------------------------------- 99c3ed81ac53629771b00a0abbe37c989ea45cd6 compiler/cmm/CmmContFlowOpt.hs | 37 +++++++++---------------------------- 1 file changed, 9 insertions(+), 28 deletions(-) diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs index 52b95a9..4b8ce6f 100644 --- a/compiler/cmm/CmmContFlowOpt.hs +++ b/compiler/cmm/CmmContFlowOpt.hs @@ -46,25 +46,20 @@ import Prelude hiding (succ, unzip, zip) -- Note [Control-flow optimisations] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- --- This optimisation does four things: +-- This optimisation does three things: -- -- - If a block finishes in an unconditonal branch to another block -- and that is the only jump to that block we concatenate the -- destination block at the end of the current one. -- --- - If a block finishes in an unconditional branch, we may be able --- to shortcut the destination block. --- -- - If a block finishes in a call whose continuation block is a -- goto, then we can shortcut the destination, making the -- continuation block the destination of the goto - but see Note -- [Shortcut call returns]. -- --- - For block finishing in conditional branch we try to invert the --- condition and shortcut destination of alternatives. --- -- - For any block that is not a call we try to shortcut the --- destination(s). +-- destination(s). Additionally, if a block ends with a +-- conditional branch we try to invert the condition. -- -- Blocks are processed using postorder DFS traversal. A side effect -- of determining traversal order with a graph search is elimination @@ -204,11 +199,8 @@ blockConcat splitting_procs g at CmmGraph { g_entry = entry_id } -- (2) remove b' from the map of blocks -- (3) remove information about b' from predecessors map -- - -- This guard must be first so that we always eliminate blocks that have - -- only one predecessor. If we had a target block that is both - -- shorcutable and has only one predecessor and attempted to shortcut it - -- first we would make that block unreachable but would not remove it - -- from the graph. + -- Since we know that the block has only one predecessor we call + -- mapDelete directly instead of calling decPreds. -- -- Note that we always maintain an up-to-date list of predecessors, so -- we can ignore the contents of shortcut_map @@ -221,20 +213,6 @@ blockConcat splitting_procs g at CmmGraph { g_entry = entry_id } , mapDelete b' backEdges ) -- If: - -- (1) current block ends with unconditional branch to b' and - -- (2) we can shortcut block b' - -- Then: - -- (1) concatenate b' at the end of current block, effectively - -- changing target of uncondtional jump from b' to dest - -- (2) increase number of predecessors of dest by 1 - -- (3) decrease number of predecessors of b' by 1 - | CmmBranch b' <- last - , Just blk' <- mapLookup b' blocks - , Just dest <- canShortcut blk' - = ( mapInsert bid (splice head blk') blocks, shortcut_map, - decPreds b' $ incPreds dest backEdges ) - - -- If: -- (1) we are splitting proc points (see Note -- [Shortcut call returns and proc-points]) and -- (2) current block is a CmmCall or CmmForeignCall with @@ -263,7 +241,10 @@ blockConcat splitting_procs g at CmmGraph { g_entry = entry_id } -- conditional -- (2) attempt to shortcut all destination blocks -- (3) if new successors of a block are different from the old ones - -- we update the of predecessors accordingly + -- update the of predecessors accordingly + -- + -- A special case of this is a situation when a block ends with an + -- unconditional jump to a block that can be shortcut. | Nothing <- callContinuation_maybe last = let oldSuccs = successors last newSuccs = successors swapcond_last From git at git.haskell.org Sat Feb 1 19:04:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Feb 2014 19:04:34 +0000 (UTC) Subject: [commit: ghc] master: Nuke dead code (78afa20) Message-ID: <20140201190434.435B62406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/78afa2078e474c9e8fd3d0f347c5652f296d5248/ghc >--------------------------------------------------------------- commit 78afa2078e474c9e8fd3d0f347c5652f296d5248 Author: Jan Stolarek Date: Sat Feb 1 19:15:06 2014 +0100 Nuke dead code * CmmRewriteAddignments module was replaced by CmmSink a long time ago. That module is now available at https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/Hoopl/Examples wiki page. * removeDeadAssignments function was not used and it was also moved to the above page. * I also nuked some commented out debugging code that was not used for 1,5 year. >--------------------------------------------------------------- 78afa2078e474c9e8fd3d0f347c5652f296d5248 compiler/cmm/CmmLayoutStack.hs | 29 +- compiler/cmm/CmmLive.hs | 28 -- compiler/cmm/CmmRewriteAssignments.hs | 628 --------------------------------- compiler/ghc.cabal.in | 1 - 4 files changed, 5 insertions(+), 681 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 78afa2078e474c9e8fd3d0f347c5652f296d5248 From git at git.haskell.org Sat Feb 1 20:23:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Feb 2014 20:23:09 +0000 (UTC) Subject: [commit: packages/integer-gmp] master: Fix a popular typo (753bb06) Message-ID: <20140201202309.D45042406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/integer-gmp On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/753bb061971b06c2560a9f2a55a1fbed76efb7bc/integer-gmp >--------------------------------------------------------------- commit 753bb061971b06c2560a9f2a55a1fbed76efb7bc Author: Gabor Greif Date: Sat Feb 1 21:16:55 2014 +0100 Fix a popular typo Herbert, this is a merge candidate to the 7.8 branch >--------------------------------------------------------------- 753bb061971b06c2560a9f2a55a1fbed76efb7bc changelog.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/changelog.md b/changelog.md index 9be79f6..28e662b 100644 --- a/changelog.md +++ b/changelog.md @@ -7,7 +7,7 @@ * Improved Haddock documentation * New [PrimBool](https://ghc.haskell.org/trac/ghc/wiki/PrimBool) - versions of comparision predicates in `GHC.Integer`: + versions of comparison predicates in `GHC.Integer`: eqInteger# :: Integer -> Integer -> Int# geInteger# :: Integer -> Integer -> Int# From git at git.haskell.org Sat Feb 1 20:24:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Feb 2014 20:24:57 +0000 (UTC) Subject: [commit: packages/base] master: Fix a popular typo (b6a8e69) Message-ID: <20140201202457.C5FDD2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b6a8e69e2d60dc3b11142e593e2e9e1458c70acf/base >--------------------------------------------------------------- commit b6a8e69e2d60dc3b11142e593e2e9e1458c70acf Author: Gabor Greif Date: Sat Feb 1 21:24:36 2014 +0100 Fix a popular typo >--------------------------------------------------------------- b6a8e69e2d60dc3b11142e593e2e9e1458c70acf GHC/IO/Buffer.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GHC/IO/Buffer.hs b/GHC/IO/Buffer.hs index b17e326..e069555 100644 --- a/GHC/IO/Buffer.hs +++ b/GHC/IO/Buffer.hs @@ -88,7 +88,7 @@ import Foreign.Storable -- the Iconv codec, but there are some pieces that are known to be -- broken. In particular, the built-in codecs -- e.g. GHC.IO.Encoding.UTF{8,16,32} need to use isFullCharBuffer or --- similar in place of the ow >= os comparisions. +-- similar in place of the ow >= os comparisons. -- --------------------------------------------------------------------------- -- Raw blocks of data From git at git.haskell.org Sat Feb 1 20:28:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Feb 2014 20:28:33 +0000 (UTC) Subject: [commit: ghc] master: Fix a popular typo in comments (d5fb670) Message-ID: <20140201202833.5AF512406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d5fb6709df641010fb50bd120abd10257f4691b7/ghc >--------------------------------------------------------------- commit d5fb6709df641010fb50bd120abd10257f4691b7 Author: Gabor Greif Date: Sat Feb 1 21:26:23 2014 +0100 Fix a popular typo in comments >--------------------------------------------------------------- d5fb6709df641010fb50bd120abd10257f4691b7 compiler/basicTypes/Demand.lhs | 2 +- compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs | 2 +- compiler/nativeGen/SPARC/CodeGen/Gen32.hs | 2 +- compiler/simplCore/Simplify.lhs | 2 +- compiler/typecheck/TcGenDeriv.lhs | 2 +- compiler/types/Type.lhs | 2 +- docs/coding-style.html | 2 +- docs/storage-mgt/rp.tex | 2 +- 8 files changed, 8 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index 9607a15..e415c6d 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -960,7 +960,7 @@ this has a strictness signature of meaning that "b2 `seq` ()" and "b2 1 `seq` ()" might well terminate, but for "b2 1 2 `seq` ()" we get definite divergence. -For comparision, +For comparison, b1 x = x `seq` error (show x) has a strictness signature of b diff --git a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs index df3c7d6..b5006ec 100644 --- a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs +++ b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs @@ -30,7 +30,7 @@ import Panic -- (which are disjoint) ie. x86, x86_64 and ppc -- -- The number of allocatable regs is hard coded in here so we can do --- a fast comparision in trivColorable. +-- a fast comparison in trivColorable. -- -- It's ok if these numbers are _less_ than the actual number of free -- regs, but they can't be more or the register conflict diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs index 43b792a..df876b4 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs @@ -606,7 +606,7 @@ coerceFlt2Dbl x = do -- Condition Codes ------------------------------------------------------------- -- --- Evaluate a comparision, and get the result into a register. +-- Evaluate a comparison, and get the result into a register. -- -- Do not fill the delay slots here. you will confuse the register allocator. -- diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index 3873ed3..129f6ef 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -1699,7 +1699,7 @@ This includes things like (==# a# b#)::Bool so that we simplify to just x This particular example shows up in default methods for -comparision operations (e.g. in (>=) for Int.Int32) +comparison operations (e.g. in (>=) for Int.Int32) Note [Case elimination: lifted case] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs index 3852106..c8b203e 100644 --- a/compiler/typecheck/TcGenDeriv.lhs +++ b/compiler/typecheck/TcGenDeriv.lhs @@ -276,7 +276,7 @@ Several special cases: Note [Do not rely on compare] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's a bad idea to define only 'compare', and build the other binary -comparisions on top of it; see Trac #2130, #4019. Reason: we don't +comparisons on top of it; see Trac #2130, #4019. Reason: we don't want to laboriously make a three-way comparison, only to extract a binary result, something like this: (>) (I# x) (I# y) = case <# x y of diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index 0abe463..b8edc3e 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -1179,7 +1179,7 @@ seqTypes (ty:tys) = seqType ty `seq` seqTypes tys %************************************************************************ %* * - Comparision for types + Comparison for types (We don't use instances so that we know where it happens) %* * %************************************************************************ diff --git a/docs/coding-style.html b/docs/coding-style.html index 37aaf8d..6be9263 100644 --- a/docs/coding-style.html +++ b/docs/coding-style.html @@ -324,7 +324,7 @@ can be "polymorphic" as these examples show: #define PROF_INFO(cl) (((StgClosure*)(cl))->header.profInfo) // polymorphic case - // but note that min(min(1,2),3) does 3 comparisions instead of 2!! + // but note that min(min(1,2),3) does 3 comparisons instead of 2!! #define min(x,y) (((x)<=(y)) ? (x) : (y)) diff --git a/docs/storage-mgt/rp.tex b/docs/storage-mgt/rp.tex index 20e313b..0d841b9 100644 --- a/docs/storage-mgt/rp.tex +++ b/docs/storage-mgt/rp.tex @@ -1029,7 +1029,7 @@ execution of retainer profiling. \label{fig-cacheprof} \end{figure} -\section{Comparision with nhc} +\section{Comparison with nhc} \section{Files} From git at git.haskell.org Sat Feb 1 21:40:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Feb 2014 21:40:36 +0000 (UTC) Subject: [commit: packages/integer-gmp] ghc-7.8's head updated: Fix a popular typo (753bb06) Message-ID: <20140201214036.970002406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/integer-gmp Branch 'ghc-7.8' now includes: 753bb06 Fix a popular typo From git at git.haskell.org Sun Feb 2 08:44:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Feb 2014 08:44:10 +0000 (UTC) Subject: [commit: ghc] master: Remove redundant NoMonoLocalBinds pragma (f028975) Message-ID: <20140202084411.0D1E42406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f02897567c033f6657d9132215f73bcdc3cbac45/ghc >--------------------------------------------------------------- commit f02897567c033f6657d9132215f73bcdc3cbac45 Author: Jan Stolarek Date: Sun Feb 2 08:54:43 2014 +0100 Remove redundant NoMonoLocalBinds pragma >--------------------------------------------------------------- f02897567c033f6657d9132215f73bcdc3cbac45 compiler/cmm/CmmBuildInfoTables.hs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs index 04c3b71..d325817 100644 --- a/compiler/cmm/CmmBuildInfoTables.hs +++ b/compiler/cmm/CmmBuildInfoTables.hs @@ -1,8 +1,4 @@ -{-# LANGUAGE GADTs, NoMonoLocalBinds #-} - --- Norman likes local bindings --- If this module lives on I'd like to get rid of the NoMonoLocalBinds --- extension in due course +{-# LANGUAGE GADTs #-} -- Todo: remove -fno-warn-warnings-deprecations {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} From git at git.haskell.org Sun Feb 2 08:44:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Feb 2014 08:44:13 +0000 (UTC) Subject: [commit: ghc] master: Remove unused import (b5c45d8) Message-ID: <20140202084413.61DFC2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b5c45d845389e7f76f609b89d984278469a674cd/ghc >--------------------------------------------------------------- commit b5c45d845389e7f76f609b89d984278469a674cd Author: Jan Stolarek Date: Sun Feb 2 08:55:50 2014 +0100 Remove unused import >--------------------------------------------------------------- b5c45d845389e7f76f609b89d984278469a674cd compiler/cmm/CmmLive.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs index e66ab73..e405fbe 100644 --- a/compiler/cmm/CmmLive.hs +++ b/compiler/cmm/CmmLive.hs @@ -14,7 +14,6 @@ module CmmLive ) where -import UniqSupply import DynFlags import BlockId import Cmm From git at git.haskell.org Sun Feb 2 13:17:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Feb 2014 13:17:03 +0000 (UTC) Subject: [commit: ghc] master: Add test-case for #8726 (5f64b2c) Message-ID: <20140202131703.0DBCE2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5f64b2c6e8f1799d7015098598f7d6e826707e6c/ghc >--------------------------------------------------------------- commit 5f64b2c6e8f1799d7015098598f7d6e826707e6c Author: Herbert Valerio Riedel Date: Sun Feb 2 12:08:06 2014 +0100 Add test-case for #8726 This tests various properties expected to hold for quotRem, divMod, div, mod, quot, and rem. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 5f64b2c6e8f1799d7015098598f7d6e826707e6c testsuite/tests/numeric/should_run/T8726.hs | 85 +++++++++++++++++++++++++++ testsuite/tests/numeric/should_run/all.T | 1 + 2 files changed, 86 insertions(+) diff --git a/testsuite/tests/numeric/should_run/T8726.hs b/testsuite/tests/numeric/should_run/T8726.hs new file mode 100644 index 0000000..ba5803a --- /dev/null +++ b/testsuite/tests/numeric/should_run/T8726.hs @@ -0,0 +1,85 @@ +import Control.Monad +import Data.Bits +import Data.List +import Data.Ord + +-- | test-values to use as numerator/denominator +posvals :: [Integer] +posvals = [1,2,3,4,5,9,10,14,15,16,17] ++ + [ n | e <- ([5..70]++[96,128,160,192,224]) + , ofs <- [-1..1], let n = bit e + ofs ] + +posvalsSum :: Integer +posvalsSum = 0x300000003000000030000000300000003000001800000000000000000 + +vals :: [Integer] +vals = sortBy (comparing abs) $ map negate posvals ++ [0] ++ posvals + + +main :: IO () +main = do + unless (sum posvals == posvalsSum) $ + fail $ "sum posvals == " ++ show (sum posvals) + + forM_ [ (n,d) | n <- vals, d <- vals, d /= 0 ] $ \(n,d) -> do + let check sp p = unless (p n d) $ fail (sp ++ " " ++ show n ++ " " ++ show d) + + check "rem0" prop_rem0 + check "mod0" prop_mod0 + + check "divMod0" prop_divMod0 + check "divMod1" prop_divMod1 + check "divMod2" prop_divMod2 + + check "quotRem0" prop_quotRem0 + check "quotRem1" prop_quotRem1 + check "quotRem2" prop_quotRem2 + + -- putStrLn "passed" + +-- QuickCheck style properties + +prop_rem0 :: Integer -> Integer -> Bool +prop_rem0 n d + | n >= 0 = (n `rem` d) `inside` (-1,abs d) + | otherwise = (n `rem` d) `inside` (-(abs d),1) + where + inside v (l,u) = l < v && v < u + +prop_mod0 :: Integer -> Integer -> Bool +prop_mod0 n d + | d >= 0 = (n `mod` d) `inside` (-1,d) + | otherwise = (n `mod` d) `inside` (d,1) + where + inside v (l,u) = l < v && v < u + +-- | Invariant from Haskell Report +prop_divMod0 :: Integer -> Integer -> Bool +prop_divMod0 n d = (n `div` d) * d + (n `mod` d) == n + +prop_divMod1 :: Integer -> Integer -> Bool +prop_divMod1 n d = divMod n d == (n `div` d, n `mod` d) + +-- | Compare IUT to implementation of 'divMod' in terms of 'quotRem' +prop_divMod2 :: Integer -> Integer -> Bool +prop_divMod2 n d = divMod n d == divMod' n d + where + divMod' x y = if signum r == negate (signum y) then (q-1, r+y) else qr + where qr@(q,r) = quotRem x y + +-- | Invariant from Haskell Report +prop_quotRem0 :: Integer -> Integer -> Bool +prop_quotRem0 n d = (n `quot` d) * d + (n `rem` d) == n + +prop_quotRem1 :: Integer -> Integer -> Bool +prop_quotRem1 n d = quotRem n d == (n `quot` d, n `rem` d) + +-- | Test symmetry properties of 'quotRem' +prop_quotRem2 :: Integer -> Integer -> Bool +prop_quotRem2 n d = (qr == negQ (quotRem n (-d)) && + qr == negR (quotRem (-n) (-d)) && + qr == (negQ . negR) (quotRem (-n) d)) + where + qr = quotRem n d + negQ (q,r) = (-q,r) + negR (q,r) = (q,-r) diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index 8f658de..3953fe6 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -61,3 +61,4 @@ test('T7014', test('T7233', normal, compile_and_run, ['']) test('NumDecimals', normal, compile_and_run, ['']) +test('T8726', normal, compile_and_run, ['']) From git at git.haskell.org Sun Feb 2 13:18:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Feb 2014 13:18:00 +0000 (UTC) Subject: [commit: packages/integer-gmp] master: Fix negation of `divMod`/`quotRem` results (fixes #8726) (2f841fd) Message-ID: <20140202131800.DC6492406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/integer-gmp On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f841fdf5b33c4eb32cfc5d1b8207585f1880d9a/integer-gmp >--------------------------------------------------------------- commit 2f841fdf5b33c4eb32cfc5d1b8207585f1880d9a Author: Herbert Valerio Riedel Date: Sun Feb 2 12:18:20 2014 +0100 Fix negation of `divMod`/`quotRem` results (fixes #8726) High-level pseudo code of what the code was supposed to implement: quotRem' :: Integer -> Integer -> (Integer,Integer) quotRem' a b@(S# _) | b < 0 = negFst . uncurry quotRem' . negSnd $ (a,b) | otherwise = quotRemUI a (fromIntegral (abs b)) divMod' :: Integer -> Integer -> (Integer,Integer) divMod' a b@(S# _) | b < 0 = negSnd . uncurry divMod' . negBoth $ (a,b) | otherwise = divModUI a (fromIntegral b) negFst (q,r) = (-q,r) negSnd (q,r) = ( q,-r) negBoth (q,r) = (-q,-r) -- quotRemUI and divModUI represent GMP's `mpz_{f,t}div_qr_ui()` quotRemUI, divModUI :: Integer -> Word -> (Integer,Integer) Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 2f841fdf5b33c4eb32cfc5d1b8207585f1880d9a GHC/Integer/Type.lhs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/GHC/Integer/Type.lhs b/GHC/Integer/Type.lhs index 8596562..3fb2ae6 100644 --- a/GHC/Integer/Type.lhs +++ b/GHC/Integer/Type.lhs @@ -296,9 +296,9 @@ quotRemInteger (S# i) (S# j) = case quotRemInt# i j of #if SIZEOF_HSWORD == SIZEOF_LONG quotRemInteger (J# s1 d1) (S# b) | isTrue# (b <# 0#) = case quotRemIntegerWord# s1 d1 (int2Word# (negateInt# b)) of - (# q, r #) -> let !q' = mpzToInteger(mpzNeg q) - !r' = mpzToInteger(mpzNeg r) - in (# q', r' #) + (# q, r #) -> let !q' = mpzToInteger (mpzNeg q) + !r' = mpzToInteger r + in (# q', r' #) -- see also Trac #8726 quotRemInteger (J# s1 d1) (S# b) = mpzToInteger2 (quotRemIntegerWord# s1 d1 (int2Word# b)) #else @@ -322,9 +322,9 @@ divModInteger (S# i) (S# j) = (# S# d, S# m #) #if SIZEOF_HSWORD == SIZEOF_LONG divModInteger (J# s1 d1) (S# b) | isTrue# (b <# 0#) = case divModIntegerWord# (negateInt# s1) d1 (int2Word# (negateInt# b)) of - (# q, r #) -> let !q' = mpzToInteger (mpzNeg q) - !r' = mpzToInteger r - in (# q', r' #) + (# q, r #) -> let !q' = mpzToInteger q + !r' = mpzToInteger (mpzNeg r) + in (# q', r' #) -- see also Trac #8726 divModInteger (J# s1 d1) (S# b) = mpzToInteger2(divModIntegerWord# s1 d1 (int2Word# b)) #else @@ -386,7 +386,7 @@ modInteger (S# a) (S# b) = S# (modInt# a b) modInteger ia@(S# _) ib@(J# _ _) = modInteger (toBig ia) ib #if SIZEOF_HSWORD == SIZEOF_LONG modInteger (J# sa a) (S# b) | isTrue# (b <# 0#) - = mpzToInteger (mpzNeg (remIntegerWord# (negateInt# sa) a (int2Word# (negateInt# b)))) + = mpzToInteger (mpzNeg (modIntegerWord# (negateInt# sa) a (int2Word# (negateInt# b)))) modInteger (J# sa a) (S# b) = mpzToInteger (modIntegerWord# sa a (int2Word# b)) #else From git at git.haskell.org Sun Feb 2 13:19:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Feb 2014 13:19:59 +0000 (UTC) Subject: [commit: packages/integer-gmp] ghc-7.8's head updated: Fix negation of `divMod`/`quotRem` results (fixes #8726) (2f841fd) Message-ID: <20140202132000.388C82406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/integer-gmp Branch 'ghc-7.8' now includes: 2f841fd Fix negation of `divMod`/`quotRem` results (fixes #8726) From git at git.haskell.org Mon Feb 3 14:42:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Feb 2014 14:42:13 +0000 (UTC) Subject: [commit: ghc] master: Document deprecations in Hoopl (526cbc7) Message-ID: <20140203144213.96B0E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/526cbc7a415eb467adbc13e55a80d8a5abbd02ba/ghc >--------------------------------------------------------------- commit 526cbc7a415eb467adbc13e55a80d8a5abbd02ba Author: Jan Stolarek Date: Mon Feb 3 11:14:04 2014 +0100 Document deprecations in Hoopl >--------------------------------------------------------------- 526cbc7a415eb467adbc13e55a80d8a5abbd02ba compiler/cmm/CmmBuildInfoTables.hs | 2 +- compiler/cmm/CmmLive.hs | 1 + compiler/cmm/Hoopl.hs | 27 +++++++++++++++++++++++++++ 3 files changed, 29 insertions(+), 1 deletion(-) diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs index d325817..16ace52 100644 --- a/compiler/cmm/CmmBuildInfoTables.hs +++ b/compiler/cmm/CmmBuildInfoTables.hs @@ -1,6 +1,6 @@ {-# LANGUAGE GADTs #-} --- Todo: remove -fno-warn-warnings-deprecations +-- See Note [Deprecations in Hoopl] in Hoopl module {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module CmmBuildInfoTables ( CAFSet, CAFEnv, cafAnal diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs index e405fbe..24202cb 100644 --- a/compiler/cmm/CmmLive.hs +++ b/compiler/cmm/CmmLive.hs @@ -2,6 +2,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} +-- See Note [Deprecations in Hoopl] in Hoopl module {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module CmmLive diff --git a/compiler/cmm/Hoopl.hs b/compiler/cmm/Hoopl.hs index 08d95b5..2d7139a 100644 --- a/compiler/cmm/Hoopl.hs +++ b/compiler/cmm/Hoopl.hs @@ -124,3 +124,30 @@ badd_rw :: BwdRewrite UniqSM n f -> (Graph n e x, BwdRewrite UniqSM n f) -> (Graph n e x, BwdRewrite UniqSM n f) badd_rw rw2 (g, rw1) = (g, rw1 `thenBwdRw` rw2) + +-- Note [Deprecations in Hoopl] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- CmmLive and CmmBuildInfoTables modules enable -fno-warn-warnings-deprecations +-- flag because they import deprecated functions from Hoopl. I spent some time +-- trying to figure out what is going on, so here's a brief explanation. The +-- culprit is the joinOutFacts function, which should be replaced with +-- joinFacts. The difference between them is that the latter one needs extra +-- Label parameter. Labels identify blocks and are used in the fact base to +-- assign facts to a block (in case you're wondering, Label is an Int wrapped in +-- a newtype). Lattice join function is also required to accept a Label but the +-- only reason why it is so are the debugging purposes: see joinInFacts function +-- which is a no-op and is run only because join function might produce +-- debugging output. Now, going back to the Cmm modules. The "problem" with the +-- deprecated joinOutFacts function is that it passes wrong label when calling +-- lattice join function: instead of label of a block for which we are joining +-- facts it uses labels of successors of that block. So the joinFacts function +-- expects to be given a label of a block for which we are joining facts. I +-- don't see an obvious way of recovering that Label at the call sites of +-- joinOutFacts (if that was easily done then joinFacts function could do it +-- internally without requiring label as a parameter). A cheap way of +-- eliminating these warnings would be to create a bogus Label, since none of +-- our join functions is actually using the Label parameter. But that doesn't +-- feel right. I think the real solution here is to fix Hoopl API, which is +-- already broken in several ways. See Hoopl/Cleanup page on the wiki for more +-- notes on improving Hoopl. From git at git.haskell.org Mon Feb 3 14:42:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Feb 2014 14:42:15 +0000 (UTC) Subject: [commit: ghc] master: Eliminate duplicate code in Cmm pipeline (dba9bf6) Message-ID: <20140203144215.F31062406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dba9bf6723472eaf4be4813a6ca5ed910e33395d/ghc >--------------------------------------------------------------- commit dba9bf6723472eaf4be4813a6ca5ed910e33395d Author: Jan Stolarek Date: Mon Feb 3 12:26:14 2014 +0100 Eliminate duplicate code in Cmm pipeline End of Cmm pipeline used to be split into two alternative flows, depending on whether we did proc-point splitting or not. There was a lot of code duplication between these two branches. But it wasn't really necessary as the differences can be easily enclosed within an if-then-else. I observed no impact of this change on compilation performance. >--------------------------------------------------------------- dba9bf6723472eaf4be4813a6ca5ed910e33395d compiler/cmm/CmmPipeline.hs | 81 ++++++++++++++++--------------------------- 1 file changed, 30 insertions(+), 51 deletions(-) diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs index 98b398f..1447f6d 100644 --- a/compiler/cmm/CmmPipeline.hs +++ b/compiler/cmm/CmmPipeline.hs @@ -84,10 +84,6 @@ cpsTop hsc_env proc = else return call_pps - let noncall_pps = proc_points `setDifference` call_pps - when (not (setNull noncall_pps) && dopt Opt_D_dump_cmm dflags) $ - pprTrace "Non-call proc points: " (ppr noncall_pps) $ return () - ----------- Layout the stack and manifest Sp ---------------------------- (g, stackmaps) <- {-# SCC "layoutStack" #-} @@ -105,57 +101,40 @@ cpsTop hsc_env proc = let cafEnv = {-# SCC "cafAnal" #-} cafAnal g dumpIfSet_dyn dflags Opt_D_dump_cmm "CAFEnv" (ppr cafEnv) - if splitting_proc_points - then do - ------------- Split into separate procedures ----------------------- - pp_map <- {-# SCC "procPointAnalysis" #-} runUniqSM $ - procPointAnalysis proc_points g - dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" pp_map - gs <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ - splitAtProcPoints dflags l call_pps proc_points pp_map - (CmmProc h l v g) - dumps Opt_D_dump_cmm_split "Post splitting" gs - - ------------- Populate info tables with stack info ----------------- - gs <- {-# SCC "setInfoTableStackMap" #-} - return $ map (setInfoTableStackMap dflags stackmaps) gs - dumps Opt_D_dump_cmm_info "after setInfoTableStackMap" gs - - ----------- Control-flow optimisations ----------------------------- - gs <- {-# SCC "cmmCfgOpts(2)" #-} - return $ if optLevel dflags >= 1 - then map (cmmCfgOptsProc splitting_proc_points) gs - else gs - gs <- return (map removeUnreachableBlocksProc gs) - -- Note [unreachable blocks] - dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" gs - - return (cafEnv, gs) - - else do - -- attach info tables to return points - g <- return $ attachContInfoTables call_pps (CmmProc h l v g) - - ------------- Populate info tables with stack info ----------------- - g <- {-# SCC "setInfoTableStackMap" #-} - return $ setInfoTableStackMap dflags stackmaps g - dump' Opt_D_dump_cmm_info "after setInfoTableStackMap" g - - ----------- Control-flow optimisations ----------------------------- - g <- {-# SCC "cmmCfgOpts(2)" #-} - return $ if optLevel dflags >= 1 - then cmmCfgOptsProc splitting_proc_points g - else g - g <- return (removeUnreachableBlocksProc g) - -- Note [unreachable blocks] - dump' Opt_D_dump_cmm_cfg "Post control-flow optimisations" g - - return (cafEnv, [g]) + g <- if splitting_proc_points + then do + ------------- Split into separate procedures ----------------------- + pp_map <- {-# SCC "procPointAnalysis" #-} runUniqSM $ + procPointAnalysis proc_points g + dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" pp_map + g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ + splitAtProcPoints dflags l call_pps proc_points pp_map + (CmmProc h l v g) + dumps Opt_D_dump_cmm_split "Post splitting" g + return g + else do + -- attach info tables to return points + return $ [attachContInfoTables call_pps (CmmProc h l v g)] + + ------------- Populate info tables with stack info ----------------- + g <- {-# SCC "setInfoTableStackMap" #-} + return $ map (setInfoTableStackMap dflags stackmaps) g + dumps Opt_D_dump_cmm_info "after setInfoTableStackMap" g + + ----------- Control-flow optimisations ----------------------------- + g <- {-# SCC "cmmCfgOpts(2)" #-} + return $ if optLevel dflags >= 1 + then map (cmmCfgOptsProc splitting_proc_points) g + else g + g <- return (map removeUnreachableBlocksProc g) + -- See Note [unreachable blocks] + dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" g + + return (cafEnv, g) where dflags = hsc_dflags hsc_env platform = targetPlatform dflags dump = dumpGraph dflags - dump' = dumpWith dflags dumps flag name = mapM_ (dumpWith dflags flag name) From git at git.haskell.org Tue Feb 4 10:59:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 10:59:24 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Update to latest Cabal 1.18 branch tip (37d6e2c) Message-ID: <20140204105925.1615D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/37d6e2c54f117f0a65f3032b6f30b6878b3f6f58/ghc >--------------------------------------------------------------- commit 37d6e2c54f117f0a65f3032b6f30b6878b3f6f58 Author: Herbert Valerio Riedel Date: Fri Jan 31 22:30:00 2014 +0100 Update to latest Cabal 1.18 branch tip This update pulls in the fix for #8266 (recommended add-on reading for those interested in OSX linker peculiarities: https://github.com/haskell/cabal/issues/1660#issuecomment-33701508 ) Signed-off-by: Herbert Valerio Riedel (cherry picked from commit 5671ad66b8c938939a44c883002caa4e13be098c) >--------------------------------------------------------------- 37d6e2c54f117f0a65f3032b6f30b6878b3f6f58 libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index e97aa58..ee6d1cf 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit e97aa58f68519db54de1c62339459ebb88aed069 +Subproject commit ee6d1cf5cefe18f6d74ed379af21d92f8b0ae92d From git at git.haskell.org Tue Feb 4 11:01:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 11:01:02 +0000 (UTC) Subject: [commit: ghc] master: Final fix to #7134 (and #8717 as well.) (2b33f6e) Message-ID: <20140204110102.982A82406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2b33f6e8045fcd00f19883bb5e8895cbaf1bf81e/ghc >--------------------------------------------------------------- commit 2b33f6e8045fcd00f19883bb5e8895cbaf1bf81e Author: Kyrill Briantsev Date: Tue Feb 4 05:00:33 2014 -0600 Final fix to #7134 (and #8717 as well.) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2b33f6e8045fcd00f19883bb5e8895cbaf1bf81e rts/Linker.c | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/rts/Linker.c b/rts/Linker.c index 9bb377c..b9c8fd0 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -3491,8 +3491,8 @@ allocateImageAndTrampolines ( /* For 32-bit case we don't need this, hence we use macro PEi386_IMAGE_OFFSET, which equals to 4 for 64-bit case and 0 for 32-bit case. */ /* We allocate trampolines area for all symbols right behind - image data, aligned on 16. */ - size = ((PEi386_IMAGE_OFFSET + size + 0xf) & ~0xf) + image data, aligned on 8. */ + size = ((PEi386_IMAGE_OFFSET + size + 0x7) & ~0x7) + hdr.NumberOfSymbols * sizeof(SymbolExtra); #endif image = VirtualAlloc(NULL, size, @@ -4147,7 +4147,7 @@ static int ocAllocateSymbolExtras_PEi386 ( ObjectCode* oc ) { oc->symbol_extras = (SymbolExtra*)(oc->image - PEi386_IMAGE_OFFSET - + ((PEi386_IMAGE_OFFSET + oc->fileSize + 0xf) & ~0xf)); + + ((PEi386_IMAGE_OFFSET + oc->fileSize + 0x7) & ~0x7)); oc->first_symbol_extra = 0; oc->n_symbol_extras = ((COFF_header*)oc->image)->NumberOfSymbols; @@ -4161,7 +4161,7 @@ makeSymbolExtra_PEi386( ObjectCode* oc, size_t s, char* symbol ) SymbolExtra *extra; curr_thunk = oc->first_symbol_extra; - if (curr_thunk > oc->n_symbol_extras) { + if (curr_thunk >= oc->n_symbol_extras) { barf("Can't allocate thunk for %s", symbol); } @@ -4172,14 +4172,6 @@ makeSymbolExtra_PEi386( ObjectCode* oc, size_t s, char* symbol ) extra->addr = (uint64_t)s; memcpy(extra->jumpIsland, jmp, 6); - /* DLL-imported symbols are inserted here. - Others are inserted in ocGetNames_PEi386. - */ - if(lookupStrHashTable(symhash, symbol) == NULL) { - ghciInsertSymbolTable(oc->fileName, symhash, symbol, extra->jumpIsland, - HS_BOOL_FALSE, oc); - } - oc->first_symbol_extra++; return (size_t)extra->jumpIsland; From git at git.haskell.org Tue Feb 4 11:14:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 11:14:03 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Bump version to 7.8.1 (9976c2e) Message-ID: <20140204111403.2B39A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/9976c2ece3aa43dea21879e16dd911bb9c16e6b2/ghc >--------------------------------------------------------------- commit 9976c2ece3aa43dea21879e16dd911bb9c16e6b2 Author: Austin Seipp Date: Tue Feb 4 05:13:35 2014 -0600 Bump version to 7.8.1 The version for RC2 will appear as '7.8.1.' Signed-off-by: Austin Seipp >--------------------------------------------------------------- 9976c2ece3aa43dea21879e16dd911bb9c16e6b2 configure.ac | 2 +- libraries/Cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index 7bb83fb..599cc6e 100644 --- a/configure.ac +++ b/configure.ac @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [7.8], [glasgow-haskell-bugs at haskell.org], [ghc]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [7.8.1], [glasgow-haskell-bugs at haskell.org], [ghc]) # Set this to YES for a released version, otherwise NO : ${RELEASE=NO} diff --git a/libraries/Cabal b/libraries/Cabal index ee6d1cf..e97aa58 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit ee6d1cf5cefe18f6d74ed379af21d92f8b0ae92d +Subproject commit e97aa58f68519db54de1c62339459ebb88aed069 From git at git.haskell.org Tue Feb 4 11:17:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 11:17:23 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: That should have been 7.8.0 (f30a016) Message-ID: <20140204111723.EF6562406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/f30a01626461c3824aa6bccb1ed633bee26382bc/ghc >--------------------------------------------------------------- commit f30a01626461c3824aa6bccb1ed633bee26382bc Author: Austin Seipp Date: Tue Feb 4 05:17:15 2014 -0600 That should have been 7.8.0 Signed-off-by: Austin Seipp >--------------------------------------------------------------- f30a01626461c3824aa6bccb1ed633bee26382bc configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 599cc6e..70749b1 100644 --- a/configure.ac +++ b/configure.ac @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [7.8.1], [glasgow-haskell-bugs at haskell.org], [ghc]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [7.8.0], [glasgow-haskell-bugs at haskell.org], [ghc]) # Set this to YES for a released version, otherwise NO : ${RELEASE=NO} From git at git.haskell.org Tue Feb 4 18:26:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:26:40 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Strictify the demand on unlifted arguments (889e02f) Message-ID: <20140204182640.93AB22406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/889e02f3e1681d4270d8047cbcc72a09ab45064d/ghc >--------------------------------------------------------------- commit 889e02f3e1681d4270d8047cbcc72a09ab45064d Author: Joachim Breitner Date: Wed Jan 15 16:52:23 2014 +0000 Strictify the demand on unlifted arguments because they are trivially strict, and the primitive operations do not have the strictness demand in their demand signature. >--------------------------------------------------------------- 889e02f3e1681d4270d8047cbcc72a09ab45064d compiler/basicTypes/Demand.lhs | 6 +++++- compiler/stranal/DmdAnal.lhs | 16 +++++++++++----- testsuite/tests/numeric/should_compile/T7116.stdout | 8 ++++---- testsuite/tests/perf/compiler/all.T | 8 ++++++-- testsuite/tests/simplCore/should_compile/T3772.stdout | 4 ++-- testsuite/tests/simplCore/should_compile/T4930.stderr | 2 +- testsuite/tests/stranal/sigs/HyperStrUse.stderr | 2 +- 7 files changed, 30 insertions(+), 16 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index e415c6d..3c410c0 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -11,7 +11,7 @@ module Demand ( countOnce, countMany, -- cardinality Demand, CleanDemand, - mkProdDmd, mkOnceUsedDmd, mkManyUsedDmd, mkHeadStrict, oneifyDmd, + mkProdDmd, mkOnceUsedDmd, mkManyUsedDmd, mkHeadStrict, oneifyDmd, strictifyDmd, getUsage, toCleanDmd, absDmd, topDmd, botDmd, seqDmd, lubDmd, bothDmd, apply1Dmd, apply2Dmd, @@ -183,6 +183,10 @@ bothStr (SProd s1) (SProd s2) | otherwise = HyperStr -- Weird bothStr (SProd _) (SCall _) = HyperStr +strictifyDmd :: Demand -> Demand +strictifyDmd (JD Lazy u) = (JD (Str HeadStr) u) +strictifyDmd (JD s u) = (JD s u) + -- utility functions to deal with memory leaks seqStrDmd :: StrDmd -> () seqStrDmd (SProd ds) = seqStrDmdList ds diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index e9a7ab4..d578a3f 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -28,7 +28,7 @@ import Id import CoreUtils ( exprIsHNF, exprType, exprIsTrivial ) -- import PprCore import TyCon -import Type ( eqType ) +import Type ( eqType, isUnLiftedType ) -- import Pair -- import Coercion ( coercionKind ) import FamInstEnv @@ -104,12 +104,18 @@ c) The application rule wouldn't be right either evaluation of f in a C(L) demand! \begin{code} --- If e is complicated enough to become a thunk, its contents will be evaluated --- at most once, so oneify it. +-- This function modifies the demand on a paramater e in a call f e: +-- * If e is complicated enough to become a thunk, its contents will be evaluated +-- at most once, so oneify it. +-- * If e is of an unlifted type, e will be evaluated before the actual call, so +-- in that sense, the demand on e is strict. dmdTransformThunkDmd :: CoreExpr -> Demand -> Demand dmdTransformThunkDmd e - | exprIsTrivial e = id - | otherwise = oneifyDmd + = when (not (exprIsTrivial e)) oneifyDmd . + when (isUnLiftedType (exprType e)) strictifyDmd + where + when True f = f + when False _ = id -- Do not process absent demands -- Otherwise act like in a normal demand analysis diff --git a/testsuite/tests/numeric/should_compile/T7116.stdout b/testsuite/tests/numeric/should_compile/T7116.stdout index 549ed48..9b7f7c8 100644 --- a/testsuite/tests/numeric/should_compile/T7116.stdout +++ b/testsuite/tests/numeric/should_compile/T7116.stdout @@ -6,7 +6,7 @@ T7116.dl :: GHC.Types.Double -> GHC.Types.Double [GblId, Arity=1, Caf=NoCafRefs, - Str=DmdType m, + Str=DmdType m, Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=False) @@ -24,7 +24,7 @@ T7116.dr :: GHC.Types.Double -> GHC.Types.Double [GblId, Arity=1, Caf=NoCafRefs, - Str=DmdType m, + Str=DmdType m, Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=False) @@ -38,7 +38,7 @@ T7116.fl :: GHC.Types.Float -> GHC.Types.Float [GblId, Arity=1, Caf=NoCafRefs, - Str=DmdType m, + Str=DmdType m, Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=False) @@ -56,7 +56,7 @@ T7116.fr :: GHC.Types.Float -> GHC.Types.Float [GblId, Arity=1, Caf=NoCafRefs, - Str=DmdType m, + Str=DmdType m, Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=False) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index c77655b..46eec23 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -69,7 +69,7 @@ test('T1969', # 2012-10-08 303930948 (x86/Linux, new codegen) # 2013-02-10 322937684 (x86/OSX) # 2014-01-22 316103268 (x86/Linux) - (wordsize(64), 698612512, 5)]), + (wordsize(64), 663200424, 5)]), # 17/11/2009 434845560 (amd64/Linux) # 08/12/2009 459776680 (amd64/Linux) # 17/05/2010 519377728 (amd64/Linux) @@ -90,6 +90,8 @@ test('T1969', # (^ new demand analyser) # 18/10/2013 698612512 (x86_64/Linux) # (fix for #8456) + # 2014-01-17 663200424 (amd64/Linux) + # (^ strictify demand on unlifted arguments) only_ways(['normal']), extra_hc_opts('-dcore-lint -static') @@ -395,8 +397,10 @@ test('T6048', [(wordsize(32), 48887164, 10), # prev: 38000000 (x86/Linux) # 2012-10-08: 48887164 (x86/Linux) - (wordsize(64), 108578664, 10)]) + (wordsize(64), 95762056, 10)]) # 18/09/2012 97247032 amd64/Linux # 16/01/2014 108578664 amd64/Linux (unknown) + # 2014-01-17 95762056 (amd64/Linux) + # (^ strictify demand on unlifted arguments) ], compile,['']) diff --git a/testsuite/tests/simplCore/should_compile/T3772.stdout b/testsuite/tests/simplCore/should_compile/T3772.stdout index 6c7735e..6c418fa 100644 --- a/testsuite/tests/simplCore/should_compile/T3772.stdout +++ b/testsuite/tests/simplCore/should_compile/T3772.stdout @@ -4,7 +4,7 @@ Result size of Tidy Core = {terms: 29, types: 12, coercions: 0} Rec { xs :: GHC.Prim.Int# -> () -[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType ] +[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType ] xs = \ (m :: GHC.Prim.Int#) -> case GHC.Prim.tagToEnum# @ GHC.Types.Bool (GHC.Prim.<=# m 1) @@ -15,7 +15,7 @@ xs = end Rec } T3772.foo [InlPrag=NOINLINE] :: GHC.Types.Int -> () -[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType ] +[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType ] T3772.foo = \ (n :: GHC.Types.Int) -> case n of _ [Occ=Dead] { GHC.Types.I# n# -> diff --git a/testsuite/tests/simplCore/should_compile/T4930.stderr b/testsuite/tests/simplCore/should_compile/T4930.stderr index 9570b7b..ee77e0c 100644 --- a/testsuite/tests/simplCore/should_compile/T4930.stderr +++ b/testsuite/tests/simplCore/should_compile/T4930.stderr @@ -13,7 +13,7 @@ T4930.foo1 = GHC.Err.error @ GHC.Types.Int lvl T4930.foo :: GHC.Types.Int -> GHC.Types.Int [GblId, Arity=1, - Str=DmdType m, + Str=DmdType m, Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=False) diff --git a/testsuite/tests/stranal/sigs/HyperStrUse.stderr b/testsuite/tests/stranal/sigs/HyperStrUse.stderr index 1a0ff33..6c5d487 100644 --- a/testsuite/tests/stranal/sigs/HyperStrUse.stderr +++ b/testsuite/tests/stranal/sigs/HyperStrUse.stderr @@ -1,5 +1,5 @@ ==================== Strictness signatures ==================== -HyperStrUse.f: m +HyperStrUse.f: m From git at git.haskell.org Tue Feb 4 18:26:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:26:42 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: In deferType, return convRes = Converges NoCPR (9343ce5c7) Message-ID: <20140204182643.073802406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/9343ce5c71da6672e056245505ba8ec659aa144d/ghc >--------------------------------------------------------------- commit 9343ce5c71da6672e056245505ba8ec659aa144d Author: Joachim Breitner Date: Wed Dec 4 16:55:18 2013 +0000 In deferType, return convRes = Converges NoCPR because this is the right-identity to `bothDmdResult`, and this is the right thing to do in a lazy context. >--------------------------------------------------------------- 9343ce5c71da6672e056245505ba8ec659aa144d compiler/basicTypes/Demand.lhs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index 5c31a28..b2e762b 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -781,8 +781,9 @@ seqCPRResult RetProd = () -- [cprRes] lets us switch off CPR analysis -- by making sure that everything uses TopRes -topRes, botRes :: DmdResult +topRes, convRes, botRes :: DmdResult topRes = Dunno NoCPR +convRes = Converges NoCPR botRes = Diverges cprSumRes :: ConTag -> DmdResult @@ -1213,9 +1214,9 @@ postProcessUnsat (True, One) ty = deferType ty postProcessUnsat (False, One) ty = ty deferType, reuseType, deferReuse :: DmdType -> DmdType -deferType (DmdType fv ds _) = DmdType (deferEnv fv) (map deferDmd ds) topRes +deferType (DmdType fv ds _) = DmdType (deferEnv fv) (map deferDmd ds) convRes reuseType (DmdType fv ds res_ty) = DmdType (reuseEnv fv) (map reuseDmd ds) res_ty -deferReuse (DmdType fv ds _) = DmdType (deferReuseEnv fv) (map deferReuseDmd ds) topRes +deferReuse (DmdType fv ds _) = DmdType (deferReuseEnv fv) (map deferReuseDmd ds) convRes deferEnv, reuseEnv, deferReuseEnv :: DmdEnv -> DmdEnv deferEnv fv = mapVarEnv deferDmd fv From git at git.haskell.org Tue Feb 4 18:26:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:26:45 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Mark the scrunitee of a multi-way-case as converging (be33911) Message-ID: <20140204182645.861E32406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/be339119cf15cb7ec6da88d777c7b3d42aebd18a/ghc >--------------------------------------------------------------- commit be339119cf15cb7ec6da88d777c7b3d42aebd18a Author: Joachim Breitner Date: Fri Jan 10 13:45:39 2014 +0000 Mark the scrunitee of a multi-way-case as converging >--------------------------------------------------------------- be339119cf15cb7ec6da88d777c7b3d42aebd18a compiler/stranal/DmdAnal.lhs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 9e19e8f..358b081 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -276,7 +276,9 @@ dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)]) dmdAnal env dmd (Case scrut case_bndr ty alts) = let -- Case expression with multiple alternatives - (alt_tys, alts') = mapAndUnzip (dmdAnalAlt env dmd) alts + case_bndr_sig = convergeSig nopSig + env_alt = extendAnalEnv NotTopLevel env case_bndr case_bndr_sig + (alt_tys, alts') = mapAndUnzip (dmdAnalAlt env_alt dmd) alts (scrut_ty, scrut') = dmdAnal env cleanEvalDmd scrut (alt_ty, case_bndr') = annotateBndr env (lubDmdTypes alt_tys) case_bndr res_ty = alt_ty `bothDmdType` toBothDmdArg scrut_ty From git at git.haskell.org Tue Feb 4 18:26:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:26:47 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Add Converges to DmdResult (24fa001) Message-ID: <20140204182648.123032406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/24fa001912799578d1a658e7d09343a0bd97e748/ghc >--------------------------------------------------------------- commit 24fa001912799578d1a658e7d09343a0bd97e748 Author: Joachim Breitner Date: Thu Dec 12 15:45:19 2013 +0000 Add Converges to DmdResult to detect definite convergence (required for nested CPR). Notable details: * botDmdType is no longer the unit for lubDmdType. So do not use foldr lubDmdType botDmdType when combinding the branches of a case, to avoid throwing away information. * avoid declaring recursive things as terminating for sure, by removing the Converges flag from a loop breaker. * cprProdSig comes with a Converging flag, so it is removed using sigMayDiverge where necessary * a data constructor worker is not converging, if it is strict in any of its fields. >--------------------------------------------------------------- 24fa001912799578d1a658e7d09343a0bd97e748 compiler/basicTypes/Demand.lhs | 67 ++++++++++++++++---- compiler/basicTypes/MkId.lhs | 5 +- compiler/stranal/DmdAnal.lhs | 15 +++-- .../tests/simplCore/should_compile/T7360.stderr | 2 +- .../simplCore/should_compile/spec-inline.stderr | 2 +- 5 files changed, 70 insertions(+), 21 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 24fa001912799578d1a658e7d09343a0bd97e748 From git at git.haskell.org Tue Feb 4 18:26:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:26:50 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Literals are Converging (6cfa6ea) Message-ID: <20140204182650.A1A522406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/6cfa6ea0b305aa003a54e33eaf4280a380749f9d/ghc >--------------------------------------------------------------- commit 6cfa6ea0b305aa003a54e33eaf4280a380749f9d Author: Joachim Breitner Date: Fri Jan 10 13:39:22 2014 +0000 Literals are Converging >--------------------------------------------------------------- 6cfa6ea0b305aa003a54e33eaf4280a380749f9d compiler/basicTypes/Demand.lhs | 5 +++-- compiler/stranal/DmdAnal.lhs | 2 +- testsuite/tests/simplCore/should_compile/T4918.stdout | 4 ++-- testsuite/tests/simplCore/should_compile/T7360.stderr | 2 +- testsuite/tests/simplCore/should_compile/spec-inline.stderr | 2 +- testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr | 2 +- 6 files changed, 9 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index b2e762b..ec2c989 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -19,7 +19,7 @@ module Demand ( peelUseCall, cleanUseDmd_maybe, strictenDmd, bothCleanDmd, DmdType(..), dmdTypeDepth, lubDmdType, lubDmdTypes, bothDmdType, - nopDmdType, botDmdType, mkDmdType, + nopDmdType, litDmdType, botDmdType, mkDmdType, addDemand, removeDmdTyArgs, BothDmdArg, mkBothDmdArg, toBothDmdArg, @@ -1086,9 +1086,10 @@ emptyDmdEnv = emptyVarEnv -- (lazy, absent, no CPR information, no termination information). -- Note that it is ''not'' the top of the lattice (which would be "may use everything"), -- so it is (no longer) called topDmd -nopDmdType, botDmdType :: DmdType +nopDmdType, litDmdType, botDmdType :: DmdType nopDmdType = DmdType emptyDmdEnv [] topRes botDmdType = DmdType emptyDmdEnv [] botRes +litDmdType = DmdType emptyDmdEnv [] convRes cprProdDmdType :: Arity -> DmdType cprProdDmdType _arity diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 358b081..e14f066 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -136,7 +136,7 @@ dmdAnal :: AnalEnv -- The CleanDemand is always strict and not absent -- See Note [Ensure demand is strict] -dmdAnal _ _ (Lit lit) = (nopDmdType, Lit lit) +dmdAnal _ _ (Lit lit) = (litDmdType, Lit lit) dmdAnal _ _ (Type ty) = (nopDmdType, Type ty) -- Doesn't happen, in fact dmdAnal _ _ (Coercion co) = (nopDmdType, Coercion co) diff --git a/testsuite/tests/simplCore/should_compile/T4918.stdout b/testsuite/tests/simplCore/should_compile/T4918.stdout index c79b116..dbbc675 100644 --- a/testsuite/tests/simplCore/should_compile/T4918.stdout +++ b/testsuite/tests/simplCore/should_compile/T4918.stdout @@ -1,2 +1,2 @@ - {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'p') -} - {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'q') -} + {- HasNoCafRefs, Strictness: tm, Unfolding: (GHC.Types.C# 'p') -} + {- HasNoCafRefs, Strictness: tm, Unfolding: (GHC.Types.C# 'q') -} diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr index f6ce7ed..5a04c74 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.stderr +++ b/testsuite/tests/simplCore/should_compile/T7360.stderr @@ -37,7 +37,7 @@ T7360.fun4 = T7360.fun1 T7360.Foo1 T7360.fun3 :: GHC.Types.Int [GblId, Caf=NoCafRefs, - Str=DmdType m, + Str=DmdType tm, Unf=Unf{Src=, TopLvl=True, Arity=0, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr index 055b643..0a53e18 100644 --- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr +++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr @@ -113,7 +113,7 @@ Roman.foo_go = Roman.foo2 :: GHC.Types.Int [GblId, Caf=NoCafRefs, - Str=DmdType m, + Str=DmdType tm, Unf=Unf{Src=, TopLvl=True, Arity=0, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] diff --git a/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr b/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr index 7fb1a55..7c17d78 100644 --- a/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr +++ b/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr @@ -4,7 +4,7 @@ DmdAnalGADTs.diverges: b DmdAnalGADTs.f: DmdAnalGADTs.f': m DmdAnalGADTs.g: -DmdAnalGADTs.hasCPR: m +DmdAnalGADTs.hasCPR: tm DmdAnalGADTs.hasStrSig: m From git at git.haskell.org Tue Feb 4 18:26:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:26:53 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Some primitive operations are converging (95ec011) Message-ID: <20140204182655.699672406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/95ec011ea0eac060efe826d7ef35f584aa03704b/ghc >--------------------------------------------------------------- commit 95ec011ea0eac060efe826d7ef35f584aa03704b Author: Joachim Breitner Date: Fri Jan 10 13:42:21 2014 +0000 Some primitive operations are converging >--------------------------------------------------------------- 95ec011ea0eac060efe826d7ef35f584aa03704b compiler/prelude/PrimOp.lhs | 4 +++- compiler/prelude/primops.txt.pp | 1 + 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs index 12f71c2..2ee7da4 100644 --- a/compiler/prelude/PrimOp.lhs +++ b/compiler/prelude/PrimOp.lhs @@ -516,8 +516,10 @@ primOpOcc op = case primOpInfo op of primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictSig) primOpSig op - = (tyvars, arg_tys, res_ty, arity, primOpStrictness op arity) + = (tyvars, arg_tys, res_ty, arity, strict_sig) where + strict_sig | primOpOkForSpeculation op = convergeSig $ primOpStrictness op arity + | otherwise = primOpStrictness op arity arity = length arg_tys (tyvars, arg_tys, res_ty) = case (primOpInfo op) of diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index d2978dc..0aad841 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -61,6 +61,7 @@ defaults can_fail = False -- See Note Note [PrimOp can_fail and has_side_effects] in PrimOp commutable = False code_size = { primOpCodeSizeDefault } + -- Strictness is turned to terminating in PrimOp.primOpSig, if allowed strictness = { \ arity -> mkClosedStrictSig (replicate arity topDmd) topRes } fixity = Nothing llvm_only = False From git at git.haskell.org Tue Feb 4 18:26:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:26:55 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Note [Termination information and arguments] (b886ef8) Message-ID: <20140204182655.7E00C24069@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/b886ef81127af11c643e633df4b219fc4a480585/ghc >--------------------------------------------------------------- commit b886ef81127af11c643e633df4b219fc4a480585 Author: Joachim Breitner Date: Wed Jan 15 16:53:31 2014 +0000 Note [Termination information and arguments] >--------------------------------------------------------------- b886ef81127af11c643e633df4b219fc4a480585 compiler/basicTypes/Demand.lhs | 30 +++++++++++++++++++++++++++++- compiler/prelude/primops.txt.pp | 1 + compiler/stranal/DmdAnal.lhs | 1 + 3 files changed, 31 insertions(+), 1 deletion(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index ec2c989..850ae19 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -1195,7 +1195,7 @@ postProcessDmdTypeM (Just du) (DmdType fv _ res_ty) postProcessDmdResult :: DeferAndUse -> DmdResult -> Termination () -- if we use it lazily, there cannot be divergence worrying us - -- (Otherwise we'd lose the termination information of constructors in in dmdAnalVarApp, for example) + -- See Note [Termination information and arguments] postProcessDmdResult (True,_) _ = Converges () postProcessDmdResult (False,_) (Dunno {}) = Dunno () postProcessDmdResult (False,_) (Converges {}) = Converges () @@ -1412,6 +1412,34 @@ and on the second, then returning a constructor. If this same function is applied to one arg, all we can say is that it uses x with , and its arg with demand . + +Note [Termination information and arguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A strictness signature of t indicates: + If you apply me to one argument, I will surely terminate (even if this + argument may diverge). +Therefore, in postProcessDmdResult, we replace the termination info of a lazy +argument by Converges. + +For strict arguments, we do not do that. But usually, t is not possible anyways: +Assume such a function is applied to undefined. This diverges, because it is strict, +and it converges, because of the terminating flag. + +One exception to this rule are unlifted arguments. These cannot be undefined, so the +function is (vacuously) strict in them. But moreover, it is important that we treat +them as strict! Consider I# (or any function with an unlifted argument type). We +clearly want "I# 1#" to be terminating, and also "I# x" and "I# (x +# 2#)". +But not "I# (x `quotInt#` 0#)"! Therefore, we need to analyze the argument with a strict +demand, so that postProcessDmdResult will not hide the termination result of the argument, +and bothDmdType takes case of erasing the Converges coming from I#. + +This is a property not just of primitive operations. Consider + f :: Bool -> (Int# -> b) -> b + f b g = g (if b then 1# else 0#) +Is this strict in `b`? Yes, it is! So we want to consider any function with an +unlifted argument type as strict. Hence we do that conveniently in dmdTransformThunkDmd. +And therefore we do not have to worry about the strictness on arguments in primops.txt.pp + \begin{code} newtype StrictSig = StrictSig DmdType deriving( Eq ) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 0aad841..301b32d 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -62,6 +62,7 @@ defaults commutable = False code_size = { primOpCodeSizeDefault } -- Strictness is turned to terminating in PrimOp.primOpSig, if allowed + -- Also see [Termination information and arguments] strictness = { \ arity -> mkClosedStrictSig (replicate arity topDmd) topRes } fixity = Nothing llvm_only = False diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index e14f066..f8f9a28 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -109,6 +109,7 @@ c) The application rule wouldn't be right either -- at most once, so oneify it. -- * If e is of an unlifted type, e will be evaluated before the actual call, so -- in that sense, the demand on e is strict. +-- See [Termination information and arguments] dmdTransformThunkDmd :: CoreExpr -> Demand -> Demand dmdTransformThunkDmd e = when (not (exprIsTrivial e)) oneifyDmd . From git at git.haskell.org Tue Feb 4 18:26:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:26:57 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Variables of unlifted types are always converging (1817b65) Message-ID: <20140204182701.E4BAC2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/1817b658d2609c22d5f045f8ad2adfe934d1107e/ghc >--------------------------------------------------------------- commit 1817b658d2609c22d5f045f8ad2adfe934d1107e Author: Joachim Breitner Date: Fri Jan 10 13:46:01 2014 +0000 Variables of unlifted types are always converging >--------------------------------------------------------------- 1817b658d2609c22d5f045f8ad2adfe934d1107e compiler/basicTypes/Demand.lhs | 2 +- compiler/stranal/DmdAnal.lhs | 8 +++++++- testsuite/tests/simplCore/should_compile/spec-inline.stderr | 4 ++-- 3 files changed, 10 insertions(+), 4 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index 850ae19..6ecd672 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -28,7 +28,7 @@ module Demand ( DmdResult, CPRResult, isBotRes, isTopRes, - topRes, botRes, cprProdRes, vanillaCprProdRes, cprSumRes, + topRes, convRes, botRes, cprProdRes, vanillaCprProdRes, cprSumRes, appIsBottom, isBottomingSig, pprIfaceStrictSig, trimCPRInfo, returnsCPR_maybe, StrictSig(..), mkStrictSig, mkClosedStrictSig, nopSig, botSig, cprProdSig, convergeSig, diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index f8f9a28..12faadd 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -701,7 +701,12 @@ a product type. \begin{code} unitVarDmd :: Var -> Demand -> DmdType unitVarDmd var dmd - = DmdType (unitVarEnv var dmd) [] topRes + = -- pprTrace "unitVarDmd" (vcat [ppr var, ppr dmd, ppr res]) $ + DmdType (unitVarEnv var dmd) [] res + where + -- Variables of unlifted types are, well, unlifted + res | isUnLiftedType (idType var) = convRes + | otherwise = topRes addVarDmd :: DmdType -> Var -> Demand -> DmdType addVarDmd (DmdType fv ds res) var dmd @@ -1059,6 +1064,7 @@ extendAnalEnv top_lvl env var sig = env { ae_sigs = extendSigEnv top_lvl (ae_sigs env) var sig' } where sig' | isWeakLoopBreaker (idOccInfo var) = sigMayDiverge sig + | isUnLiftedType (idType var) = convergeSig sig | otherwise = sig extendSigEnv :: TopLevelFlag -> SigEnv -> Id -> StrictSig -> SigEnv diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr index 0a53e18..27607ee 100644 --- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr +++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr @@ -16,7 +16,7 @@ Roman.foo_$s$wgo = \ (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#) -> let { a :: GHC.Prim.Int# - [LclId, Str=DmdType] + [LclId, Str=DmdType t] a = GHC.Prim.+# (GHC.Prim.+# @@ -60,7 +60,7 @@ Roman.$wgo = case x of _ [Occ=Dead] { GHC.Types.I# ipv -> let { a :: GHC.Prim.Int# - [LclId, Str=DmdType] + [LclId, Str=DmdType t] a = GHC.Prim.+# (GHC.Prim.+# From git at git.haskell.org Tue Feb 4 18:27:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:00 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Initial work on Nested CPR (d4ed1c6) Message-ID: <20140204182702.140FD24069@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/d4ed1c60623d28aad986352750d715d0db882e75/ghc >--------------------------------------------------------------- commit d4ed1c60623d28aad986352750d715d0db882e75 Author: Simon Peyton Jones Date: Mon Nov 25 09:59:16 2013 +0000 Initial work on Nested CPR >--------------------------------------------------------------- d4ed1c60623d28aad986352750d715d0db882e75 compiler/basicTypes/Demand.lhs | 133 ++++++++++++-------- compiler/stranal/DmdAnal.lhs | 116 ++++++++++++----- .../tests/numeric/should_compile/T7116.stdout | 8 +- .../tests/simplCore/should_compile/T3717.stderr | 2 +- .../tests/simplCore/should_compile/T4201.stdout | 2 +- .../tests/simplCore/should_compile/T4918.stdout | 4 +- .../tests/simplCore/should_compile/T4930.stderr | 2 +- .../tests/simplCore/should_compile/T7360.stderr | 4 +- .../simplCore/should_compile/spec-inline.stderr | 6 +- .../stranal/sigs/BottomFromInnerLambda.stderr | 2 +- testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr | 6 +- testsuite/tests/stranal/sigs/HyperStrUse.stderr | 2 +- testsuite/tests/stranal/sigs/T8598.stderr | 2 +- testsuite/tests/stranal/sigs/UnsatFun.stderr | 4 +- 14 files changed, 183 insertions(+), 110 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d4ed1c60623d28aad986352750d715d0db882e75 From git at git.haskell.org Tue Feb 4 18:27:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:02 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Limit the depth of the CPR information (1810fe5) Message-ID: <20140204182703.09DA62406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/1810fe5660c72e15ea35886d10a14bc2c095915c/ghc >--------------------------------------------------------------- commit 1810fe5660c72e15ea35886d10a14bc2c095915c Author: Joachim Breitner Date: Thu Dec 5 16:13:41 2013 +0000 Limit the depth of the CPR information as otherwise, it could become infinite. >--------------------------------------------------------------- 1810fe5660c72e15ea35886d10a14bc2c095915c compiler/basicTypes/Demand.lhs | 34 ++++++++++++++++++++++++++++------ 1 file changed, 28 insertions(+), 6 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index 8411356..668dd55 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -813,8 +813,8 @@ cprSumRes tag | opt_CprOff = topRes cprProdRes :: [DmdResult] -> DmdResult cprProdRes arg_ress - | opt_CprOff = topRes - | otherwise = Converges $ RetProd arg_ress + | opt_CprOff = topRes + | otherwise = Converges $ cutCPRResult maxCPRDepth $ RetProd arg_ress getDmdResult :: DmdType -> DmdResult getDmdResult (DmdType _ [] r) = r -- Only for data-typed arguments! @@ -824,10 +824,31 @@ getDmdResult _ = topRes divergeDmdResult :: DmdResult -> DmdResult divergeDmdResult r = r `lubDmdResult` botRes +maxCPRDepth :: Int +maxCPRDepth = 3 + +-- With nested CPR, DmdResult can be arbitrarily deep; consider +-- data Rec1 = Foo Rec2 Rec2 +-- data Rec2 = Bar Rec1 Rec1 +-- +-- x = Foo y y +-- y = Bar x x +-- +-- So we need to forget information at a certain depth. We do that at all points +-- where we are constructing new RetProd constructors. +cutDmdResult :: Int -> DmdResult -> DmdResult +cutDmdResult 0 _ = topRes +cutDmdResult _ Diverges = Diverges +cutDmdResult n (Converges c) = Converges (cutCPRResult n c) +cutDmdResult n (Dunno c) = Dunno (cutCPRResult n c) + +cutCPRResult :: Int -> CPRResult -> CPRResult +cutCPRResult _ NoCPR = NoCPR +cutCPRResult n (RetProd rs) = RetProd (map (cutDmdResult (n-1)) rs) +cutCPRResult _ (RetSum tag) = RetSum tag + vanillaCprProdRes :: Arity -> DmdResult -vanillaCprProdRes arity - | opt_CprOff = topRes - | otherwise = Converges $ RetProd (replicate arity topRes) +vanillaCprProdRes arity = cprProdRes (replicate arity topRes) isTopRes :: DmdResult -> Bool isTopRes (Dunno NoCPR) = True @@ -1097,10 +1118,11 @@ bothDmdType (DmdType fv1 ds1 r1) (fv2, t2) instance Outputable DmdType where ppr (DmdType fv ds res) = hsep [text "DmdType", - hcat (map ppr ds) <> ppr res, + hcat (map ppr ds) <> ppr_res, if null fv_elts then empty else braces (fsep (map pp_elt fv_elts))] where + ppr_res = if isTopRes res then empty else ppr res pp_elt (uniq, dmd) = ppr uniq <> text "->" <> ppr dmd fv_elts = ufmToList fv From git at git.haskell.org Tue Feb 4 18:27:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:05 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Add a flag -fnested-cpr-off to conveniently test the effect of nested CPR (685ef19) Message-ID: <20140204182705.E48772406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/685ef198136aa0cc2ae0ac33cc71172f45d277eb/ghc >--------------------------------------------------------------- commit 685ef198136aa0cc2ae0ac33cc71172f45d277eb Author: Joachim Breitner Date: Wed Dec 4 09:14:26 2013 +0000 Add a flag -fnested-cpr-off to conveniently test the effect of nested CPR >--------------------------------------------------------------- 685ef198136aa0cc2ae0ac33cc71172f45d277eb compiler/basicTypes/Demand.lhs | 27 ++++++++++++++++++--------- compiler/main/StaticFlags.hs | 9 +++++++-- 2 files changed, 25 insertions(+), 11 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index 668dd55..0d26d66 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -814,6 +814,7 @@ cprSumRes tag | opt_CprOff = topRes cprProdRes :: [DmdResult] -> DmdResult cprProdRes arg_ress | opt_CprOff = topRes + | opt_NestedCprOff = Converges $ cutCPRResult flatCPRDepth $ RetProd arg_ress | otherwise = Converges $ cutCPRResult maxCPRDepth $ RetProd arg_ress getDmdResult :: DmdType -> DmdResult @@ -827,6 +828,13 @@ divergeDmdResult r = r `lubDmdResult` botRes maxCPRDepth :: Int maxCPRDepth = 3 +-- This is the depth we use with -fnested-cpr-off, in order +-- to get precisely the same behaviour as before introduction of nested cpr +-- -fnested-cpr-off can eventually be removed if nested cpr is deemd to be +-- a good thing always. +flatCPRDepth :: Int +flatCPRDepth = 1 + -- With nested CPR, DmdResult can be arbitrarily deep; consider -- data Rec1 = Foo Rec2 Rec2 -- data Rec2 = Bar Rec1 Rec1 @@ -836,16 +844,17 @@ maxCPRDepth = 3 -- -- So we need to forget information at a certain depth. We do that at all points -- where we are constructing new RetProd constructors. -cutDmdResult :: Int -> DmdResult -> DmdResult -cutDmdResult 0 _ = topRes -cutDmdResult _ Diverges = Diverges -cutDmdResult n (Converges c) = Converges (cutCPRResult n c) -cutDmdResult n (Dunno c) = Dunno (cutCPRResult n c) - cutCPRResult :: Int -> CPRResult -> CPRResult -cutCPRResult _ NoCPR = NoCPR -cutCPRResult n (RetProd rs) = RetProd (map (cutDmdResult (n-1)) rs) -cutCPRResult _ (RetSum tag) = RetSum tag +cutCPRResult 0 _ = NoCPR +cutCPRResult _ NoCPR = NoCPR +cutCPRResult _ (RetSum tag) = RetSum tag +cutCPRResult n (RetProd rs) = RetProd (map (cutDmdResult (n-1)) rs) + where + cutDmdResult :: Int -> DmdResult -> DmdResult + cutDmdResult 0 _ = topRes + cutDmdResult _ Diverges = Diverges + cutDmdResult n (Converges c) = Converges (cutCPRResult n c) + cutDmdResult n (Dunno c) = Dunno (cutCPRResult n c) vanillaCprProdRes :: Arity -> DmdResult vanillaCprProdRes arity = cprProdRes (replicate arity topRes) diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 01dc3b7..feb7235 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -27,6 +27,7 @@ module StaticFlags ( -- optimisation opts opt_NoStateHack, opt_CprOff, + opt_NestedCprOff, opt_NoOptCoercion, -- For the parser @@ -140,7 +141,8 @@ flagsStaticNames :: [String] flagsStaticNames = [ "fno-state-hack", "fno-opt-coercion", - "fcpr-off" + "fcpr-off", + "fnested-cpr-off" ] -- We specifically need to discard static flags for clients of the @@ -195,10 +197,13 @@ opt_NoDebugOutput = lookUp (fsLit "-dno-debug-output") opt_NoStateHack :: Bool opt_NoStateHack = lookUp (fsLit "-fno-state-hack") --- Switch off CPR analysis in the new demand analyser +-- Switch off CPR analysis in the demand analyser opt_CprOff :: Bool opt_CprOff = lookUp (fsLit "-fcpr-off") +opt_NestedCprOff :: Bool +opt_NestedCprOff = lookUp (fsLit "-fnested-cpr-off") + opt_NoOptCoercion :: Bool opt_NoOptCoercion = lookUp (fsLit "-fno-opt-coercion") From git at git.haskell.org Tue Feb 4 18:27:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:08 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Refactor trimCPRInfo away (34db1df) Message-ID: <20140204182708.5F2952406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/34db1df27aee84aca959a370a134a17337b57560/ghc >--------------------------------------------------------------- commit 34db1df27aee84aca959a370a134a17337b57560 Author: Joachim Breitner Date: Wed Jan 15 17:44:30 2014 +0000 Refactor trimCPRInfo away >--------------------------------------------------------------- 34db1df27aee84aca959a370a134a17337b57560 compiler/basicTypes/Demand.lhs | 35 ++++++++++++++++++++--------------- compiler/stranal/DmdAnal.lhs | 38 ++++++++++++++++++++++++-------------- 2 files changed, 44 insertions(+), 29 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index 0d26d66..c7338c4 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -30,7 +30,8 @@ module Demand ( isBotRes, isTopRes, getDmdResult, topRes, convRes, botRes, cprProdRes, vanillaCprProdRes, cprSumRes, appIsBottom, isBottomingSig, pprIfaceStrictSig, - trimCPRInfo, returnsCPR_maybe, + returnsCPR_maybe, + forgetCPR, forgetSumCPR, StrictSig(..), mkStrictSig, mkClosedStrictSig, nopSig, botSig, cprProdSig, convergeSig, isNopSig, splitStrictSig, increaseStrictSigArity, sigMayDiverge, @@ -856,6 +857,24 @@ cutCPRResult n (RetProd rs) = RetProd (map (cutDmdResult (n-1)) rs) cutDmdResult n (Converges c) = Converges (cutCPRResult n c) cutDmdResult n (Dunno c) = Dunno (cutCPRResult n c) +-- Forget the CPR information, but remember if it converges or diverges +-- Used for non-strict thunks and non-top-level things with sum type +forgetCPR :: DmdResult -> DmdResult +forgetCPR Diverges = Diverges +forgetCPR (Converges _) = Converges NoCPR +forgetCPR (Dunno _) = Dunno NoCPR + +forgetSumCPR :: DmdResult -> DmdResult +forgetSumCPR Diverges = Diverges +forgetSumCPR (Converges r) = Converges (forgetSumCPR_help r) +forgetSumCPR (Dunno r) = Dunno (forgetSumCPR_help r) + +forgetSumCPR_help :: CPRResult -> CPRResult +forgetSumCPR_help (RetProd ds) = RetProd (map forgetSumCPR ds) +forgetSumCPR_help (RetSum _) = NoCPR +forgetSumCPR_help NoCPR = NoCPR + + vanillaCprProdRes :: Arity -> DmdResult vanillaCprProdRes arity = cprProdRes (replicate arity topRes) @@ -867,20 +886,6 @@ isBotRes :: DmdResult -> Bool isBotRes Diverges = True isBotRes _ = False -trimCPRInfo :: Bool -> Bool -> DmdResult -> DmdResult -trimCPRInfo trim_all trim_sums res - = trimR res - where - trimR (Converges c) = Converges (trimC c) - trimR (Dunno c) = Dunno (trimC c) - trimR Diverges = Diverges - - trimC (RetSum n) | trim_all || trim_sums = NoCPR - | otherwise = RetSum n - trimC (RetProd rs) | trim_all = NoCPR - | otherwise = RetProd (map trimR rs) - trimC NoCPR = NoCPR - returnsCPR_maybe :: DmdResult -> Maybe ConTag returnsCPR_maybe (Converges c) = retCPR_maybe c returnsCPR_maybe (Dunno c) = retCPR_maybe c diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index bfe406f..5ae2439 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -652,22 +652,26 @@ dmdAnalRhs :: TopLevelFlag -> (StrictSig, DmdEnv, Id, CoreExpr) -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. -dmdAnalRhs top_lvl rec_flag env id rhs +dmdAnalRhs top_lvl rec_flag env var rhs | Just fn <- unpackTrivial rhs -- See Note [Trivial right-hand sides] , let fn_str = getStrictness env fn - = (fn_str, emptyDmdEnv, set_idStrictness env id fn_str, rhs) + = (fn_str, emptyDmdEnv, set_idStrictness env var fn_str, rhs) | otherwise - = (sig_ty, lazy_fv, id', mkLams bndrs' body') + = (sig_ty, lazy_fv, var', mkLams bndrs' body') where - (bndrs, body) = collectBinders rhs - env_body = foldl extendSigsWithLam env bndrs - (body_ty, body') = dmdAnal env_body body_dmd body - body_ty' = removeDmdTyArgs body_ty -- zap possible deep CPR info + (bndrs, body) = collectBinders rhs + env_body = foldl extendSigsWithLam env bndrs + (body_ty, body') = dmdAnal env_body body_dmd body + body_ty' = removeDmdTyArgs body_ty -- zap possible deep CPR info (DmdType rhs_fv rhs_dmds rhs_res, bndrs') - = annotateLamBndrs env (isDFunId id) body_ty' bndrs - sig_ty = mkStrictSig (mkDmdType sig_fv rhs_dmds rhs_res') - id' = set_idStrictness env id sig_ty + = annotateLamBndrs env (isDFunId var) body_ty' bndrs + sig_ty = mkStrictSig $ + mkDmdType sig_fv rhs_dmds $ + handle_sum_cpr $ + handle_thunk_cpr $ + rhs_res + var' = set_idStrictness env var sig_ty -- See Note [NOINLINE and strictness] -- See Note [Product demands for function body] @@ -683,16 +687,19 @@ dmdAnalRhs top_lvl rec_flag env id rhs (lazy_fv, sig_fv) = splitFVs is_thunk rhs_fv1 - rhs_res' = trimCPRInfo trim_all trim_sums rhs_res - trim_all = is_thunk && not_strict - trim_sums = not (isTopLevel top_lvl) -- See Note [CPR for sum types] + -- Note [CPR for sum types] + handle_sum_cpr | isTopLevel top_lvl = id + | otherwise = forgetSumCPR -- See Note [CPR for thunks] + handle_thunk_cpr | is_thunk && not_strict = forgetCPR + | otherwise = id + is_thunk = not (exprIsHNF rhs) not_strict = isTopLevel top_lvl -- Top level and recursive things don't || isJust rec_flag -- get their demandInfo set at all - || not (isStrictDmd (idDemandInfo id) || ae_virgin env) + || not (isStrictDmd (idDemandInfo var) || ae_virgin env) -- See Note [Optimistic CPR in the "virgin" case] unpackTrivial :: CoreExpr -> Maybe Id @@ -883,6 +890,9 @@ may be CPR'd (via the returned Justs). But in the case of sums, there may be Nothing alternatives; and that messes up the sum-type CPR. +This also applies to nested CPR information: Keep product CPR information, but +zap sum CPR information therein. + Conclusion: only do this for products. It's still not guaranteed OK for products, but sums definitely lose sometimes. From git at git.haskell.org Tue Feb 4 18:27:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:10 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Pass nested CPR information from scrunitee to body (2e6a0d8) Message-ID: <20140204182710.E365F2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/2e6a0d80451a0f3e5d676c5424a82859b1974a60/ghc >--------------------------------------------------------------- commit 2e6a0d80451a0f3e5d676c5424a82859b1974a60 Author: Joachim Breitner Date: Wed Jan 8 15:09:42 2014 +0000 Pass nested CPR information from scrunitee to body in case of a complex case scrunitee. >--------------------------------------------------------------- 2e6a0d80451a0f3e5d676c5424a82859b1974a60 compiler/basicTypes/Demand.lhs | 15 +++++++++++++-- compiler/stranal/DmdAnal.lhs | 41 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+), 2 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index c7338c4..da576f3 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -27,8 +27,9 @@ module Demand ( peelFV, DmdResult, CPRResult, - isBotRes, isTopRes, getDmdResult, + isBotRes, isTopRes, getDmdResult, resTypeArgDmd, topRes, convRes, botRes, cprProdRes, vanillaCprProdRes, cprSumRes, + splitNestedRes, appIsBottom, isBottomingSig, pprIfaceStrictSig, returnsCPR_maybe, forgetCPR, forgetSumCPR, @@ -702,6 +703,7 @@ splitProdDmd_maybe (JD {strd = s, absd = u}) (Str s, Use _ (UProd ux)) -> Just (mkJointDmds (splitStrProdDmd (length ux) s) ux) (Lazy, Use _ (UProd ux)) -> Just (mkJointDmds (replicate (length ux) Lazy) ux) _ -> Nothing + \end{code} %************************************************************************ @@ -874,10 +876,19 @@ forgetSumCPR_help (RetProd ds) = RetProd (map forgetSumCPR ds) forgetSumCPR_help (RetSum _) = NoCPR forgetSumCPR_help NoCPR = NoCPR - vanillaCprProdRes :: Arity -> DmdResult vanillaCprProdRes arity = cprProdRes (replicate arity topRes) +splitNestedRes :: DmdResult -> [DmdResult] +splitNestedRes Diverges = repeat topRes +splitNestedRes (Dunno c) = splitNestedCPR c +splitNestedRes (Converges c) = splitNestedCPR c + +splitNestedCPR :: CPRResult -> [DmdResult] +splitNestedCPR NoCPR = repeat topRes +splitNestedCPR (RetSum _) = repeat topRes +splitNestedCPR (RetProd cs) = cs + isTopRes :: DmdResult -> Bool isTopRes (Dunno NoCPR) = True isTopRes _ = False diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 5ae2439..c4b9f02 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -191,6 +191,44 @@ dmdAnal env dmd (Lam var body) in (postProcessUnsat defer_and_use lam_ty, Lam var' body') +dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, bndrs, _)]) + -- Only one alternative with a product constructor, and a complex scrutinee + | let tycon = dataConTyCon dc + , isProductTyCon tycon + -- If the scrutinee is not trivial, we are not going to get much from + -- passing the body demand to it. OTOH, we might be getting some nested CPR + -- information from the scrutinee that we can feed into the bound variables. + , not (exprIsTrivial scrut) + , Just rec_tc' <- checkRecTc (ae_rec_tc env) tycon + = let + scrut_dmd = mkProdDmd (replicate (dataConRepArity dc) topDmd) + (scrut_ty, scrut') = dmdAnal env scrut_dmd scrut + + scrut_ret = getDmdResult scrut_ty + comp_rets = take (dataConRepArity dc) $ splitNestedRes scrut_ret -- infinite list! + + -- Build a surely converging, CPR carrying signature for the builder, + -- and for the components use what we get from the scrunitee + case_bndr_sig = mkClosedStrictSig [] (cprProdRes comp_rets) + + env_w_tc = env { ae_rec_tc = rec_tc' } + env_alt = extendAnalEnvs NotTopLevel env_w_tc $ + (case_bndr, case_bndr_sig) : + zipWithEqual "dmdAnal:CaseComplex" + (\b ty -> (b, mkClosedStrictSig [] ty)) bndrs comp_rets + + (alt_ty, alt') = dmdAnalAlt env_alt dmd alt + (alt_ty1, case_bndr') = annotateBndr env alt_ty case_bndr + res_ty = alt_ty1 `bothDmdType` toBothDmdArg scrut_ty + in + -- pprTrace "dmdAnal:CaseComplex" (vcat [ text "scrut" <+> ppr scrut + -- , text "dmd" <+> ppr dmd + -- , text "scrut_dmd" <+> ppr scrut_dmd + -- , text "scrut_ty" <+> ppr scrut_ty + -- , text "alt_ty" <+> ppr alt_ty1 + -- , text "res_ty" <+> ppr res_ty ]) $ + (res_ty, Case scrut' case_bndr' ty [alt']) + dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)]) -- Only one alternative with a product constructor | let tycon = dataConTyCon dc @@ -1117,6 +1155,9 @@ sigEnv = ae_sigs updSigEnv :: AnalEnv -> SigEnv -> AnalEnv updSigEnv env sigs = env { ae_sigs = sigs } +extendAnalEnvs :: TopLevelFlag -> AnalEnv -> [(Id, StrictSig)] -> AnalEnv +extendAnalEnvs top_lvl = foldl' (\e (i,s) -> extendAnalEnv top_lvl e i s) + extendAnalEnv :: TopLevelFlag -> AnalEnv -> Id -> StrictSig -> AnalEnv extendAnalEnv top_lvl env var sig = env { ae_sigs = extendSigEnv top_lvl (ae_sigs env) var sig' } From git at git.haskell.org Tue Feb 4 18:27:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:13 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: CPR test case: Case binder CPR (3336339) Message-ID: <20140204182713.D78402406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/3336339b03e5961a3064c43a8ab062f080b6ef55/ghc >--------------------------------------------------------------- commit 3336339b03e5961a3064c43a8ab062f080b6ef55 Author: Joachim Breitner Date: Tue Jan 14 09:36:34 2014 +0000 CPR test case: Case binder CPR >--------------------------------------------------------------- 3336339b03e5961a3064c43a8ab062f080b6ef55 testsuite/tests/stranal/sigs/CaseBinderCPR.hs | 15 +++++++++++++++ .../stranal/sigs/{T8569.stderr => CaseBinderCPR.stderr} | 2 +- testsuite/tests/stranal/sigs/all.T | 1 + 3 files changed, 17 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/stranal/sigs/CaseBinderCPR.hs b/testsuite/tests/stranal/sigs/CaseBinderCPR.hs new file mode 100644 index 0000000..13f2163 --- /dev/null +++ b/testsuite/tests/stranal/sigs/CaseBinderCPR.hs @@ -0,0 +1,15 @@ +module CaseBinderCPR where + +-- This example, taken from nofib's transform (and heavily reduced) ensures that +-- CPR information is added to a case binder + +f_list_cmp::(t1 -> t1 -> Int) -> [t1] -> [t1] -> Int; +f_list_cmp a_cmp [] []= 0 +f_list_cmp a_cmp [] a_ys= -1 +f_list_cmp a_cmp a_xs []= 1 +f_list_cmp a_cmp (a_x:a_xs) (a_y:a_ys)= + if r_order == 0 + then f_list_cmp a_cmp a_xs a_ys + else r_order + where + r_order = a_cmp a_x a_y diff --git a/testsuite/tests/stranal/sigs/T8569.stderr b/testsuite/tests/stranal/sigs/CaseBinderCPR.stderr similarity index 53% copy from testsuite/tests/stranal/sigs/T8569.stderr copy to testsuite/tests/stranal/sigs/CaseBinderCPR.stderr index d33935e..f2ea61d 100644 --- a/testsuite/tests/stranal/sigs/T8569.stderr +++ b/testsuite/tests/stranal/sigs/CaseBinderCPR.stderr @@ -1,5 +1,5 @@ ==================== Strictness signatures ==================== -T8569.addUp: +CaseBinderCPR.f_list_cmp: m() diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T index 9d36479..81a8d4b 100644 --- a/testsuite/tests/stranal/sigs/all.T +++ b/testsuite/tests/stranal/sigs/all.T @@ -15,3 +15,4 @@ test('FacState', expect_broken(1600), compile, ['']) test('UnsatFun', normal, compile, ['']) test('BottomFromInnerLambda', normal, compile, ['']) test('DmdAnalGADTs', normal, compile, ['']) +test('CaseBinderCPR', normal, compile, ['']) From git at git.haskell.org Tue Feb 4 18:27:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:16 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Actually create a nested CPR worker-wrapper (220998d) Message-ID: <20140204182717.08DF72406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/220998dc2289b73af410cc31a25bd58cf14652b9/ghc >--------------------------------------------------------------- commit 220998dc2289b73af410cc31a25bd58cf14652b9 Author: Joachim Breitner Date: Thu Dec 5 18:58:07 2013 +0000 Actually create a nested CPR worker-wrapper >--------------------------------------------------------------- 220998dc2289b73af410cc31a25bd58cf14652b9 compiler/basicTypes/Demand.lhs | 20 ++++--- compiler/stranal/WwLib.lhs | 128 +++++++++++++++++++++++++--------------- 2 files changed, 93 insertions(+), 55 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 220998dc2289b73af410cc31a25bd58cf14652b9 From git at git.haskell.org Tue Feb 4 18:27:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:19 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Inline the datacon wrapper more aggressively (ecb4cc4) Message-ID: <20140204182719.744702406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/ecb4cc42c87d4efa433b866d67b004c90a58b1ce/ghc >--------------------------------------------------------------- commit ecb4cc42c87d4efa433b866d67b004c90a58b1ce Author: Joachim Breitner Date: Tue Jan 14 10:18:48 2014 +0000 Inline the datacon wrapper more aggressively so that the CPR analysis find the real constructor and can return a nested CPR result. An alternative would be to look through the unfolding and analize that (but that would only be a good idea if the wrapper is going to be inlined afterwards), or special-case wrappers in the demand analyzer. Both not very nice. According to nofib: The impact of this is (on code size and allocations) is ... nil. >--------------------------------------------------------------- ecb4cc42c87d4efa433b866d67b004c90a58b1ce compiler/basicTypes/MkId.lhs | 2 +- compiler/coreSyn/CoreUnfold.lhs | 31 ++++++++++++++++++++ .../tests/deSugar/should_compile/T2431.stderr | 2 +- .../tests/simplCore/should_compile/T7360.stderr | 2 +- 4 files changed, 34 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index b7716b2..150cf0d 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -513,7 +513,7 @@ mkDataConRep dflags fam_envs wrap_name data_con -- ...(let w = C x in ...(w p q)...)... -- we want to see that w is strict in its two arguments - wrap_unf = mkInlineUnfolding (Just wrap_arity) wrap_rhs + wrap_unf = mkDataConWrapUnfolding wrap_arity wrap_rhs wrap_tvs = (univ_tvs `minusList` map fst eq_spec) ++ ex_tvs wrap_rhs = mkLams wrap_tvs $ mkLams wrap_args $ diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index a219de8..2df8139 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -29,6 +29,7 @@ module CoreUnfold ( mkUnfolding, mkCoreUnfolding, mkTopUnfolding, mkSimpleUnfolding, mkInlineUnfolding, mkInlinableUnfolding, mkWwInlineRule, + mkDataConWrapUnfolding, mkCompulsoryUnfolding, mkDFunUnfolding, interestingArg, ArgSummary(..), @@ -127,6 +128,16 @@ mkInlineUnfolding mb_arity expr boring_ok = inlineBoringOk expr' +mkDataConWrapUnfolding :: Arity -> CoreExpr -> Unfolding +mkDataConWrapUnfolding arity expr + = mkCoreUnfolding InlineStable + True + expr' arity + (UnfWhen needSaturated boringCxtOk) + -- Note [Inline data constructor wrappers aggresively] + where + expr' = simpleOptExpr expr + mkInlinableUnfolding :: DynFlags -> CoreExpr -> Unfolding mkInlinableUnfolding dflags expr = mkUnfolding dflags InlineStable True is_bot expr' @@ -199,6 +210,26 @@ This can occasionally mean that the guidance is very pessimistic; it gets fixed up next round. And it should be rare, because large let-bound things that are dead are usually caught by preInlineUnconditionally +Note [Inline data constructor wrappers aggresively] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The wrappers for strict data type constructors are to be inlined even in +a boring context. This increases the chance that the demand analyzer will +see the real constructor and return a nested CPR property. + +For example: + data P a = P !a !b + f :: Int -> P Int Int + f x = P x x +previously, the demand analyzer would only see + f x = $WP x x +and infer a strictness signature of "m(,)", i.e. a non-nested CPR property. + +But if we inline $WP, we get + f x = case x of _ -> P x x +and we would get ",m(t(),t())", i.e. a nested CPR property. + +A real world example of this issue is the function mean in [ticket:2289#comment:1]. + %************************************************************************ %* * diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr index dbafaed..0d68d40 100644 --- a/testsuite/tests/deSugar/should_compile/T2431.stderr +++ b/testsuite/tests/deSugar/should_compile/T2431.stderr @@ -8,7 +8,7 @@ T2431.$WRefl [InlPrag=INLINE] :: forall a. a T2431.:~: a Str=DmdType, Unf=Unf{Src=InlineStable, TopLvl=True, Arity=0, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=False) + Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=True) Tmpl= \ (@ a) -> T2431.Refl @ a @ a @~ _N}] T2431.$WRefl = \ (@ a) -> T2431.Refl @ a @ a @~ _N diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr index 51207a6..b3f70e9 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.stderr +++ b/testsuite/tests/simplCore/should_compile/T7360.stderr @@ -9,7 +9,7 @@ T7360.$WFoo3 [InlPrag=INLINE] :: GHC.Types.Int -> T7360.Foo Str=DmdType m3, Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=False) + Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=True) Tmpl= \ (dt [Occ=Once!] :: GHC.Types.Int) -> case dt of _ [Occ=Dead] { GHC.Types.I# dt [Occ=Once] -> T7360.Foo3 dt From git at git.haskell.org Tue Feb 4 18:27:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:22 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Add a testcase with an infinite CPR property (868496a) Message-ID: <20140204182722.F27452406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/868496a83120fc8cab33f7d92692ea4c6da608fa/ghc >--------------------------------------------------------------- commit 868496a83120fc8cab33f7d92692ea4c6da608fa Author: Joachim Breitner Date: Fri Jan 17 09:48:39 2014 +0000 Add a testcase with an infinite CPR property >--------------------------------------------------------------- 868496a83120fc8cab33f7d92692ea4c6da608fa testsuite/tests/stranal/sigs/InfiniteCPR.hs | 10 ++++++++++ .../sigs/{StrAnalExample.stderr => InfiniteCPR.stderr} | 2 +- testsuite/tests/stranal/sigs/all.T | 1 + 3 files changed, 12 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/stranal/sigs/InfiniteCPR.hs b/testsuite/tests/stranal/sigs/InfiniteCPR.hs new file mode 100644 index 0000000..f814792 --- /dev/null +++ b/testsuite/tests/stranal/sigs/InfiniteCPR.hs @@ -0,0 +1,10 @@ +module InfiniteCPR where + +data Rec1 = Foo Rec2 Rec2 +data Rec2 = Bar Rec1 Rec1 + +f a = + let x = Foo a y + y = Bar x x + in x + diff --git a/testsuite/tests/stranal/sigs/StrAnalExample.stderr b/testsuite/tests/stranal/sigs/InfiniteCPR.stderr similarity index 63% copy from testsuite/tests/stranal/sigs/StrAnalExample.stderr copy to testsuite/tests/stranal/sigs/InfiniteCPR.stderr index dbe4770..70a3cdf 100644 --- a/testsuite/tests/stranal/sigs/StrAnalExample.stderr +++ b/testsuite/tests/stranal/sigs/InfiniteCPR.stderr @@ -1,5 +1,5 @@ ==================== Strictness signatures ==================== -StrAnalExample.foo: +InfiniteCPR.f: m(,m(tm(,),tm(,))) diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T index 81a8d4b..7fde06b 100644 --- a/testsuite/tests/stranal/sigs/all.T +++ b/testsuite/tests/stranal/sigs/all.T @@ -16,3 +16,4 @@ test('UnsatFun', normal, compile, ['']) test('BottomFromInnerLambda', normal, compile, ['']) test('DmdAnalGADTs', normal, compile, ['']) test('CaseBinderCPR', normal, compile, ['']) +test('InfiniteCPR', normal, compile, ['']) From git at git.haskell.org Tue Feb 4 18:27:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:25 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Mark FacState as not broken (db71595) Message-ID: <20140204182725.4145B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/db71595e492cd551685f150eaf117118795a8db2/ghc >--------------------------------------------------------------- commit db71595e492cd551685f150eaf117118795a8db2 Author: Joachim Breitner Date: Fri Jan 17 09:59:14 2014 +0000 Mark FacState as not broken >--------------------------------------------------------------- db71595e492cd551685f150eaf117118795a8db2 testsuite/tests/stranal/sigs/FacState.stderr | 2 +- testsuite/tests/stranal/sigs/all.T | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/stranal/sigs/FacState.stderr b/testsuite/tests/stranal/sigs/FacState.stderr index 133ad6e..9757620 100644 --- a/testsuite/tests/stranal/sigs/FacState.stderr +++ b/testsuite/tests/stranal/sigs/FacState.stderr @@ -1,5 +1,5 @@ ==================== Strictness signatures ==================== -FacState.fac: dm1(d,tm1(d)) +FacState.fac: m(,tm(t)) diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T index 7fde06b..ea66fdc 100644 --- a/testsuite/tests/stranal/sigs/all.T +++ b/testsuite/tests/stranal/sigs/all.T @@ -11,7 +11,7 @@ test('StrAnalExample', normal, compile, ['']) test('T8569', expect_broken(8569), compile, ['']) test('HyperStrUse', normal, compile, ['']) test('T8598', normal, compile, ['']) -test('FacState', expect_broken(1600), compile, ['']) +test('FacState', normal, compile, ['']) test('UnsatFun', normal, compile, ['']) test('BottomFromInnerLambda', normal, compile, ['']) test('DmdAnalGADTs', normal, compile, ['']) From git at git.haskell.org Tue Feb 4 18:27:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:27 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Do not attach CPR information to data constructor ids (92fa9f0) Message-ID: <20140204182727.BD5612406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/92fa9f050355d7c0ba91c3722fbfa848ff3c78f0/ghc >--------------------------------------------------------------- commit 92fa9f050355d7c0ba91c3722fbfa848ff3c78f0 Author: Joachim Breitner Date: Fri Jan 17 10:36:09 2014 +0000 Do not attach CPR information to data constructor ids because the worker is handled specially by the demand analyser, and the wrapper is expected to be inlined before that. There are corner cases (such as undersaturated calls) where this loses information, but nofib does not know any of these. On the other side it simplifies and removes code, and it makes it easier to get holdof the DynFlags whenever we create CPR information. >--------------------------------------------------------------- 92fa9f050355d7c0ba91c3722fbfa848ff3c78f0 compiler/basicTypes/Demand.lhs | 5 +-- compiler/basicTypes/MkId.lhs | 37 ++------------------ .../tests/simplCore/should_compile/T7360.stderr | 2 +- 3 files changed, 4 insertions(+), 40 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index 5c06080..2363d04 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -28,7 +28,7 @@ module Demand ( DmdResult, CPRResult, isBotRes, isTopRes, getDmdResult, resTypeArgDmd, - topRes, convRes, botRes, cprProdRes, vanillaCprProdRes, cprSumRes, + topRes, convRes, botRes, cprProdRes, cprSumRes, splitNestedRes, appIsBottom, isBottomingSig, pprIfaceStrictSig, returnsCPR_maybe, @@ -876,9 +876,6 @@ forgetSumCPR_help (RetProd ds) = RetProd (map forgetSumCPR ds) forgetSumCPR_help (RetSum _) = NoCPR forgetSumCPR_help NoCPR = NoCPR -vanillaCprProdRes :: Arity -> DmdResult -vanillaCprProdRes arity = cprProdRes (replicate arity topRes) - splitNestedRes :: DmdResult -> [DmdResult] splitNestedRes Diverges = repeat topRes splitNestedRes (Dunno c) = splitNestedCPR c diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index 150cf0d..1e6f3ee 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -389,11 +389,9 @@ mkDataConWorkId wkr_name data_con wkr_arity = dataConRepArity data_con wkr_info = noCafIdInfo `setArityInfo` wkr_arity - `setStrictnessInfo` wkr_sig `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, -- even if arity = 0 - wkr_sig = mkClosedStrictSig (replicate wkr_arity topDmd) (dataConCPR data_con) -- Note [Data-con worker strictness] -- Notice that we do *not* say the worker is strict -- even if the data constructor is declared strict @@ -426,33 +424,6 @@ mkDataConWorkId wkr_name data_con mkCompulsoryUnfolding $ mkLams nt_tvs $ Lam id_arg1 $ wrapNewTypeBody tycon res_ty_args (Var id_arg1) - -dataConCPR :: DataCon -> DmdResult -dataConCPR con - | isDataTyCon tycon -- Real data types only; that is, - -- not unboxed tuples or newtypes - , isVanillaDataCon con -- No existentials - , wkr_arity > 0 - , wkr_arity <= mAX_CPR_SIZE - = if is_prod then vanillaCprProdRes (dataConRepArity con) - else cprSumRes (dataConTag con) - | otherwise - = topRes - where - is_prod = isProductTyCon tycon - tycon = dataConTyCon con - wkr_arity = dataConRepArity con - - mAX_CPR_SIZE :: Arity - mAX_CPR_SIZE = 10 - -- We do not treat very big tuples as CPR-ish: - -- a) for a start we get into trouble because there aren't - -- "enough" unboxed tuple types (a tiresome restriction, - -- but hard to fix), - -- b) more importantly, big unboxed tuples get returned mainly - -- on the stack, and are often then allocated in the heap - -- by the caller. So doing CPR for them may in fact make - -- things worse. \end{code} ------------------------------------------------- @@ -497,16 +468,12 @@ mkDataConRep dflags fam_envs wrap_name data_con -- does not tidy the IdInfo of implicit bindings (like the wrapper) -- so it not make sure that the CAF info is sane - wrap_sig_conv = mkClosedStrictSig wrap_arg_dmds (dataConCPR data_con) - wrap_sig | any isBanged (dropList eq_spec wrap_bangs) = sigMayDiverge wrap_sig_conv - | otherwise = wrap_sig_conv + wrap_sig = mkClosedStrictSig wrap_arg_dmds topRes wrap_arg_dmds = map mk_dmd (dropList eq_spec wrap_bangs) mk_dmd str | isBanged str = evalDmd | otherwise = topDmd - -- The Cpr info can be important inside INLINE rhss, where the - -- wrapper constructor isn't inlined. - -- And the argument strictness can be important too; we + -- The argument strictness can be important; we -- may not inline a contructor when it is partially applied. -- For example: -- data W = C !Int !Int !Int diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr index b3f70e9..627dc32 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.stderr +++ b/testsuite/tests/simplCore/should_compile/T7360.stderr @@ -6,7 +6,7 @@ T7360.$WFoo3 [InlPrag=INLINE] :: GHC.Types.Int -> T7360.Foo [GblId[DataConWrapper], Arity=1, Caf=NoCafRefs, - Str=DmdType m3, + Str=DmdType , Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=True) From git at git.haskell.org Tue Feb 4 18:27:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:30 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Remove dmdTransformDataConSig (7e92656) Message-ID: <20140204182731.509F52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/7e92656934f5e2f5bd55bcc6fb41960305fdf766/ghc >--------------------------------------------------------------- commit 7e92656934f5e2f5bd55bcc6fb41960305fdf766 Author: Joachim Breitner Date: Fri Jan 17 10:46:45 2014 +0000 Remove dmdTransformDataConSig it does nothing that dmdAnalVarApp would not have done before >--------------------------------------------------------------- 7e92656934f5e2f5bd55bcc6fb41960305fdf766 compiler/basicTypes/Demand.lhs | 26 +------------------------- compiler/stranal/DmdAnal.lhs | 4 ---- 2 files changed, 1 insertion(+), 29 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index 2363d04..579813c 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -45,7 +45,7 @@ module Demand ( postProcessUnsat, postProcessDmdTypeM, splitProdDmd, splitProdDmd_maybe, peelCallDmd, mkCallDmd, mkCallDmdN, - dmdTransformSig, dmdTransformDataConSig, dmdTransformDictSelSig, + dmdTransformSig, dmdTransformDictSelSig, argOneShots, argsOneShots, isSingleUsed, reuseEnv, zapDemand, zapStrictSig, @@ -1588,30 +1588,6 @@ dmdTransformSig (StrictSig dmd_ty@(DmdType _ arg_ds _)) cd = postProcessUnsat (peelManyCalls (length arg_ds) cd) dmd_ty -- see Note [Demands from unsaturated function calls] -dmdTransformDataConSig :: Arity -> StrictSig -> CleanDemand -> DmdType --- Same as dmdTransformSig but for a data constructor (worker), --- which has a special kind of demand transformer. --- If the constructor is saturated, we feed the demand on --- the result into the constructor arguments. -dmdTransformDataConSig arity (StrictSig (DmdType _ _ con_res)) - (CD { sd = str, ud = abs }) - | Just str_dmds <- go_str arity str - , Just abs_dmds <- go_abs arity abs - = DmdType emptyDmdEnv (mkJointDmds str_dmds abs_dmds) con_res - -- Must remember whether it's a product, hence con_res, not TopRes - - | otherwise -- Not saturated - = nopDmdType - where - go_str 0 dmd = Just (splitStrProdDmd arity dmd) - go_str n (SCall s') = go_str (n-1) s' - go_str n HyperStr = go_str (n-1) HyperStr - go_str _ _ = Nothing - - go_abs 0 dmd = Just (splitUseProdDmd arity dmd) - go_abs n (UCall One u') = go_abs (n-1) u' - go_abs _ _ = Nothing - dmdTransformDictSelSig :: StrictSig -> CleanDemand -> DmdType -- Like dmdTransformDataConSig, we have a special demand transformer -- for dictionary selectors. If the selector is saturated (ie has one diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index c4b9f02..fa4ad8b 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -511,10 +511,6 @@ dmdTransform :: AnalEnv -- The strictness environment -- this function plus demand on its free variables dmdTransform env var dmd - | isDataConWorkId var -- Data constructor - = dmdTransformDataConSig - (idArity var) (idStrictness var) dmd - | gopt Opt_DmdTxDictSel (ae_dflags env), Just _ <- isClassOpId_maybe var -- Dictionary component selector = dmdTransformDictSelSig (idStrictness var) dmd From git at git.haskell.org Tue Feb 4 18:27:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:33 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Unify the code paths that create cpr signatures (2ee0836) Message-ID: <20140204182733.93A812406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/2ee0836af24625d2101c54989f62b74a48e7abc9/ghc >--------------------------------------------------------------- commit 2ee0836af24625d2101c54989f62b74a48e7abc9 Author: Joachim Breitner Date: Fri Jan 17 12:03:42 2014 +0000 Unify the code paths that create cpr signatures >--------------------------------------------------------------- 2ee0836af24625d2101c54989f62b74a48e7abc9 compiler/basicTypes/Demand.lhs | 18 +++++++++++------- compiler/stranal/DmdAnal.lhs | 13 +++++++------ 2 files changed, 18 insertions(+), 13 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index 579813c..c224572 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -19,7 +19,7 @@ module Demand ( peelUseCall, cleanUseDmd_maybe, strictenDmd, bothCleanDmd, DmdType(..), dmdTypeDepth, lubDmdType, lubDmdTypes, bothDmdType, - nopDmdType, litDmdType, botDmdType, mkDmdType, + nopDmdType, litDmdType, botDmdType, mkDmdType, cprProdDmdType, cprSumDmdType, addDemand, removeDmdTyArgs, BothDmdArg, mkBothDmdArg, toBothDmdArg, @@ -28,7 +28,7 @@ module Demand ( DmdResult, CPRResult, isBotRes, isTopRes, getDmdResult, resTypeArgDmd, - topRes, convRes, botRes, cprProdRes, cprSumRes, + topRes, convRes, botRes, splitNestedRes, appIsBottom, isBottomingSig, pprIfaceStrictSig, returnsCPR_maybe, @@ -1162,9 +1162,13 @@ nopDmdType = DmdType emptyDmdEnv [] topRes botDmdType = DmdType emptyDmdEnv [] botRes litDmdType = DmdType emptyDmdEnv [] convRes -cprProdDmdType :: Arity -> DmdType -cprProdDmdType arity - = DmdType emptyDmdEnv [] (Dunno (RetProd (replicate arity topRes))) +cprProdDmdType :: [DmdResult] -> DmdType +cprProdDmdType arg_ress + = DmdType emptyDmdEnv [] $ cprProdRes arg_ress + +cprSumDmdType :: ConTag -> DmdType +cprSumDmdType tag + = DmdType emptyDmdEnv [] $ cprSumRes tag isNopDmdType :: DmdType -> Bool isNopDmdType (DmdType env [] res) @@ -1542,8 +1546,8 @@ nopSig, botSig :: StrictSig nopSig = StrictSig nopDmdType botSig = StrictSig botDmdType -cprProdSig :: Arity -> StrictSig -cprProdSig arity = StrictSig (cprProdDmdType arity) +cprProdSig :: [DmdResult] -> StrictSig +cprProdSig arg_ress = StrictSig (cprProdDmdType arg_ress) sigMayDiverge :: StrictSig -> StrictSig sigMayDiverge (StrictSig (DmdType env ds res)) = (StrictSig (DmdType env ds (divergeDmdResult res))) diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index fa4ad8b..e86e597 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -209,7 +209,7 @@ dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, bndrs, _)]) -- Build a surely converging, CPR carrying signature for the builder, -- and for the components use what we get from the scrunitee - case_bndr_sig = mkClosedStrictSig [] (cprProdRes comp_rets) + case_bndr_sig = cprProdSig comp_rets env_w_tc = env { ae_rec_tc = rec_tc' } env_alt = extendAnalEnvs NotTopLevel env_w_tc $ @@ -240,7 +240,7 @@ dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)]) (alt_ty, alt') = dmdAnalAlt env_alt dmd alt (alt_ty1, case_bndr') = annotateBndr env alt_ty case_bndr (_, bndrs', _) = alt' - case_bndr_sig = cprProdSig (dataConRepArity dc) + case_bndr_sig = cprProdSig (replicate (dataConRepArity dc) topRes) -- Inside the alternative, the case binder has the CPR property, and -- is known to converge. -- Meaning that a case on it will successfully cancel. @@ -570,9 +570,9 @@ dmdAnalVarApp env dmd fun args , dataConRepArity con > 0 , dataConRepArity con < 10 , let cpr_info - | isProductTyCon (dataConTyCon con) = cprProdRes arg_rets - | otherwise = cprSumRes (dataConTag con) - res_ty = foldl bothDmdType (DmdType emptyDmdEnv [] cpr_info) arg_tys + | isProductTyCon (dataConTyCon con) = cprProdDmdType arg_rets + | otherwise = cprSumDmdType (dataConTag con) + res_ty = foldl bothDmdType cpr_info arg_tys = -- pprTrace "dmdAnalVarApp" (vcat [ ppr con, ppr args, ppr n_val_args, ppr cxt_ds -- , ppr arg_tys, ppr cpr_info, ppr res_ty]) $ ( res_ty @@ -1194,7 +1194,8 @@ extendSigsWithLam env id -- See Note [Optimistic CPR in the "virgin" case] -- See Note [Initial CPR for strict binders] , Just (dc,_,_,_) <- deepSplitProductType_maybe (ae_fam_envs env) $ idType id - = extendAnalEnv NotTopLevel env id (sigMayDiverge (cprProdSig (dataConRepArity dc))) + = extendAnalEnv NotTopLevel env id $ sigMayDiverge $ + cprProdSig (replicate (dataConRepArity dc) topRes) | otherwise = env From git at git.haskell.org Tue Feb 4 18:27:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:36 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Replace static CPR flags by dynamic -fcpr-depth (c636d36) Message-ID: <20140204182736.7F43F2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/c636d36cfd001e5863e4680ee86864a322d444fa/ghc >--------------------------------------------------------------- commit c636d36cfd001e5863e4680ee86864a322d444fa Author: Joachim Breitner Date: Fri Jan 17 13:12:28 2014 +0000 Replace static CPR flags by dynamic -fcpr-depth which can disable cpr altogether (=0), disable nested cpr (=1) or finetune cpr. Also includes a testcase for this. >--------------------------------------------------------------- c636d36cfd001e5863e4680ee86864a322d444fa compiler/basicTypes/Demand.lhs | 52 +++++++------------- compiler/main/DynFlags.hs | 6 +++ compiler/main/StaticFlags.hs | 13 +---- compiler/stranal/DmdAnal.lhs | 12 +++-- docs/users_guide/flags.xml | 9 ++++ .../sigs/{InfiniteCPR.hs => InfiniteCPRDepth0.hs} | 2 + .../{T8569.stderr => InfiniteCPRDepth0.stderr} | 2 +- .../sigs/{InfiniteCPR.hs => InfiniteCPRDepth1.hs} | 2 + .../{T8569.stderr => InfiniteCPRDepth1.stderr} | 2 +- testsuite/tests/stranal/sigs/all.T | 2 + 10 files changed, 48 insertions(+), 54 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c636d36cfd001e5863e4680ee86864a322d444fa From git at git.haskell.org Tue Feb 4 18:27:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:39 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: CPR testcase: AnonLambda (b4c2be0) Message-ID: <20140204182739.9CA102406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/b4c2be09d2a4f7f9d6b6008e450ffd0d29b6fdea/ghc >--------------------------------------------------------------- commit b4c2be09d2a4f7f9d6b6008e450ffd0d29b6fdea Author: Joachim Breitner Date: Tue Jan 21 12:18:08 2014 +0000 CPR testcase: AnonLambda >--------------------------------------------------------------- b4c2be09d2a4f7f9d6b6008e450ffd0d29b6fdea testsuite/tests/stranal/sigs/AnonLambda.hs | 11 +++++++++++ .../stranal/sigs/{InfiniteCPR.stderr => AnonLambda.stderr} | 3 ++- testsuite/tests/stranal/sigs/all.T | 1 + 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/stranal/sigs/AnonLambda.hs b/testsuite/tests/stranal/sigs/AnonLambda.hs new file mode 100644 index 0000000..f79b940 --- /dev/null +++ b/testsuite/tests/stranal/sigs/AnonLambda.hs @@ -0,0 +1,11 @@ +module AnonLambda where + +g :: Int -> Bool +{-# NOINLINE g #-} +g = (==0) + +-- This test ensures that the CPR property of the anonymous lambda +-- Does not escape to f (which has arity 1) + +f = \x -> if g x then \y -> x + y + 1 + else \y -> x + y + 2 diff --git a/testsuite/tests/stranal/sigs/InfiniteCPR.stderr b/testsuite/tests/stranal/sigs/AnonLambda.stderr similarity index 54% copy from testsuite/tests/stranal/sigs/InfiniteCPR.stderr copy to testsuite/tests/stranal/sigs/AnonLambda.stderr index 70a3cdf..350b61c 100644 --- a/testsuite/tests/stranal/sigs/InfiniteCPR.stderr +++ b/testsuite/tests/stranal/sigs/AnonLambda.stderr @@ -1,5 +1,6 @@ ==================== Strictness signatures ==================== -InfiniteCPR.f: m(,m(tm(,),tm(,))) +AnonLambda.f: +AnonLambda.g: diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T index 448dc8e..7cc7618 100644 --- a/testsuite/tests/stranal/sigs/all.T +++ b/testsuite/tests/stranal/sigs/all.T @@ -19,3 +19,4 @@ test('CaseBinderCPR', normal, compile, ['']) test('InfiniteCPR', normal, compile, ['']) test('InfiniteCPRDepth0', normal, compile, ['']) test('InfiniteCPRDepth1', normal, compile, ['']) +test('AnonLambda', normal, compile, ['']) From git at git.haskell.org Tue Feb 4 18:27:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:42 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Note [Recursion and nested cpr] and test case (161d0ce) Message-ID: <20140204182743.D2ABD2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/161d0ceaf07bb7ebf979f1879c033baf0f41d04f/ghc >--------------------------------------------------------------- commit 161d0ceaf07bb7ebf979f1879c033baf0f41d04f Author: Joachim Breitner Date: Tue Jan 21 13:56:14 2014 +0000 Note [Recursion and nested cpr] and test case the reason why we remove the converging flag of LoopBreakers is actually non-obvious, and has little to do with the termination analysis per se. Document that with an extensive note and guard it with two test cases. >--------------------------------------------------------------- 161d0ceaf07bb7ebf979f1879c033baf0f41d04f compiler/stranal/DmdAnal.lhs | 40 ++++++++++++++++++++ testsuite/tests/stranal/should_run/Stream.hs | 13 +++++++ testsuite/tests/stranal/should_run/all.T | 1 + testsuite/tests/stranal/sigs/StreamSig.hs | 11 ++++++ .../{InfiniteCPRDepth0.stderr => StreamSig.stderr} | 2 +- testsuite/tests/stranal/sigs/all.T | 1 + 6 files changed, 67 insertions(+), 1 deletion(-) diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 7dec582..d25999e 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -1160,6 +1160,7 @@ extendAnalEnv top_lvl env var sig = env { ae_sigs = extendSigEnv top_lvl (ae_sigs env) var sig' } where sig' | isWeakLoopBreaker (idOccInfo var) = sigMayDiverge sig + -- Note [Recursion and nested CPR] | isUnLiftedType (idType var) = convergeSig sig | otherwise = sig @@ -1283,3 +1284,42 @@ of the Id, and start from "bottom". Nowadays the Id can have a current strictness, because interface files record strictness for nested bindings. To know when we are in the first iteration, we look at the ae_virgin field of the AnalEnv. + +Note [Recursion and nested cpr] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In extendAnalEnv, we remove possible definite convergence information from loop +breakers. + +This is *not* required to make termination analysis sound: It would be fine +without this, since we initialize the fixed point iteration with definite +divergence, and this is sufficient to make sure that, for example, a +tail-recursive function is not going to be considered terminating. + +But we need to do it to avoid the nested CPR w/w-transformation from going +horribly wrong. Consider this code (also in tests/stranal/sigs/StreamSig.hs): + + data Stream a = Stream a (Stream a) + forever :: a -> Stream a + forever x = Stream x (forever x) + +This should deserve a CPR information of + + tm(,tm(,)) + +(or deeper, as you wish) because clearly it terminates arbitrarily deep. But if +we gave it that signature, we would generate the following worker: + + $wforever x = case $wforever x of + (# ww1, ww2, ww3 #) -> (# x, ww1, Stream ww2 ww3 #) + +which will obviously diverge. By killing the convergence flag for loop breakers +we ensure that the CPR information is + + tm(,m(,)) + +and the worker is + + $wforever x = (# x, case $wforever x of (# a, b#) -> Stream a b #) + +which is fine (and will later be further simplified). diff --git a/testsuite/tests/stranal/should_run/Stream.hs b/testsuite/tests/stranal/should_run/Stream.hs new file mode 100644 index 0000000..5e3555c --- /dev/null +++ b/testsuite/tests/stranal/should_run/Stream.hs @@ -0,0 +1,13 @@ +-- Adapted from symalg/RealM.hs's treeFrom + +data Stream a = Stream a (Stream a) + +-- This must not get a CPR signature that allows for nested cpr, +-- as it would make the worker call itself before producing the +-- Stream constructor. + +forever :: a -> Stream a +forever x = Stream x (forever x) + +main :: IO () +main = forever () `seq` return () diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T index 0c43aac..e8e51de 100644 --- a/testsuite/tests/stranal/should_run/all.T +++ b/testsuite/tests/stranal/should_run/all.T @@ -7,3 +7,4 @@ test('strun003', normal, compile_and_run, ['']) test('strun004', normal, compile_and_run, ['']) test('T2756b', normal, compile_and_run, ['']) test('T7649', normal, compile_and_run, ['']) +test('Stream', extra_run_opts('+RTS -M1M -RTS'), compile_and_run, ['']) diff --git a/testsuite/tests/stranal/sigs/StreamSig.hs b/testsuite/tests/stranal/sigs/StreamSig.hs new file mode 100644 index 0000000..78269d8 --- /dev/null +++ b/testsuite/tests/stranal/sigs/StreamSig.hs @@ -0,0 +1,11 @@ +module StreamSig where +-- Adapted from symalg/RealM.hs's treeFrom + +data Stream a = Stream a (Stream a) + +-- This must not get a CPR signature that allows for nested cpr, +-- as it would make the worker call itself before producing the +-- Stream constructor. + +forever :: a -> Stream a +forever x = Stream x (forever x) diff --git a/testsuite/tests/stranal/sigs/InfiniteCPRDepth0.stderr b/testsuite/tests/stranal/sigs/StreamSig.stderr similarity index 63% copy from testsuite/tests/stranal/sigs/InfiniteCPRDepth0.stderr copy to testsuite/tests/stranal/sigs/StreamSig.stderr index 63ca4b6..9d3bf3a 100644 --- a/testsuite/tests/stranal/sigs/InfiniteCPRDepth0.stderr +++ b/testsuite/tests/stranal/sigs/StreamSig.stderr @@ -1,5 +1,5 @@ ==================== Strictness signatures ==================== -InfiniteCPR.f: +StreamSig.forever: tm(,m(,m(,))) diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T index 7cc7618..3cccc2b 100644 --- a/testsuite/tests/stranal/sigs/all.T +++ b/testsuite/tests/stranal/sigs/all.T @@ -20,3 +20,4 @@ test('InfiniteCPR', normal, compile, ['']) test('InfiniteCPRDepth0', normal, compile, ['']) test('InfiniteCPRDepth1', normal, compile, ['']) test('AnonLambda', normal, compile, ['']) +test('StreamSig', normal, compile, ['']) From git at git.haskell.org Tue Feb 4 18:27:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:45 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: More tracing in the demand analyser (dc388b4) Message-ID: <20140204182745.BE43A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/dc388b4feb5f3e5c1317210627dfad13315dbcb6/ghc >--------------------------------------------------------------- commit dc388b4feb5f3e5c1317210627dfad13315dbcb6 Author: Joachim Breitner Date: Tue Jan 21 13:59:51 2014 +0000 More tracing in the demand analyser >--------------------------------------------------------------- dc388b4feb5f3e5c1317210627dfad13315dbcb6 compiler/stranal/DmdAnal.lhs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index d25999e..9e9def0 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -188,8 +188,14 @@ dmdAnal env dmd (Lam var body) env' = extendSigsWithLam env var (body_ty, body') = dmdAnal env' body_dmd body (lam_ty, var') = annotateLamIdBndr env notArgOfDfun body_ty one_shot var + lam_ty' = postProcessUnsat defer_and_use lam_ty in - (postProcessUnsat defer_and_use lam_ty, Lam var' body') + -- pprTrace "dmdAnal:Lam" (vcat [ text "dmd" <+> ppr dmd + -- , text "body_ty" <+> ppr body_ty + -- , text "lam_ty" <+> ppr lam_ty + -- , text "lam_ty'" <+> ppr lam_ty' + -- ]) $ + (lam_ty', Lam var' body') dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, bndrs, _)]) -- Only one alternative with a product constructor, and a complex scrutinee @@ -337,6 +343,9 @@ dmdAnal env dmd (Let (Rec pairs) body) body_ty1 = deleteFVs body_ty (map fst pairs) body_ty2 = addLazyFVs body_ty1 lazy_fv in + -- pprTrace "dmdAnal:LetRec" (vcat [ text "body_ty" <+> ppr body_ty + -- , text "body_ty1" <+> ppr body_ty1 + -- , text "body_ty2" <+> ppr body_ty2]) $ body_ty2 `seq` (body_ty2, Let (Rec pairs') body') @@ -390,6 +399,9 @@ dmdAnalAlt env dmd (con,bndrs,rhs) io_hack_reqd = con == DataAlt unboxedPairDataCon && idType (head bndrs) `eqType` realWorldStatePrimTy in + -- pprTrace "dmdAnalAlt" (vcat [ text "rhs_ty" <+> ppr rhs_ty + -- , text "alt_ty" <+> ppr alt_ty + -- ]) $ (final_alt_ty, (con, bndrs', rhs')) \end{code} From git at git.haskell.org Tue Feb 4 18:27:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:50 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr: Work in progress: nested-cpr.tex (4f0fa84) Message-ID: <20140204182750.1969A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/nested-cpr Link : http://ghc.haskell.org/trac/ghc/changeset/4f0fa8456590b6ace7c72ae032e96aa86262ef8d/ghc >--------------------------------------------------------------- commit 4f0fa8456590b6ace7c72ae032e96aa86262ef8d Author: Joachim Breitner Date: Tue Jan 21 10:27:13 2014 +0000 Work in progress: nested-cpr.tex A formal description of the nested CPR property (but the usefulness of such is limited, it seems...) >--------------------------------------------------------------- 4f0fa8456590b6ace7c72ae032e96aa86262ef8d docs/nested-cpr/nested-cpr.tex | 276 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 276 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 4f0fa8456590b6ace7c72ae032e96aa86262ef8d From git at git.haskell.org Tue Feb 4 18:27:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 18:27:52 +0000 (UTC) Subject: [commit: ghc] wip/nested-cpr's head updated: Work in progress: nested-cpr.tex (4f0fa84) Message-ID: <20140204182752.76E052406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/nested-cpr' now includes: 98db754 Typos in comments 45d825b Add an expect-broken test for Trac #8566 9433f1d Tidy up Outputable.printDoc, and add printDoc_ 44dc0aa Eta expand data family instances before printing them 0f7381b Don't print roles for data instances 19e09df Add a test case for #5949 20b1a07 Add testcase for #4267 e4a4aba Fix #8675 0d90cbc Enable LLVM-based code generation for FreeBSD/amd64. c3b8b3a Allow "amd64" to be recognized as an x86_64 platform. bcc5c95 Re-enable DYNAMIC_GHC_PROGRAMS for FreeBSD. 1ad599e Fix #8451 fe3740b Make `#include "Rts.h"` C++-compatible again (re #8676) 2bb19fa Make worker-wrapper unbox data families 0c57887 Simplify doCorePass da66a8d Test case for #T7619 59cb44a Explain why TcAxiomInstCo carries [TcCoercion], and not [TcType] 4f8369b Implement pattern synonyms 22ddcff T7336 is expected to be broken because of a regression introduced by pattern synonym implementation 0a2d323 Fix #8677 (fallout from #8180) 3047c09 Fix some of the 32bit perf numbers. 721e188 Fix another failure. c9ed9aa Clean up the release notes. b61958d Also mention Pattern Synonyms (but with a FIXME) 4f9df5a More release note touchups. 21c2607 More tweaks. c5088e2 Fix more 32 bit performance fallout. d562382 Wibble. e81c630 Release notes: mention Mavericks and some bugs 2335060 And don't forget FreeBSD 7c48e76 Revert "Fix more 32 bit performance fallout." 13f1f86 Fix 32bit numbers (again) 801a3d2 One more fix (T3064) cabf0b4 Fix spelling of language pragma 26acb49 More demand analyser test cases 8d34ae3 Some polishing of the demand analyser. e01367f Some typos in comments 5281dd6 User documentation for pattern synonyms 9005f91 Squash some spelling issues d9ac5ea Tweak the example 7325040 Mention #3202 (no monomorphism restriction in GHCi) in release notes 8f8bd88 Fix the Win64 RTS linker & disable .ctors 2ac9e5b build.mk.sample: Don't disable dynamic linking for LLVM flavours 08f8efb Add short blurb about LLVM dynamic linking to release notes 4ade962 Abort when binutils ld is used with dynamic linking on ARM 874124d Fix ./validate failure due to unused result. db9baf0 Update some mingw32 perf numbers. f9652e2 Check for __thread in ./configure.ac 28b031c Refactor GCTDecl.h, and mitigate #7602 a bit 943f22a Document a Haddock/Mavericks bug. f7be53a Fix inplace dynamic linking on OS X (#8266) 25821cc Win64 linker: fix loading foreign imports (#2283) 9ed12c7 Remove a TODO FIXME in the release notes. 466d069 Bump version: 7.7 -> 7.9 24669fe Update Win32 submodule to pull in version bump 9f58cec Fix glitch in core-spec pdf 48326cf Fix iOS build (fallout from 28b031c506) 99484c9 Add a perf-cross build setting. 044f233 Bump win32 version number in release notes 1dd38a5 Remove Coercible documentation from compiler/prelude/primops.txt.pp fda9beb Fix some edge cases in 8f8bd88c (#7134) 5671ad6 Update to latest Cabal 1.18 branch tip 71a412c No need to remove testsuite/.git 50e4d40 Individual sdist-foo targets a2269bf Remove some references to deprecated -fglasgow-exts in user's guide ea584ab Loopification jump between stack and heap checks c6ce808 Remove unnecessary LANGUAGE pragma 99c3ed8 Simplify Control Flow Optimisations Cmm pass 78afa20 Nuke dead code d5fb670 Fix a popular typo in comments f028975 Remove redundant NoMonoLocalBinds pragma b5c45d8 Remove unused import 5f64b2c Add test-case for #8726 526cbc7 Document deprecations in Hoopl dba9bf6 Eliminate duplicate code in Cmm pipeline 2b33f6e Final fix to #7134 (and #8717 as well.) 889e02f Strictify the demand on unlifted arguments 24fa001 Add Converges to DmdResult 9343ce5c7 In deferType, return convRes = Converges NoCPR be33911 Mark the scrunitee of a multi-way-case as converging 6cfa6ea Literals are Converging 95ec011 Some primitive operations are converging b886ef8 Note [Termination information and arguments] 1817b65 Variables of unlifted types are always converging d4ed1c6 Initial work on Nested CPR 1810fe5 Limit the depth of the CPR information 685ef19 Add a flag -fnested-cpr-off to conveniently test the effect of nested CPR 34db1df Refactor trimCPRInfo away 2e6a0d8 Pass nested CPR information from scrunitee to body 3336339 CPR test case: Case binder CPR 220998d Actually create a nested CPR worker-wrapper ecb4cc4 Inline the datacon wrapper more aggressively 868496a Add a testcase with an infinite CPR property db71595 Mark FacState as not broken 92fa9f0 Do not attach CPR information to data constructor ids 7e92656 Remove dmdTransformDataConSig 2ee0836 Unify the code paths that create cpr signatures c636d36 Replace static CPR flags by dynamic -fcpr-depth b4c2be0 CPR testcase: AnonLambda 161d0ce Note [Recursion and nested cpr] and test case dc388b4 More tracing in the demand analyser 4f0fa84 Work in progress: nested-cpr.tex From git at git.haskell.org Tue Feb 4 22:53:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Feb 2014 22:53:38 +0000 (UTC) Subject: [commit: ghc] master: Tweak holes documentation (2f6d36f) Message-ID: <20140204225338.6E95A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f6d36f64730f044bb038e2d3da2b97ee571d763/ghc >--------------------------------------------------------------- commit 2f6d36f64730f044bb038e2d3da2b97ee571d763 Author: Krzysztof Gogolewski Date: Tue Feb 4 23:42:00 2014 +0100 Tweak holes documentation type holes -> typed holes, reorder, minor changes >--------------------------------------------------------------- 2f6d36f64730f044bb038e2d3da2b97ee571d763 docs/users_guide/glasgow_exts.xml | 28 +++++++++++++--------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 60f8acf..a3913cc 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -7978,17 +7978,7 @@ with but type inference becomes less predica , which is enabled by default. -The goal of the typed holes warning is not to change the type system, but to help with writing Haskell -code. Type holes can be used to obtain extra information from the type checker, which might otherwise be hard -to get. -Normally, the type checker is used to decide if a module is well typed or not. Using GHCi, -users can inspect the (inferred) type signatures of all top-level bindings. However, determining the -type of a single term is still hard. Yet while writing code, it could be helpful to know the type of -the term you're about to write. - - - -This extension allows special placeholders, written with a leading underscore (e.g. "_", +This option allows special placeholders, written with a leading underscore (e.g. "_", "_foo", "_bar"), to be used as an expression. During compilation these holes will generate an error message describing what type is expected there, information about the origin of any free type variables, and a list of local bindings @@ -7996,6 +7986,15 @@ that might help fill the hole with actual code. +The goal of the typed holes warning is not to change the type system, but to help with writing Haskell +code. Typed holes can be used to obtain extra information from the type checker, which might otherwise be hard +to get. +Normally, using GHCi, users can inspect the (inferred) type signatures of all top-level bindings. +However, this method is less convenient with terms which are not defined on top-level or +inside complex expressions. Holes allow to check the type of the term you're about to write. + + + Holes work together well with deferring type errors to runtime: with -fdefer-type-errors, the error from a hole is also deferred, effctively making the hole typecheck just like undefined, but with the added benefit that it will show its warning message @@ -8023,15 +8022,15 @@ hole.hs:2:7: -Multiple type holes can be used to find common type variables between expressions. For example: +Multiple typed holes can be used to find common type variables between expressions. For example: sum :: [Int] -> Int -sum xx = foldr _f _z xs +sum xs = foldr _f _z xs Shows: holes.hs:2:15: - Found hole `_f' with type: Int-> Int -> Int + Found hole `_f' with type: Int -> Int -> Int In the first argument of `foldr', namely `_' In the expression: foldr _a _b _c In an equation for `sum': sum x = foldr _a _b _c @@ -8070,7 +8069,6 @@ unbound.hs:1:13: In the second argument of `(:)', namely `_x' In the expression: _x : _x In an equation for `cons': cons = _x : _x -Failed, modules loaded: none. This ensures that an unbound identifier is never reported with a too polymorphic type, like forall a. a, when used multiple times for types that can not be unified. From git at git.haskell.org Wed Feb 5 03:28:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Feb 2014 03:28:24 +0000 (UTC) Subject: [commit: ghc] master: Fix #8698 by properly handling long section names and reenabling .ctors handling (40ce203) Message-ID: <20140205032824.826542406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/40ce20357fb6266471a53cec7de0a810a3070f36/ghc >--------------------------------------------------------------- commit 40ce20357fb6266471a53cec7de0a810a3070f36 Author: Edward Z. Yang Date: Tue Feb 4 15:59:55 2014 -0800 Fix #8698 by properly handling long section names and reenabling .ctors handling Our old function for searching for sections could only deal with section names that were eight bytes or shorter; this patch adds support for long section names. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 40ce20357fb6266471a53cec7de0a810a3070f36 rts/Linker.c | 59 +++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 36 insertions(+), 23 deletions(-) diff --git a/rts/Linker.c b/rts/Linker.c index b9c8fd0..8f57873 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -211,9 +211,7 @@ static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc ); static int ocVerifyImage_PEi386 ( ObjectCode* oc ); static int ocGetNames_PEi386 ( ObjectCode* oc ); static int ocResolve_PEi386 ( ObjectCode* oc ); -#if !defined(x86_64_HOST_ARCH) static int ocRunInit_PEi386 ( ObjectCode* oc ); -#endif static void *lookupSymbolInDLLs ( unsigned char *lbl ); static void zapTrailingAtSign ( unsigned char *sym ); static char *allocateImageAndTrampolines ( @@ -2875,10 +2873,7 @@ resolveObjs( void ) #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) -#if !defined(x86_64_HOST_ARCH) - /* It does not work on x86_64 yet. #8698. */ r = ocRunInit_PEi386 ( oc ); -#endif #elif defined(OBJFORMAT_MACHO) r = ocRunInit_MachO ( oc ); #else @@ -3608,9 +3603,10 @@ cstring_from_section_name (UChar* name, UChar* strtab) /* Just compares the short names (first 8 chars) */ static COFF_section * -findPEi386SectionCalled ( ObjectCode* oc, UChar* name ) +findPEi386SectionCalled ( ObjectCode* oc, UChar* name, UChar* strtab ) { int i; + rtsBool long_name = rtsFalse; COFF_header* hdr = (COFF_header*)(oc->image); COFF_section* sectab @@ -3618,6 +3614,14 @@ findPEi386SectionCalled ( ObjectCode* oc, UChar* name ) ((UChar*)(oc->image)) + sizeof_COFF_header + hdr->SizeOfOptionalHeader ); + // String is longer than 8 bytes, swap in the proper + // (NULL-terminated) version, and make a note that this + // is a long name. + if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) { + UInt32 strtab_offset = * (UInt32*)(name+4); + name = ((UChar*)strtab) + strtab_offset; + long_name = rtsTrue; + } for (i = 0; i < hdr->NumberOfSections; i++) { UChar* n1; UChar* n2; @@ -3626,10 +3630,28 @@ findPEi386SectionCalled ( ObjectCode* oc, UChar* name ) myindex ( sizeof_COFF_section, sectab, i ); n1 = (UChar*) &(section_i->Name); n2 = name; - if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] && - n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] && - n1[6]==n2[6] && n1[7]==n2[7]) - return section_i; + // Long section names are prefixed with a slash, see + // also cstring_from_section_name + if (n1[0] == '/' && long_name) { + // Long name check + // We don't really want to make an assumption that the string + // table indexes are the same, so we'll do a proper check. + int n1_strtab_offset = strtol((char*)n1+1,NULL,10); + n1 = (UChar*) (((char*)strtab) + n1_strtab_offset); + if (0==strcmp((const char*)n1, (const char*)n2)) { + return section_i; + } + } else if (n1[0] != '/' && !long_name) { + // Short name check + if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] && + n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] && + n1[6]==n2[6] && n1[7]==n2[7]) { + return section_i; + } + } else { + // guaranteed to mismatch, because we never attempt to link + // in an executable where the section name may be truncated + } } return NULL; @@ -4235,14 +4257,6 @@ ocResolve_PEi386 ( ObjectCode* oc ) continue; } -#if defined(x86_64_HOST_ARCH) - /* It does not work on x86_64 yet. #8698. */ - if (0 == strcmp(".ctors", (char*)secname)) { - stgFree(secname); - continue; - } -#endif - stgFree(secname); if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) { @@ -4304,9 +4318,11 @@ ocResolve_PEi386 ( ObjectCode* oc ) if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) { COFF_section* section_sym - = findPEi386SectionCalled ( oc, sym->Name ); + = findPEi386SectionCalled ( oc, sym->Name, strtab ); if (!section_sym) { - errorBelch("%" PATH_FMT ": can't find section `%s' in %s", oc->fileName, sym->Name, secname); + errorBelch("%" PATH_FMT ": can't find section named: ", oc->fileName); + printName(sym->Name, strtab); + errorBelch(" in %s", secname); return 0; } S = ((size_t)(oc->image)) @@ -4414,8 +4430,6 @@ ocResolve_PEi386 ( ObjectCode* oc ) return 1; } -/* It does not work on x86_64 yet. #8698. */ -#if !defined(x86_64_HOST_ARCH) static int ocRunInit_PEi386 ( ObjectCode *oc ) { @@ -4458,7 +4472,6 @@ ocRunInit_PEi386 ( ObjectCode *oc ) freeProgEnvv(envc, envv); return 1; } -#endif #endif /* defined(OBJFORMAT_PEi386) */ From git at git.haskell.org Wed Feb 5 22:17:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Feb 2014 22:17:12 +0000 (UTC) Subject: [commit: packages/base] master: Add release note about new `SomeAsyncException` (58e503f) Message-ID: <20140205221712.7B2AC2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/58e503f4268737b08454930548ba8b2059b8ea5b/base >--------------------------------------------------------------- commit 58e503f4268737b08454930548ba8b2059b8ea5b Author: Herbert Valerio Riedel Date: Wed Feb 5 23:16:10 2014 +0100 Add release note about new `SomeAsyncException` Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 58e503f4268737b08454930548ba8b2059b8ea5b changelog.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/changelog.md b/changelog.md index 8e1df37..ef9fa08 100644 --- a/changelog.md +++ b/changelog.md @@ -109,6 +109,10 @@ * Remove deprecated functions `unsafeInterleaveST`, `unsafeIOToST`, and `unsafeSTToIO` from `Control.Monad.ST`. + * Add a new superclass `SomeAsyncException` for all asynchronous exceptions + and makes the existing `AsyncException` and `Timeout` exception children + of `SomeAsyncException` in the hierarchy. + * Remove deprecated functions `blocked`, `unblock`, and `block` from `Control.Exception`. From git at git.haskell.org Wed Feb 5 22:17:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Feb 2014 22:17:42 +0000 (UTC) Subject: [commit: packages/base] ghc-7.8's head updated: Add release note about new `SomeAsyncException` (58e503f) Message-ID: <20140205221742.AD0D32406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base Branch 'ghc-7.8' now includes: b6a8e69 Fix a popular typo 58e503f Add release note about new `SomeAsyncException` From git at git.haskell.org Wed Feb 5 23:57:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Feb 2014 23:57:28 +0000 (UTC) Subject: [commit: packages/base] wip/T7994: Implement foldl with foldr (493a35d) Message-ID: <20140205235729.0AB122406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : wip/T7994 Link : http://ghc.haskell.org/trac/ghc/changeset/493a35d42773331c414a9dd01e2ce696d2fe954c/base >--------------------------------------------------------------- commit 493a35d42773331c414a9dd01e2ce696d2fe954c Author: Joachim Breitner Date: Tue Jan 28 14:31:05 2014 +0100 Implement foldl with foldr together with the call arity analysis and the following patch (about inlining maximum), we get nice benefits from fusing foldl and foldl' with good producers: Min -0.1% -74.5% -6.8% -8.3% -50.0% Max +0.2% 0.0% +38.5% +38.5% 0.0% Geometric Mean -0.0% -4.1% +7.7% +7.7% -0.8% Because this depends on a compiler optimisation, we have to watch out for cases where this is not an improvements, and whether they occur in the wild. >--------------------------------------------------------------- 493a35d42773331c414a9dd01e2ce696d2fe954c Data/List.hs | 31 ++++++------------------------- GHC/List.lhs | 10 ++++------ 2 files changed, 10 insertions(+), 31 deletions(-) diff --git a/Data/List.hs b/Data/List.hs index 130ceb2..987ae17 100644 --- a/Data/List.hs +++ b/Data/List.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-} +{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-} ----------------------------------------------------------------------------- -- | @@ -989,10 +989,8 @@ unfoldr f b = -- ----------------------------------------------------------------------------- -- | A strict version of 'foldl'. -foldl' :: (b -> a -> b) -> b -> [a] -> b -foldl' f z0 xs0 = lgo z0 xs0 - where lgo z [] = z - lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs +foldl' :: forall a b . (b -> a -> b) -> b -> [a] -> b +foldl' k z0 xs = foldr (\(v::a) (fn::b->b) (z::b) -> z `seq` fn (k z v)) (id :: b -> b) xs z0 -- | 'foldl1' is a variant of 'foldl' that has no starting value argument, -- and thus must be applied to non-empty lists. @@ -1008,32 +1006,15 @@ foldl1' _ [] = errorEmptyList "foldl1'" -- ----------------------------------------------------------------------------- -- List sum and product -{-# SPECIALISE sum :: [Int] -> Int #-} -{-# SPECIALISE sum :: [Integer] -> Integer #-} -{-# INLINABLE sum #-} -{-# SPECIALISE product :: [Int] -> Int #-} -{-# SPECIALISE product :: [Integer] -> Integer #-} -{-# INLINABLE product #-} --- We make 'sum' and 'product' inlinable so that we get specialisations --- at other types. See, for example, Trac #7507. - -- | The 'sum' function computes the sum of a finite list of numbers. sum :: (Num a) => [a] -> a -- | The 'product' function computes the product of a finite list of numbers. product :: (Num a) => [a] -> a -#ifdef USE_REPORT_PRELUDE + +{-# INLINE sum #-} sum = foldl (+) 0 +{-# INLINE product #-} product = foldl (*) 1 -#else -sum l = sum' l 0 - where - sum' [] a = a - sum' (x:xs) a = sum' xs (a+x) -product l = prod l 1 - where - prod [] a = a - prod (x:xs) a = prod xs (a*x) -#endif -- ----------------------------------------------------------------------------- -- Functions on strings diff --git a/GHC/List.lhs b/GHC/List.lhs index b7b78c7..b5b8e08 100644 --- a/GHC/List.lhs +++ b/GHC/List.lhs @@ -1,6 +1,6 @@ \begin{code} {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-} +{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- @@ -178,11 +178,9 @@ filterFB c p x r | p x = x `c` r -- can be inlined, and then (often) strictness-analysed, -- and hence the classic space leak on foldl (+) 0 xs -foldl :: (b -> a -> b) -> b -> [a] -> b -foldl f z0 xs0 = lgo z0 xs0 - where - lgo z [] = z - lgo z (x:xs) = lgo (f z x) xs +foldl :: forall a b. (b -> a -> b) -> b -> [a] -> b +{-# INLINE foldl #-} +foldl k z0 xs = foldr (\(v::a) (fn::b->b) (z::b) -> fn (k z v)) (id :: b -> b) xs z0 -- | 'scanl' is similar to 'foldl', but returns a list of successive -- reduced values from the left: From git at git.haskell.org Wed Feb 5 23:57:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Feb 2014 23:57:30 +0000 (UTC) Subject: [commit: packages/base] wip/T7994: Inline maximum/minium a bit more aggresively (5b68483) Message-ID: <20140205235730.904AF2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : wip/T7994 Link : http://ghc.haskell.org/trac/ghc/changeset/5b68483804d9c03e72ae707791b34e96bc55b8d3/base >--------------------------------------------------------------- commit 5b68483804d9c03e72ae707791b34e96bc55b8d3 Author: Joachim Breitner Date: Wed Jan 29 17:29:53 2014 +0100 Inline maximum/minium a bit more aggresively in order to allow fusion of the foldr in the foldl in the foldl' therein. >--------------------------------------------------------------- 5b68483804d9c03e72ae707791b34e96bc55b8d3 Data/List.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Data/List.hs b/Data/List.hs index 987ae17..06c752b 100644 --- a/Data/List.hs +++ b/Data/List.hs @@ -519,7 +519,7 @@ insertBy cmp x ys@(y:ys') -- It is a special case of 'Data.List.maximumBy', which allows the -- programmer to supply their own comparison function. maximum :: (Ord a) => [a] -> a -{-# NOINLINE [1] maximum #-} +{-# INLINE [1] maximum #-} maximum [] = errorEmptyList "maximum" maximum xs = foldl1 max xs @@ -540,7 +540,7 @@ strictMaximum xs = foldl1' max xs -- It is a special case of 'Data.List.minimumBy', which allows the -- programmer to supply their own comparison function. minimum :: (Ord a) => [a] -> a -{-# NOINLINE [1] minimum #-} +{-# INLINE [1] minimum #-} minimum [] = errorEmptyList "minimum" minimum xs = foldl1 min xs From git at git.haskell.org Thu Feb 6 07:52:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Feb 2014 07:52:48 +0000 (UTC) Subject: [commit: ghc] master: Mention that MR is off by default in GHCi in documentation (5bda0d0) Message-ID: <20140206075248.3D81E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5bda0d08d8fec86433917b65a93836d2372a5b5c/ghc >--------------------------------------------------------------- commit 5bda0d08d8fec86433917b65a93836d2372a5b5c Author: Krzysztof Gogolewski Date: Wed Feb 5 20:40:13 2014 +0100 Mention that MR is off by default in GHCi in documentation >--------------------------------------------------------------- 5bda0d08d8fec86433917b65a93836d2372a5b5c 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 a3913cc..1564f38 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -7862,7 +7862,8 @@ scope over the methods defined in the where part. For exampl 4.5.5 of the Haskell Report) can be completely switched off by -. +. Since GHC 7.8.1, it is +switched off by default in GHCi. From git at git.haskell.org Thu Feb 6 07:52:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Feb 2014 07:52:50 +0000 (UTC) Subject: [commit: ghc] master: Switch to relative URLs in .gitmodules (ad44e47) Message-ID: <20140206075250.D81072406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ad44e47542a822ac3e02cf514b5d2be52880fc95/ghc >--------------------------------------------------------------- commit ad44e47542a822ac3e02cf514b5d2be52880fc95 Author: Herbert Valerio Riedel Date: Thu Feb 6 08:42:27 2014 +0100 Switch to relative URLs in .gitmodules Previously, the `http://`-protocol part was hardcoded in the URLs, causing the initial clone process to fall back to `http://` even when the ghc.git repo was cloned via one of the other 3 supported transport protocols. This is slightly related to #8545, as it will make it possible to e.g. git clone --recursive git://git.haskell.org/ghc and clone ghc.git including all submodules in one go (i.e. w/o `sync-all`), and w/o falling back to a different (hardwired) Git transport protocol for the submodules. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- ad44e47542a822ac3e02cf514b5d2be52880fc95 .gitmodules | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/.gitmodules b/.gitmodules index f0fd280..d83bfd0 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,56 +1,56 @@ [submodule "libraries/binary"] path = libraries/binary - url = http://git.haskell.org/packages/binary.git + url = ../packages/binary.git ignore = untracked [submodule "libraries/bytestring"] path = libraries/bytestring - url = http://git.haskell.org/packages/bytestring.git + url = ../packages/bytestring.git ignore = untracked [submodule "libraries/Cabal"] path = libraries/Cabal - url = http://git.haskell.org/packages/Cabal.git + url = ../packages/Cabal.git ignore = untracked [submodule "libraries/containers"] path = libraries/containers - url = http://git.haskell.org/packages/containers.git + url = ../packages/containers.git ignore = untracked [submodule "libraries/haskeline"] path = libraries/haskeline - url = http://git.haskell.org/packages/haskeline.git + url = ../packages/haskeline.git ignore = untracked [submodule "libraries/pretty"] path = libraries/pretty - url = http://git.haskell.org/packages/pretty.git + url = ../packages/pretty.git ignore = untracked [submodule "libraries/terminfo"] path = libraries/terminfo - url = http://git.haskell.org/packages/terminfo.git + url = ../packages/terminfo.git ignore = untracked [submodule "libraries/transformers"] path = libraries/transformers - url = http://git.haskell.org/packages/transformers.git + url = ../packages/transformers.git ignore = untracked [submodule "libraries/xhtml"] path = libraries/xhtml - url = http://git.haskell.org/packages/xhtml.git + url = ../packages/xhtml.git ignore = untracked [submodule "libraries/Win32"] path = libraries/Win32 - url = http://git.haskell.org/packages/Win32.git + url = ../packages/Win32.git ignore = untracked [submodule "libraries/primitive"] path = libraries/primitive - url = http://git.haskell.org/packages/primitive.git + url = ../packages/primitive.git ignore = untracked [submodule "libraries/vector"] path = libraries/vector - url = http://git.haskell.org/packages/vector.git + url = ../packages/vector.git ignore = untracked [submodule "libraries/time"] path = libraries/time - url = http://git.haskell.org/packages/time.git + url = ../packages/time.git ignore = untracked [submodule "libraries/random"] path = libraries/random - url = http://git.haskell.org/packages/random.git + url = ../packages/random.git ignore = untracked From git at git.haskell.org Thu Feb 6 10:00:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Feb 2014 10:00:33 +0000 (UTC) Subject: [commit: ghc] master: Correctly clone submodules from github (b755c7b) Message-ID: <20140206100033.4AF8224077@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b755c7bd6af9f2bee47427b1eaa6c29c72b2b17a/ghc >--------------------------------------------------------------- commit b755c7bd6af9f2bee47427b1eaa6c29c72b2b17a Author: Joachim Breitner Date: Thu Feb 6 09:55:30 2014 +0000 Correctly clone submodules from github >--------------------------------------------------------------- b755c7bd6af9f2bee47427b1eaa6c29c72b2b17a sync-all | 48 ++++++++++++++++++++++++++++++++++-------------- 1 file changed, 34 insertions(+), 14 deletions(-) diff --git a/sync-all b/sync-all index f88ad2b..469dabe 100755 --- a/sync-all +++ b/sync-all @@ -123,7 +123,7 @@ sub git { }); } -sub readgit { +sub readgitline { my $dir = shift; my @args = @_; @@ -138,12 +138,26 @@ sub readgit { }); } +sub readgit { + my $dir = shift; + my @args = @_; + + &inDir($dir, sub { + open my $fh, '-|', 'git', @args + or die "Executing git @args failed: $!"; + my $ret; + $ret .= $_ while <$fh>; + close $fh; + return $ret; + }); +} + sub configure_repository { my $localpath = shift; &git($localpath, "config", "--local", "core.ignorecase", "true"); - my $autocrlf = &readgit($localpath, 'config', '--get', 'core.autocrlf'); + my $autocrlf = &readgitline($localpath, 'config', '--get', 'core.autocrlf'); if ($autocrlf eq "true") { &git($localpath, "config", "--local", "core.autocrlf", "false"); &git($localpath, "reset", "--hard"); @@ -161,17 +175,17 @@ sub getrepo { # Figure out where to get the other repositories from, # based on where this GHC repo came from. my $git_dir = $bare_flag ? "ghc.git" : "."; - my $branch = &readgit($git_dir, "rev-parse", "--abbrev-ref", "HEAD"); + my $branch = &readgitline($git_dir, "rev-parse", "--abbrev-ref", "HEAD"); die "Bad branch: $branch" unless $branch =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!; - my $remote = &readgit($git_dir, "config", "branch.$branch.remote"); + my $remote = &readgitline($git_dir, "config", "branch.$branch.remote"); if ($remote eq "") { # remotes are not mandatory for branches (e.g. not recorded by default for bare repos) $remote = "origin"; } die "Bad remote: $remote" unless $remote =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!; - $repo = &readgit($git_dir, "config", "remote.$remote.url"); + $repo = &readgitline($git_dir, "config", "remote.$remote.url"); } my $repo_base; @@ -402,7 +416,7 @@ sub gitall { } close($lsremote); - my $myhead = &readgit('.', 'rev-parse', '--verify', 'HEAD'); + my $myhead = &readgitline('.', 'rev-parse', '--verify', 'HEAD'); if (not defined($remote_heads{$myhead})) { die "Sub module $localpath needs to be pushed; see http://ghc.haskell.org/trac/ghc/wiki/Repositories/Upstream"; @@ -539,11 +553,11 @@ sub gitall { } print "$localpath"; print (' ' x (40 - length($localpath))); - my $branch = &readgit($localpath, "rev-parse", "--abbrev-ref", "HEAD"); + my $branch = &readgitline($localpath, "rev-parse", "--abbrev-ref", "HEAD"); die "Bad branch: $branch" unless $branch =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!; - my $us = &readgit(".", "ls-remote", $localpath, "refs/heads/$branch"); - my $them = &readgit(".", "ls-remote", $compareto, "refs/heads/$branch"); + my $us = &readgitline(".", "ls-remote", $localpath, "refs/heads/$branch"); + my $them = &readgitline(".", "ls-remote", $compareto, "refs/heads/$branch"); $us =~ s/[[:space:]].*//; $them =~ s/[[:space:]].*//; die "Bad commit of mine: $us" unless (length($us) eq 40); @@ -567,13 +581,19 @@ sub gitInitSubmodules { &git(".", "submodule", "init", @_); my ($repo_base, $checked_out_tree, $repo_local) = getrepo(); + + my $submodulespaths = &readgit(".", "config", "--get-regexp", "^submodule[.].*[.]url"); + # if we came from github, change the urls appropriately + while ($submodulespaths =~ m!^(submodule.libraries/[a-zA-Z0-9]+.url) git://github.com/ghc/packages/([a-zA-Z0-9]+).git$!gm) { + &git(".", "config", $1, "git://github.com/ghc/packages-$2"); + } + # if we came from a local repository, grab our submodules from their # checkouts over there, if they exist. if ($repo_local) { - my $gitConfig = &tryReadFile(".git/config"); - foreach $_ (split /^/, $gitConfig) { - if ($_ =~ /^\[submodule "(.*)"\]$/ and -e "$repo_base/$1/.git") { - &git(".", "config", "submodule.$1.url", "$repo_base/$1"); + while ($submodulespaths =~ m!^(submodule.(libraries/[a-zA-Z0-9]+).url) .*$!gm) { + if (-e "$repo_base/$2/.git") { + &git(".", "config", $1, "$repo_base/$2"); } } } @@ -1043,7 +1063,7 @@ EOF } message "== Checking for obsolete Git repo URL"; - my $repo_url = &readgit(".", 'config', '--get', 'remote.origin.url'); + my $repo_url = &readgitline(".", 'config', '--get', 'remote.origin.url'); if ($repo_url =~ /^http:\/\/darcs.haskell.org/) { print < Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ecc92abad017cf12d8eb83509d4d57ae14ad47f9/unix >--------------------------------------------------------------- commit ecc92abad017cf12d8eb83509d4d57ae14ad47f9 Author: Alain O'Dea Date: Wed Feb 5 21:24:28 2014 +0000 Handle EROFS/ETXTBSY as permission denied in `fileAccess` (re #8741) This extends `System.Posix.Files.`access` to map EROFS & ETXTBSY to mean permission denied just like EACCESS. Based on a patch by Alain O'Dea and comments by Duncan Coutts Authored-by: Alain O'Dea Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- ecc92abad017cf12d8eb83509d4d57ae14ad47f9 System/Posix/Files.hsc | 2 +- changelog.md | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/System/Posix/Files.hsc b/System/Posix/Files.hsc index 57f771e..704ef8a 100644 --- a/System/Posix/Files.hsc +++ b/System/Posix/Files.hsc @@ -151,7 +151,7 @@ access name flags = if (r == 0) then return True else do err <- getErrno - if (err == eACCES) + if (err == eACCES || err == eROFS || err == eTXTBSY) then return False else throwErrnoPath "fileAccess" name diff --git a/changelog.md b/changelog.md index 272c503..54e5a96 100644 --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,7 @@ +## 2.7.0.1 + + * Handle EROFS and ETXTBSY as (non-exceptional) permission denied in `fileAccess` + ## 2.7.0.0 *Nov 2013* * New `forkProcessWithUnmask` function in the style of `forkIOWithUnmask` From git at git.haskell.org Thu Feb 6 11:16:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Feb 2014 11:16:16 +0000 (UTC) Subject: [commit: packages/unix] master: Convert `changelog` to markdown format (4a08984) Message-ID: <20140206111616.F3ABE240AE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4a08984afe5390d91f10f9b1caf7365e6a93595b/unix >--------------------------------------------------------------- commit 4a08984afe5390d91f10f9b1caf7365e6a93595b Author: Herbert Valerio Riedel Date: Sun Feb 2 11:03:00 2014 +0100 Convert `changelog` to markdown format Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 4a08984afe5390d91f10f9b1caf7365e6a93595b changelog | 47 ----------------------------------------------- changelog.md | 44 ++++++++++++++++++++++++++++++++++++++++++++ unix.cabal | 4 ++-- 3 files changed, 46 insertions(+), 49 deletions(-) diff --git a/changelog b/changelog deleted file mode 100644 index ce72345..0000000 --- a/changelog +++ /dev/null @@ -1,47 +0,0 @@ --*-changelog-*- - -2.7.0.0 Nov 2013 - - * New `forkProcessWithUnmask` function in the style of `forkIOWithUnmask` - - * Change `forkProcess` to inherit the exception masking state of its caller - - * Add new `Bool` flag to `ProcessStatus(Terminated)` constructor - indicating whether a core dump occured - - * New functions in "System.Posix.Files(.ByteString)" for operating - on high resolution file timestamps: - - + `setFdTimesHiRes :: Fd -> POSIXTime -> POSIXTime -> IO ()` - + `setFileTimesHiRes :: FilePath -> POSIXTime -> POSIXTime -> IO ()` - + `setSymbolicLinkTimesHiRes :: FilePath -> POSIXTime -> POSIXTime -> IO ()` - + `touchFd :: Fd -> IO ()` - + `touchSymbolicLink :: FilePath -> IO ()` - - * Export `SignalInfo(..)` and `SignalSpecificInfo(..)` as well as - the two `Handler` constructors `CatchInfo` and `CatchInfoOnce` - from "System.Posix.Signals". - - * Don't export `seekDirStream` and `tellDirStream` if the - underlying `seekdir(3)`/`telldir(3)` system calls are not - available (as on Android). - - * Fix library detection of `shm*` on openSUSE (#8350) - - * Minor documentation fixes/updates - - * Update package to `cabal-version >= 1.10` format - -2.6.0.1 Jan 2013 - - * Bundled with GHC 7.6.2 - * Fix memory corruption issue in `putEnv` - * Use `pthread_kill(3)` instead of `raise(2)` on OS X too - -2.6.0.0 Sep 2012 - - * Bundled with GHC 7.6.1 - * New functions `mkdtemp` and `mkstemps` in "System.Posix.Temp" - * New functions `setEnvironment` and `cleanEnv` - * New functions `accessTimeHiRes`, `modificationTimeHiRes`, and - `statusChangeTimeHiRes` for accessing high resolution timestamps diff --git a/changelog.md b/changelog.md new file mode 100644 index 0000000..272c503 --- /dev/null +++ b/changelog.md @@ -0,0 +1,44 @@ +## 2.7.0.0 *Nov 2013* + + * New `forkProcessWithUnmask` function in the style of `forkIOWithUnmask` + + * Change `forkProcess` to inherit the exception masking state of its caller + + * Add new `Bool` flag to `ProcessStatus(Terminated)` constructor + indicating whether a core dump occured + + * New functions in `System.Posix.Files{,.ByteString}` for operating + on high resolution file timestamps: + + setFdTimesHiRes :: Fd -> POSIXTime -> POSIXTime -> IO () + setFileTimesHiRes :: FilePath -> POSIXTime -> POSIXTime -> IO () + setSymbolicLinkTimesHiRes :: FilePath -> POSIXTime -> POSIXTime -> IO () + touchFd :: Fd -> IO () + touchSymbolicLink :: FilePath -> IO () + + * Export `SignalInfo(..)` and `SignalSpecificInfo(..)` as well as + the two `Handler` constructors `CatchInfo` and `CatchInfoOnce` + from `System.Posix.Signals` + + * Don't export `seekDirStream` and `tellDirStream` if the underlying + `seekdir(3)`/`telldir(3)` system calls are not available (as on Android) + + * Fix library detection of `shm*` on openSUSE (#8350) + + * Minor documentation fixes/updates + + * Update package to `cabal-version >= 1.10` format + +## 2.6.0.1 *Jan 2013* + + * Bundled with GHC 7.6.2 + * Fix memory corruption issue in `putEnv` + * Use `pthread_kill(3)` instead of `raise(2)` on OS X too + +## 2.6.0.0 *Sep 2012* + + * Bundled with GHC 7.6.1 + * New functions `mkdtemp` and `mkstemps` in `System.Posix.Temp` + * New functions `setEnvironment` and `cleanEnv` + * New functions `accessTimeHiRes`, `modificationTimeHiRes`, and + `statusChangeTimeHiRes` for accessing high resolution timestamps diff --git a/unix.cabal b/unix.cabal index 3ad3c98..03d47b4 100644 --- a/unix.cabal +++ b/unix.cabal @@ -1,5 +1,5 @@ name: unix -version: 2.7.0.0 +version: 2.7.0.1 -- GHC 7.6.1 released with 2.6.0.0 license: BSD3 license-file: LICENSE @@ -19,7 +19,7 @@ description: The package is not supported under Windows (except under Cygwin). extra-source-files: - changelog + changelog.md config.guess config.sub configure From git at git.haskell.org Thu Feb 6 11:34:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Feb 2014 11:34:21 +0000 (UTC) Subject: [commit: packages/unix] master: M-x delete-trailing-whitespace & M-x untabify (86d7989) Message-ID: <20140206113421.911EC240BD@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/86d798975357c55fd0e5303c83f09844411c3837/unix >--------------------------------------------------------------- commit 86d798975357c55fd0e5303c83f09844411c3837 Author: Herbert Valerio Riedel Date: Thu Feb 6 12:33:55 2014 +0100 M-x delete-trailing-whitespace & M-x untabify Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 86d798975357c55fd0e5303c83f09844411c3837 System/Posix/Files.hsc | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/System/Posix/Files.hsc b/System/Posix/Files.hsc index 704ef8a..49c9bc1 100644 --- a/System/Posix/Files.hsc +++ b/System/Posix/Files.hsc @@ -138,22 +138,22 @@ fileExist name = withFilePath name $ \s -> do r <- c_access s (#const F_OK) if (r == 0) - then return True - else do err <- getErrno - if (err == eNOENT) - then return False - else throwErrnoPath "fileExist" name + then return True + else do err <- getErrno + if (err == eNOENT) + then return False + else throwErrnoPath "fileExist" name access :: FilePath -> CMode -> IO Bool access name flags = withFilePath name $ \s -> do r <- c_access s (fromIntegral flags) if (r == 0) - then return True - else do err <- getErrno - if (err == eACCES || err == eROFS || err == eTXTBSY) - then return False - else throwErrnoPath "fileAccess" name + then return True + else do err <- getErrno + if (err == eACCES || err == eROFS || err == eTXTBSY) + then return False + else throwErrnoPath "fileAccess" name -- | @getFileStatus path@ calls gets the @FileStatus@ information (user ID, @@ -269,7 +269,7 @@ readSymbolicLink file = allocaArray0 (#const PATH_MAX) $ \buf -> do withFilePath file $ \s -> do len <- throwErrnoPathIfMinus1 "readSymbolicLink" file $ - c_readlink s buf (#const PATH_MAX) + c_readlink s buf (#const PATH_MAX) peekFilePathLen (buf,fromIntegral len) foreign import ccall unsafe "readlink" @@ -316,7 +316,7 @@ setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO () setSymbolicLinkOwnerAndGroup name uid gid = do withFilePath name $ \s -> throwErrnoPathIfMinus1_ "setSymbolicLinkOwnerAndGroup" name - (c_lchown s uid gid) + (c_lchown s uid gid) foreign import ccall unsafe "lchown" c_lchown :: CString -> CUid -> CGid -> IO CInt From git at git.haskell.org Thu Feb 6 22:17:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Feb 2014 22:17:27 +0000 (UTC) Subject: [commit: ghc] master: Tweak documentation of monomorphism restriction (41cfc96) Message-ID: <20140206221727.612652406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/41cfc96b55a4a44953fc20aa72ef50789ba6ceab/ghc >--------------------------------------------------------------- commit 41cfc96b55a4a44953fc20aa72ef50789ba6ceab Author: Krzysztof Gogolewski Date: Thu Feb 6 23:15:50 2014 +0100 Tweak documentation of monomorphism restriction Suggested by Gabor Greif on ghc-devs >--------------------------------------------------------------- 41cfc96b55a4a44953fc20aa72ef50789ba6ceab 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 1564f38..fb3eb48 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -7862,8 +7862,8 @@ scope over the methods defined in the where part. For exampl 4.5.5 of the Haskell Report) can be completely switched off by -. Since GHC 7.8.1, it is -switched off by default in GHCi. +. Since GHC 7.8.1, the monomorphism +restriction is switched off by default in GHCi. From git at git.haskell.org Fri Feb 7 04:59:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Feb 2014 04:59:25 +0000 (UTC) Subject: [commit: ghc] master: Fix __thread detection (#8722) (298a25b) Message-ID: <20140207045925.4A5372406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/298a25bdfd02bb591fde2dd0590bd7af81a91b94/ghc >--------------------------------------------------------------- commit 298a25bdfd02bb591fde2dd0590bd7af81a91b94 Author: Peter Trommler Date: Thu Feb 6 22:57:34 2014 -0600 Fix __thread detection (#8722) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 298a25bdfd02bb591fde2dd0590bd7af81a91b94 configure.ac | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index 33d4e7c..e7fbc7f 100644 --- a/configure.ac +++ b/configure.ac @@ -867,11 +867,11 @@ AC_COMPILE_IFELSE( [ AC_LANG_SOURCE([[__thread int tester = 0;]]) ], [ AC_MSG_RESULT(yes) - AC_DEFINE([CC_SUPPORTS_TLS],[0],[Define to 1 if __thread is supported]) + AC_DEFINE([CC_SUPPORTS_TLS],[1],[Define to 1 if __thread is supported]) ], [ AC_MSG_RESULT(no) - AC_DEFINE([CC_SUPPORTS_TLS],[1],[Define to 1 if __thread is supported]) + AC_DEFINE([CC_SUPPORTS_TLS],[0],[Define to 1 if __thread is supported]) ]) From git at git.haskell.org Fri Feb 7 04:59:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Feb 2014 04:59:28 +0000 (UTC) Subject: [commit: ghc] master: Remove ios_HOST check for GCTDecl.h (b4eb630) Message-ID: <20140207045929.21B802406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b4eb630c7480bc56c673a463f274aec18e237e8c/ghc >--------------------------------------------------------------- commit b4eb630c7480bc56c673a463f274aec18e237e8c Author: Austin Seipp Date: Thu Feb 6 22:58:30 2014 -0600 Remove ios_HOST check for GCTDecl.h Following 298a25bdf and #8722 as Peter mentioned, this probably isn't needed anymore. Signed-off-by: Austin Seipp >--------------------------------------------------------------- b4eb630c7480bc56c673a463f274aec18e237e8c rts/sm/GCTDecl.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/sm/GCTDecl.h b/rts/sm/GCTDecl.h index 2489430..5602cb8 100644 --- a/rts/sm/GCTDecl.h +++ b/rts/sm/GCTDecl.h @@ -57,7 +57,7 @@ extern StgWord8 the_gc_thread[]; Also, the iOS Clang compiler doesn't support __thread either for some bizarre reason, so there's not much we can do about that... */ -#if (defined(llvm_CC_FLAVOR) && (CC_SUPPORTS_TLS == 0)) || defined(ios_HOST_OS) +#if defined(llvm_CC_FLAVOR) && (CC_SUPPORTS_TLS == 0) #define gct ((gc_thread *)(pthread_getspecific(gctKey))) #define SET_GCT(to) (pthread_setspecific(gctKey, to)) #define DECLARE_GCT ThreadLocalKey gctKey; From git at git.haskell.org Fri Feb 7 06:20:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Feb 2014 06:20:42 +0000 (UTC) Subject: [commit: ghc] master: Fix some Python brainos in testlib (except e is not valid form). (03200e8) Message-ID: <20140207062042.201D12406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/03200e8cebb0a20c0a0f608390c80f87f32a3f34/ghc >--------------------------------------------------------------- commit 03200e8cebb0a20c0a0f608390c80f87f32a3f34 Author: Edward Z. Yang Date: Thu Feb 6 22:20:27 2014 -0800 Fix some Python brainos in testlib (except e is not valid form). Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 03200e8cebb0a20c0a0f608390c80f87f32a3f34 testsuite/driver/testlib.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 8c8c60d..d8fbd02 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -675,7 +675,7 @@ def test_common_work (name, opts, func, args): result = runCmdFor(name, 'cd ' + getTestOpts().testdir + ' && ' + cleanCmd) if result != 0: framework_fail(name, 'cleaning', 'clean-command failed: ' + str(result)) - except e: + except: framework_fail(name, 'cleaning', 'clean-command exception') package_conf_cache_file_end_timestamp = get_package_cache_timestamp(); @@ -738,7 +738,7 @@ def do_test(name, way, func, args): result = runCmdFor(name, 'cd ' + getTestOpts().testdir + ' && ' + preCmd) if result != 0: framework_fail(name, way, 'pre-command failed: ' + str(result)) - except e: + except: framework_fail(name, way, 'pre-command exception') try: From git at git.haskell.org Fri Feb 7 14:26:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Feb 2014 14:26:14 +0000 (UTC) Subject: [commit: ghc] wip/T7994-calledArity: More CallArity to its own module (3d078a2) Message-ID: <20140207142614.A59F52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T7994-calledArity Link : http://ghc.haskell.org/trac/ghc/changeset/3d078a2d41afd0483c0d106f6a1423fa55521558/ghc >--------------------------------------------------------------- commit 3d078a2d41afd0483c0d106f6a1423fa55521558 Author: Joachim Breitner Date: Wed Jan 29 13:54:44 2014 +0000 More CallArity to its own module >--------------------------------------------------------------- 3d078a2d41afd0483c0d106f6a1423fa55521558 compiler/basicTypes/Id.lhs | 14 +- compiler/basicTypes/IdInfo.lhs | 10 +- compiler/coreSyn/CoreArity.lhs | 250 +--------------------------------- compiler/coreSyn/PprCore.lhs | 4 +- compiler/ghc.cabal.in | 1 + compiler/simplCore/CallArity.hs | 266 +++++++++++++++++++++++++++++++++++++ compiler/simplCore/SimplCore.lhs | 2 +- compiler/simplCore/SimplUtils.lhs | 2 +- 8 files changed, 284 insertions(+), 265 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3d078a2d41afd0483c0d106f6a1423fa55521558 From git at git.haskell.org Fri Feb 7 14:26:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Feb 2014 14:26:17 +0000 (UTC) Subject: [commit: ghc] wip/T7994-calledArity: Do not say “TailCall” in function names (8e9ca58) Message-ID: <20140207142617.1F4972406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T7994-calledArity Link : http://ghc.haskell.org/trac/ghc/changeset/8e9ca5875caccad227736e79d6dbf23b2af5badd/ghc >--------------------------------------------------------------- commit 8e9ca5875caccad227736e79d6dbf23b2af5badd Author: Joachim Breitner Date: Wed Jan 29 15:10:35 2014 +0000 Do not say ?TailCall? in function names >--------------------------------------------------------------- 8e9ca5875caccad227736e79d6dbf23b2af5badd compiler/simplCore/CallArity.hs | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index a953e5f..9a58a59 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -126,7 +126,7 @@ callArityAnal arity int (Let (NonRec v rhs) e) where (ae_rhs, rhs') = callArityAnal 0 int rhs (ae_body, e') = callArityAnal arity int e - ae_final = forgetTailCalls ae_rhs `lubEnv` ae_body + ae_final = forgetGoodCalls ae_rhs `lubEnv` ae_body -- Non-recursive let. Find out how the body calls the rhs, analise that, -- and combine the results, convervatively using both @@ -146,7 +146,7 @@ callArityAnal arity int (Let (NonRec v rhs) e) -- tail-call information from there | otherwise = let (ae_rhs, rhs') = callArityAnal 0 int rhs - final_ae = forgetTailCalls ae_rhs `lubEnv` ae_body' + final_ae = forgetGoodCalls ae_rhs `lubEnv` ae_body' v' = v `setIdCallArity` 0 in -- pprTrace "callArityAnal:LetNonRecNonTailCall" -- (vcat [ppr v, ppr arity, ppr final_ae ]) @@ -164,7 +164,7 @@ callArityAnal arity int (Let (Rec [(v,rhs)]) e) where (ae_rhs, rhs') = callArityAnal 0 int rhs (ae_body, e') = callArityAnal arity int e - ae_final = forgetTailCalls ae_rhs `lubEnv` ae_body + ae_final = forgetGoodCalls ae_rhs `lubEnv` ae_body -- Recursive let. Again, find out how the body calls the rhs, analise that, -- but then check if it is compatible with how rhs calls itself. If not, @@ -183,7 +183,7 @@ callArityAnal arity int (Let (Rec [(v,rhs)]) e) -- tail-call information from there. No need to iterate there. | otherwise = let (ae_rhs, rhs') = callArityAnal 0 int_body rhs - final_ae = forgetTailCalls ae_rhs `lubEnv` ae_body' + final_ae = forgetGoodCalls ae_rhs `lubEnv` ae_body' v' = v `setIdCallArity` 0 in -- pprTrace "callArityAnal:LetRecNonTailCall" -- (vcat [ppr v, ppr arity, ppr final_ae ]) @@ -200,7 +200,7 @@ callArityAnal arity int (Let (Rec binds) e) where (aes, binds') = unzip $ map go binds go (i,e) = let (ae,e') = callArityAnal 0 int e - in (forgetTailCalls ae, (i,e')) + in (forgetGoodCalls ae, (i,e')) (ae, e') = callArityAnal arity int e final_ae = foldl lubEnv ae aes @@ -248,19 +248,17 @@ callArityFix arity int v e new_arity = lookupWithDefaultVarEnv ae Nothing v -anyTailCalls :: VarEnv (Maybe Arity) -> Bool -anyTailCalls = foldVarEnv ((||) . isJust) False +anyGoodCalls :: VarEnv (Maybe Arity) -> Bool +anyGoodCalls = foldVarEnv ((||) . isJust) False -forgetTailCalls :: VarEnv (Maybe Arity) -> VarEnv (Maybe Arity) -forgetTailCalls = mapVarEnv (const Nothing) +forgetGoodCalls :: VarEnv (Maybe Arity) -> VarEnv (Maybe Arity) +forgetGoodCalls = mapVarEnv (const Nothing) useBetterOf :: CallArityEnv -> CallArityEnv -> CallArityEnv -useBetterOf ae1 ae2 | anyTailCalls ae1 = ae1 `lubEnv` forgetTailCalls ae2 -useBetterOf ae1 ae2 | otherwise = forgetTailCalls ae1 `lubEnv` ae2 +useBetterOf ae1 ae2 | anyGoodCalls ae1 = ae1 `lubEnv` forgetGoodCalls ae2 +useBetterOf ae1 ae2 | otherwise = forgetGoodCalls ae1 `lubEnv` ae2 -- Used when combining results from alternative cases; take the minimum lubEnv :: CallArityEnv -> CallArityEnv -> CallArityEnv lubEnv = plusVarEnv_C min - - From git at git.haskell.org Fri Feb 7 14:26:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Feb 2014 14:26:19 +0000 (UTC) Subject: [commit: ghc] wip/T7994-calledArity: Add the usual flags -fcall-arity and -dddump-call-arity (f878fc2) Message-ID: <20140207142619.9750F2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T7994-calledArity Link : http://ghc.haskell.org/trac/ghc/changeset/f878fc278f9a3a5e1407b0665eeeb285c07c2579/ghc >--------------------------------------------------------------- commit f878fc278f9a3a5e1407b0665eeeb285c07c2579 Author: Joachim Breitner Date: Wed Jan 29 15:09:09 2014 +0000 Add the usual flags -fcall-arity and -dddump-call-arity >--------------------------------------------------------------- f878fc278f9a3a5e1407b0665eeeb285c07c2579 compiler/main/DynFlags.hs | 5 +++++ compiler/simplCore/CallArity.hs | 2 +- compiler/simplCore/CoreMonad.lhs | 2 +- compiler/simplCore/SimplCore.lhs | 7 +++++-- 4 files changed, 12 insertions(+), 4 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 615fdbb..b8aa2908 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -240,6 +240,7 @@ data DumpFlag | Opt_D_dump_spec | Opt_D_dump_prep | Opt_D_dump_stg + | Opt_D_dump_call_arity | Opt_D_dump_stranal | Opt_D_dump_strsigs | Opt_D_dump_tc @@ -288,6 +289,7 @@ data GeneralFlag | Opt_PrintExplicitKinds -- optimisation opts + | Opt_CallArity | Opt_Strictness | Opt_LateDmdAnal | Opt_KillAbsence @@ -2322,6 +2324,7 @@ dynamic_flags = [ , Flag "ddump-spec" (setDumpFlag Opt_D_dump_spec) , Flag "ddump-prep" (setDumpFlag Opt_D_dump_prep) , Flag "ddump-stg" (setDumpFlag Opt_D_dump_stg) + , Flag "ddump-call-arity" (setDumpFlag Opt_D_dump_call_arity) , Flag "ddump-stranal" (setDumpFlag Opt_D_dump_stranal) , Flag "ddump-strsigs" (setDumpFlag Opt_D_dump_strsigs) , Flag "ddump-tc" (setDumpFlag Opt_D_dump_tc) @@ -2623,6 +2626,7 @@ fFlags = [ ( "error-spans", Opt_ErrorSpans, nop ), ( "print-explicit-foralls", Opt_PrintExplicitForalls, nop ), ( "print-explicit-kinds", Opt_PrintExplicitKinds, nop ), + ( "call-arity", Opt_CallArity, nop ), ( "strictness", Opt_Strictness, nop ), ( "late-dmd-anal", Opt_LateDmdAnal, nop ), ( "specialise", Opt_Specialise, nop ), @@ -2957,6 +2961,7 @@ optLevelFlags -- in PrelRules , ([1,2], Opt_DoEtaReduction) , ([1,2], Opt_CaseMerge) + , ([1,2], Opt_CallArity) , ([1,2], Opt_Strictness) , ([1,2], Opt_CSE) , ([1,2], Opt_FullLaziness) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index 9a58a59..754c1f1 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -112,7 +112,7 @@ callArityAnal 0 int (Lam v e) = (ae', Lam v e') where (ae, e') = callArityAnal 0 int e - ae' = forgetTailCalls ae + ae' = forgetGoodCalls ae -- We have a lambda that we are calling. decrease arity. callArityAnal arity int (Lam v e) = (ae, Lam v e') diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs index 7c91505..b2f697a 100644 --- a/compiler/simplCore/CoreMonad.lhs +++ b/compiler/simplCore/CoreMonad.lhs @@ -334,7 +334,7 @@ coreDumpFlag CoreDoFloatInwards = Just Opt_D_verbose_core2core coreDumpFlag (CoreDoFloatOutwards {}) = Just Opt_D_verbose_core2core coreDumpFlag CoreLiberateCase = Just Opt_D_verbose_core2core coreDumpFlag CoreDoStaticArgs = Just Opt_D_verbose_core2core -coreDumpFlag CoreDoCallArity = Just Opt_D_verbose_core2core +coreDumpFlag CoreDoCallArity = Just Opt_D_dump_call_arity coreDumpFlag CoreDoStrictness = Just Opt_D_dump_stranal coreDumpFlag CoreDoWorkerWrapper = Just Opt_D_dump_worker_wrapper coreDumpFlag CoreDoSpecialising = Just Opt_D_dump_spec diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 3183b11..436d1b6 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -115,6 +115,7 @@ getCoreToDo dflags phases = simplPhases dflags max_iter = maxSimplIterations dflags rule_check = ruleCheck dflags + call_arity = gopt Opt_CallArity dflags strictness = gopt Opt_Strictness dflags full_laziness = gopt Opt_FullLaziness dflags do_specialise = gopt Opt_Specialise dflags @@ -259,8 +260,10 @@ getCoreToDo dflags -- Don't stop now! simpl_phase 0 ["main"] (max max_iter 3), - CoreDoCallArity, - simpl_phase 0 ["post-call-arity"] (max max_iter 3), + runWhen call_arity $ CoreDoPasses + [ CoreDoCallArity + , simpl_phase 0 ["post-call-arity"] max_iter + ], runWhen strictness demand_analyser, From git at git.haskell.org Fri Feb 7 14:26:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Feb 2014 14:26:22 +0000 (UTC) Subject: [commit: ghc] wip/T7994-calledArity: Bugfix: Properly remove bound variables in returned CallArityEnv (6308577) Message-ID: <20140207142622.22DE52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T7994-calledArity Link : http://ghc.haskell.org/trac/ghc/changeset/6308577af634eb4e1ed95e14f20fbf9063140ee0/ghc >--------------------------------------------------------------- commit 6308577af634eb4e1ed95e14f20fbf9063140ee0 Author: Joachim Breitner Date: Wed Jan 29 16:00:37 2014 +0000 Bugfix: Properly remove bound variables in returned CallArityEnv >--------------------------------------------------------------- 6308577af634eb4e1ed95e14f20fbf9063140ee0 compiler/simplCore/CallArity.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index ca34a44..b43d1fe 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -309,7 +309,8 @@ callArityAnal arity int (Let (NonRec v rhs) e) where (ae_rhs, rhs') = callArityAnal 0 int rhs (ae_body, e') = callArityAnal arity int e - ae_final = forgetGoodCalls ae_rhs `lubEnv` ae_body + ae_body' = ae_body `delVarEnv` v + ae_final = forgetGoodCalls ae_rhs `lubEnv` ae_body' -- Non-recursive let. Find out how the body calls the rhs, analise that, -- and combine the results, convervatively using both @@ -347,7 +348,7 @@ callArityAnal arity int (Let (Rec [(v,rhs)]) e) where (ae_rhs, rhs') = callArityAnal 0 int rhs (ae_body, e') = callArityAnal arity int e - ae_final = forgetGoodCalls ae_rhs `lubEnv` ae_body + ae_final = (forgetGoodCalls ae_rhs `lubEnv` ae_body) `delVarEnv` v -- Recursive let. -- See Note [Recursion and fixpointing] @@ -356,7 +357,7 @@ callArityAnal arity int (Let (Rec [(v,rhs)]) e) -- tail-call for everything | Just n <- rhs_arity = let (ae_rhs, rhs_arity', rhs') = callArityFix n int_body v rhs - final_ae = ae_rhs `lubEnv` ae_body' + final_ae = (ae_rhs `lubEnv` ae_body) `delVarEnv` v v' = v `setIdCallArity` rhs_arity' in -- pprTrace "callArityAnal:LetRecTailCall" -- (vcat [ppr v, ppr arity, ppr n, ppr rhs_arity', ppr final_ae ]) @@ -365,7 +366,7 @@ callArityAnal arity int (Let (Rec [(v,rhs)]) e) -- tail-call information from there. No need to iterate there. | otherwise = let (ae_rhs, rhs') = callArityAnal 0 int_body rhs - final_ae = forgetGoodCalls ae_rhs `lubEnv` ae_body' + final_ae = (forgetGoodCalls ae_rhs `lubEnv` ae_body) `delVarEnv` v v' = v `setIdCallArity` 0 in -- pprTrace "callArityAnal:LetRecNonTailCall" -- (vcat [ppr v, ppr arity, ppr final_ae ]) @@ -373,7 +374,6 @@ callArityAnal arity int (Let (Rec [(v,rhs)]) e) where int_body = int `extendVarSet` v (ae_body, e') = callArityAnal arity int_body e - ae_body' = ae_body `delVarEnv` v rhs_arity = lookupWithDefaultVarEnv ae_body Nothing v -- Mutual recursion. Do nothing serious here, for now @@ -384,7 +384,7 @@ callArityAnal arity int (Let (Rec binds) e) go (i,e) = let (ae,e') = callArityAnal 0 int e in (forgetGoodCalls ae, (i,e')) (ae, e') = callArityAnal arity int e - final_ae = foldl lubEnv ae aes + final_ae = foldl lubEnv ae aes `delVarEnvList` map fst binds -- Application. Increase arity for the called expresion, nothing to know about -- the second From git at git.haskell.org Fri Feb 7 14:26:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Feb 2014 14:26:25 +0000 (UTC) Subject: [commit: ghc] wip/T7994-calledArity: Add huge note to CallArity (d1634e2) Message-ID: <20140207142625.ADCB32406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T7994-calledArity Link : http://ghc.haskell.org/trac/ghc/changeset/d1634e25ef875a4f64d2fc7a56aa3d27b230046b/ghc >--------------------------------------------------------------- commit d1634e25ef875a4f64d2fc7a56aa3d27b230046b Author: Joachim Breitner Date: Wed Jan 29 15:11:05 2014 +0000 Add huge note to CallArity (the module is now 50% notes). >--------------------------------------------------------------- d1634e25ef875a4f64d2fc7a56aa3d27b230046b compiler/simplCore/CallArity.hs | 237 ++++++++++++++++++++++++++++++++++----- 1 file changed, 211 insertions(+), 26 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d1634e25ef875a4f64d2fc7a56aa3d27b230046b From git at git.haskell.org Fri Feb 7 14:26:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Feb 2014 14:26:27 +0000 (UTC) Subject: [commit: ghc] wip/T7994-calledArity: Stop fixpointing when below exprArity (b2d9c93) Message-ID: <20140207142627.AD8F32406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T7994-calledArity Link : http://ghc.haskell.org/trac/ghc/changeset/b2d9c939a72c73c88aad9fb3495602aa2ac31ce3/ghc >--------------------------------------------------------------- commit b2d9c939a72c73c88aad9fb3495602aa2ac31ce3 Author: Joachim Breitner Date: Wed Jan 29 15:10:58 2014 +0000 Stop fixpointing when below exprArity >--------------------------------------------------------------- b2d9c939a72c73c88aad9fb3495602aa2ac31ce3 compiler/simplCore/CallArity.hs | 38 ++++++++++++++++++++++++-------------- 1 file changed, 24 insertions(+), 14 deletions(-) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index 754c1f1..fa57194 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -16,8 +16,7 @@ import Id import CoreArity import Control.Arrow ( second ) -import Data.Maybe ( fromMaybe, isJust ) - +import Data.Maybe ( isJust ) {- @@ -175,7 +174,7 @@ callArityAnal arity int (Let (Rec [(v,rhs)]) e) | Just n <- rhs_arity = let (ae_rhs, rhs_arity', rhs') = callArityFix n int_body v rhs final_ae = ae_rhs `lubEnv` ae_body' - v' = v `setIdCallArity` fromMaybe 0 rhs_arity' + v' = v `setIdCallArity` rhs_arity' in -- pprTrace "callArityAnal:LetRecTailCall" -- (vcat [ppr v, ppr arity, ppr n, ppr rhs_arity', ppr final_ae ]) (final_ae, Let (Rec [(v',rhs')]) e') @@ -228,24 +227,35 @@ callArityAnal arity int (Case scrut bndr ty alts) in (ae, (dc, bndrs, e')) alt_ae = foldl lubEnv emptyVarEnv alt_aes (scrut_ae, scrut') = callArityAnal 0 int scrut + -- See Note [Case and App: Which side to take?] final_ae = scrut_ae `useBetterOf` alt_ae -callArityFix :: Arity -> VarSet -> Id -> CoreExpr -> (CallArityEnv, Maybe Arity, CoreExpr) +callArityFix :: Arity -> VarSet -> Id -> CoreExpr -> (CallArityEnv, Arity, CoreExpr) callArityFix arity int v e - | Nothing <- new_arity - -- Not tail recusive, rerun with arity 0 and bail out - -- (Or not recursive at all, but that was hopefully handled by the simplifier before) - = let (ae, e') = callArityAnal 0 int e - in (forgetTailCalls ae `delVarEnv` v, Nothing, e') - | Just n <- new_arity, n < arity - -- Retry - = callArityFix n int v e + + | arity <= min_arity + -- The incoming arity is already lower than the exprArity, so we can + -- ignore the arity coming from the RHS + = (ae `delVarEnv` v, 0, e') + | otherwise - -- RHS calls itself with at least as many arguments as the body of the let - = (ae `delVarEnv` v, new_arity, e') + = case new_arity of + -- Not nicely recursive, rerun with arity 0 + -- (which will do at most one iteration, see above) + -- (Or not recursive at all, but that was hopefully handled by the simplifier before) + Nothing -> callArityFix 0 int v e + + Just n -> if n < arity + -- RHS puts a lower arity on itself, but still a nice call, so try with that + then callArityFix n int v e + + -- RHS calls itself with at least as many arguments as the body of + -- the let: Great! + else (ae `delVarEnv` v, n, e') where (ae, e') = callArityAnal arity int e new_arity = lookupWithDefaultVarEnv ae Nothing v + min_arity = exprArity e anyGoodCalls :: VarEnv (Maybe Arity) -> Bool From git at git.haskell.org Fri Feb 7 14:26:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Feb 2014 14:26:31 +0000 (UTC) Subject: [commit: ghc] wip/T7994-calledArity: Add a unit test for CallArity (89eca0c) Message-ID: <20140207142631.BBD372406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T7994-calledArity Link : http://ghc.haskell.org/trac/ghc/changeset/89eca0c5293fb98b5cf3852b8b6b132d7d021dca/ghc >--------------------------------------------------------------- commit 89eca0c5293fb98b5cf3852b8b6b132d7d021dca Author: Joachim Breitner Date: Wed Jan 29 12:19:35 2014 +0000 Add a unit test for CallArity I put it all in one file because starting the GHC API is quite slow. >--------------------------------------------------------------- 89eca0c5293fb98b5cf3852b8b6b132d7d021dca compiler/simplCore/CallArity.hs | 1 + testsuite/tests/callarity/CallArity1.hs | 160 ++++++++++++++++++++ testsuite/tests/callarity/CallArity1.stderr | 31 ++++ .../tests/{annotations => callarity}/Makefile | 0 testsuite/tests/callarity/all.T | 8 + 5 files changed, 200 insertions(+) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index b43d1fe..2527db0 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -4,6 +4,7 @@ module CallArity ( callArityAnalProgram + , callArityRHS -- for testing ) where import VarSet diff --git a/testsuite/tests/callarity/CallArity1.hs b/testsuite/tests/callarity/CallArity1.hs new file mode 100644 index 0000000..ffc72f3 --- /dev/null +++ b/testsuite/tests/callarity/CallArity1.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE TupleSections #-} +import CoreSyn +import CoreUtils +import Id +import Type +import MkCore +import CoreArity (callArityRHS) +import MkId +import SysTools +import DynFlags +import ErrUtils +import Outputable +import TysWiredIn +import Literal +import GHC +import Control.Monad +import Control.Monad.IO.Class +import System.Environment( getArgs ) +import VarSet +import PprCore +import Unique +import CoreLint +import FastString + +-- Build IDs. use mkTemplateLocal, more predictable than proper uniques +go, go2, x, d, n, y, z, scrut :: Id +[go, go2, x,d, n, y, z, scrut, f] = mkTestIds + (words "go go2 x d n y z scrut f") + [ mkFunTys [intTy, intTy] intTy + , mkFunTys [intTy, intTy] intTy + , intTy + , mkFunTys [intTy] intTy + , mkFunTys [intTy] intTy + , intTy + , intTy + , boolTy + , mkFunTys [intTy, intTy] intTy -- protoypical external function + ] + +exprs :: [(String, CoreExpr)] +exprs = + [ ("go2",) $ + mkRFun go [x] + (mkLet d (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y) + ) $ mkLams [z] $ Var d `mkVarApps` [x]) $ + go `mkLApps` [0, 0] + , ("nested_go2",) $ + mkRFun go [x] + (mkLet n (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y)) $ + mkACase (Var n) $ + mkFun go2 [y] + (mkLet d + (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y) ) $ + mkLams [z] $ Var d `mkVarApps` [x] )$ + Var go2 `mkApps` [mkLit 1] ) $ + go `mkLApps` [0, 0] + , ("d0",) $ + mkRFun go [x] + (mkLet d (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y) + ) $ mkLams [z] $ Var f `mkApps` [ Var d `mkVarApps` [x], Var d `mkVarApps` [x] ]) $ + go `mkLApps` [0, 0] + , ("go2 (in case crut)",) $ + mkRFun go [x] + (mkLet d (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y) + ) $ mkLams [z] $ Var d `mkVarApps` [x]) $ + Case (go `mkLApps` [0, 0]) z intTy + [(DEFAULT, [], Var f `mkVarApps` [z,z])] + , ("go2 (in function call)",) $ + mkRFun go [x] + (mkLet d (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y) + ) $ mkLams [z] $ Var d `mkVarApps` [x]) $ + f `mkLApps` [0] `mkApps` [go `mkLApps` [0, 0]] + , ("go2 (using surrounding interesting let; 'go 2' would be good!)",) $ + mkLet n (f `mkLApps` [0]) $ + mkRFun go [x] + (mkLet d (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y) + ) $ mkLams [z] $ Var d `mkVarApps` [x]) $ + Var f `mkApps` [n `mkLApps` [0], go `mkLApps` [0, 0]] + , ("go2 (using surrounding boring let)",) $ + mkLet z (mkLit 0) $ + mkRFun go [x] + (mkLet d (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y) + ) $ mkLams [z] $ Var d `mkVarApps` [x]) $ + Var f `mkApps` [Var z, go `mkLApps` [0, 0]] + , ("two recursions (both arity 1 would be good!)",) $ + mkRLet n (mkACase (mkLams [y] $ mkLit 0) (Var n)) $ + mkRLet d (mkACase (mkLams [y] $ mkLit 0) (Var d)) $ + Var n `mkApps` [d `mkLApps` [0]] + , ("two recursions (semantically like the previous case)",) $ + mkRLet n (mkACase (mkLams [y] $ mkLit 0) (Var n)) $ + mkRLet d (mkACase (mkLams [y] $ n `mkLApps` [0]) (Var d)) $ + d `mkLApps` [0] + ] + +main = do + [libdir] <- getArgs + runGhc (Just libdir) $ do + getSessionDynFlags >>= setSessionDynFlags . flip gopt_set Opt_SuppressUniques + dflags <- getSessionDynFlags + liftIO $ forM_ exprs $ \(n,e) -> do + case lintExpr [f,scrut] e of + Just msg -> putMsg dflags (msg $$ text "in" <+> text n) + Nothing -> return () + putMsg dflags (text n <> char ':') + -- liftIO $ putMsg dflags (ppr e) + let e' = callArityRHS e + let bndrs = varSetElems (allBoundIds e') + -- liftIO $ putMsg dflags (ppr e') + forM_ bndrs $ \v -> putMsg dflags $ nest 4 $ ppr v <+> ppr (idCalledArity v) + +-- Utilities +mkLApps :: Id -> [Integer] -> CoreExpr +mkLApps v = mkApps (Var v) . map mkLit + +mkACase = mkIfThenElse (Var scrut) + +mkTestId :: Int -> String -> Type -> Id +mkTestId i s ty = mkSysLocal (mkFastString s) (mkBuiltinUnique i) ty + +mkTestIds :: [String] -> [Type] -> [Id] +mkTestIds ns tys = zipWith3 mkTestId [0..] ns tys + +mkLet :: Id -> CoreExpr -> CoreExpr -> CoreExpr +mkLet v rhs body = Let (NonRec v rhs) body + +mkRLet :: Id -> CoreExpr -> CoreExpr -> CoreExpr +mkRLet v rhs body = Let (Rec [(v, rhs)]) body + +mkFun :: Id -> [Id] -> CoreExpr -> CoreExpr -> CoreExpr +mkFun v xs rhs body = mkLet v (mkLams xs rhs) body + +mkRFun :: Id -> [Id] -> CoreExpr -> CoreExpr -> CoreExpr +mkRFun v xs rhs body = mkRLet v (mkLams xs rhs) body + +mkLit :: Integer -> CoreExpr +mkLit i = Lit (mkLitInteger i intTy) + +-- Collects all let-bound IDs +allBoundIds :: CoreExpr -> VarSet +allBoundIds (Let (NonRec v rhs) body) = allBoundIds rhs `unionVarSet` allBoundIds body `extendVarSet` v +allBoundIds (Let (Rec binds) body) = + allBoundIds body `unionVarSet` unionVarSets + [ allBoundIds rhs `extendVarSet` v | (v, rhs) <- binds ] +allBoundIds (App e1 e2) = allBoundIds e1 `unionVarSet` allBoundIds e2 +allBoundIds (Case scrut _ _ alts) = + allBoundIds scrut `unionVarSet` unionVarSets + [ allBoundIds e | (_, _ , e) <- alts ] +allBoundIds (Lam _ e) = allBoundIds e +allBoundIds (Tick _ e) = allBoundIds e +allBoundIds (Cast e _) = allBoundIds e +allBoundIds _ = emptyVarSet + diff --git a/testsuite/tests/callarity/CallArity1.stderr b/testsuite/tests/callarity/CallArity1.stderr new file mode 100644 index 0000000..ba8322b --- /dev/null +++ b/testsuite/tests/callarity/CallArity1.stderr @@ -0,0 +1,31 @@ +go2: + go 2 + d 1 +nested_go2: + go 2 + go2 2 + d 1 + n 1 +d0: + go 0 + d 0 +go2 (in case crut): + go 2 + d 1 +go2 (in function call): + go 2 + d 1 +go2 (using surrounding interesting let; 'go 2' would be good!): + go 0 + d 0 + n 1 +go2 (using surrounding boring let): + go 2 + d 1 + z 0 +two recursions (both arity 1 would be good!): + d 0 + n 1 +two recursions (semantically like the previous case): + d 1 + n 1 diff --git a/testsuite/tests/annotations/Makefile b/testsuite/tests/callarity/Makefile similarity index 100% copy from testsuite/tests/annotations/Makefile copy to testsuite/tests/callarity/Makefile diff --git a/testsuite/tests/callarity/all.T b/testsuite/tests/callarity/all.T new file mode 100644 index 0000000..e39c1d7 --- /dev/null +++ b/testsuite/tests/callarity/all.T @@ -0,0 +1,8 @@ +def f( name, opts ): + opts.only_ways = ['normal'] + +setTestOpts(f) +setTestOpts(extra_hc_opts('-package ghc')) +setTestOpts(extra_run_opts('"' + config.libdir + '"')) + +test('CallArity1', normal, compile_and_run, ['']) From git at git.haskell.org Fri Feb 7 17:59:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Feb 2014 17:59:30 +0000 (UTC) Subject: [commit: ghc] master: Add test case for #8743 (c3ff5f2) Message-ID: <20140207175930.784102406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c3ff5f29c80680a09c7779aee2535fa64b880cd9/ghc >--------------------------------------------------------------- commit c3ff5f29c80680a09c7779aee2535fa64b880cd9 Author: Joachim Breitner Date: Fri Feb 7 17:56:18 2014 +0000 Add test case for #8743 which only occurs when the instance being compiled is also present from a .hs-boot file. >--------------------------------------------------------------- c3ff5f29c80680a09c7779aee2535fa64b880cd9 testsuite/tests/stranal/should_compile/T8743.hs | 11 +++++++++++ testsuite/tests/stranal/should_compile/T8743.hs-boot | 3 +++ testsuite/tests/stranal/should_compile/all.T | 2 ++ 3 files changed, 16 insertions(+) diff --git a/testsuite/tests/stranal/should_compile/T8743.hs b/testsuite/tests/stranal/should_compile/T8743.hs new file mode 100644 index 0000000..a69e522 --- /dev/null +++ b/testsuite/tests/stranal/should_compile/T8743.hs @@ -0,0 +1,11 @@ +module T8743 where + +-- Without the following import, it does not fail +import {-# SOURCE #-} T8743 () + +-- [()] required, () does not work. +class ToRow a where toRow :: a -> [()] + +instance ToRow (Maybe a) where + toRow Nothing = [()] + toRow (Just _) = [()] diff --git a/testsuite/tests/stranal/should_compile/T8743.hs-boot b/testsuite/tests/stranal/should_compile/T8743.hs-boot new file mode 100644 index 0000000..7f22b24 --- /dev/null +++ b/testsuite/tests/stranal/should_compile/T8743.hs-boot @@ -0,0 +1,3 @@ +module T8743 where +class ToRow a +instance ToRow (Maybe a) diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index 7ee45ad..2c53ebb 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -18,3 +18,5 @@ test('newtype', req_profiling, compile, ['-prof -auto-all']) test('T1988', normal, compile, ['']) test('T8467', normal, compile, ['']) test('T8037', normal, compile, ['']) +test('T8743', [ expect_broken(8743), extra_clean(['T8743.o-boot', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0']) + From git at git.haskell.org Fri Feb 7 17:59:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Feb 2014 17:59:32 +0000 (UTC) Subject: [commit: ghc] master: In deepSplitCprType_maybe, be more forgiving (312686c) Message-ID: <20140207175933.D5C532406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/312686c172eefb74237c8a61e2cca1b2af7459c1/ghc >--------------------------------------------------------------- commit 312686c172eefb74237c8a61e2cca1b2af7459c1 Author: Joachim Breitner Date: Fri Feb 7 17:59:29 2014 +0000 In deepSplitCprType_maybe, be more forgiving the ConTag may be out of range (e.g. if the type constructor is imported via SOURCE and we don't know any of its data constructors); just return Nothing without complaining in that case. This fixes #8743. >--------------------------------------------------------------- 312686c172eefb74237c8a61e2cca1b2af7459c1 compiler/stranal/WwLib.lhs | 4 +++- testsuite/tests/stranal/should_compile/all.T | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs index 57937d6..f88c9ad 100644 --- a/compiler/stranal/WwLib.lhs +++ b/compiler/stranal/WwLib.lhs @@ -529,7 +529,9 @@ deepSplitCprType_maybe fam_envs con_tag ty , Just (tc, tc_args) <- splitTyConApp_maybe ty1 , isDataTyCon tc , let cons = tyConDataCons tc - con = ASSERT( cons `lengthAtLeast` con_tag ) cons !! (con_tag - fIRST_TAG) + , cons `lengthAtLeast` con_tag -- This might not be true if we import the + -- type constructor via a .hs-bool file (#8743) + , let con = cons !! (con_tag - fIRST_TAG) = Just (con, tc_args, dataConInstArgTys con tc_args, co) deepSplitCprType_maybe _ _ _ = Nothing \end{code} diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index 2c53ebb..0d10a99 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -18,5 +18,5 @@ test('newtype', req_profiling, compile, ['-prof -auto-all']) test('T1988', normal, compile, ['']) test('T8467', normal, compile, ['']) test('T8037', normal, compile, ['']) -test('T8743', [ expect_broken(8743), extra_clean(['T8743.o-boot', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0']) +test('T8743', [ extra_clean(['T8743.o-boot', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0']) From ezyang at mit.edu Sat Feb 8 01:04:32 2014 From: ezyang at mit.edu (Edward Z. Yang) Date: Fri, 07 Feb 2014 17:04:32 -0800 Subject: [commit: packages/integer-gmp] master: Allocate initial 1-limb mpz_t on the Stack and introduce MPZ# type (7bdcadd) In-Reply-To: <20140113132526.74D922406B@ghc.haskell.org> References: <20140113132526.74D922406B@ghc.haskell.org> Message-ID: <1391821369-sup-769@sabre> Hey Herbert, Is there a way to get rid of the stg_INTLIKE_closure hack? I ask because this hack will stop working if the HEAP_ALLOCED removal patch hits mainline, because the way you need to access static closures will change. Cheers, Edward Excerpts from git's message of 2014-01-13 05:25:26 -0800: > Repository : ssh://git at git.haskell.org/integer-gmp > > On branch : master > Link : http://ghc.haskell.org/trac/ghc/changeset/7bdcadda7e884edffb1427f0685493f3a2e5c5fa/integer-gmp > > >--------------------------------------------------------------- > > commit 7bdcadda7e884edffb1427f0685493f3a2e5c5fa > Author: Herbert Valerio Riedel > Date: Thu Jan 9 00:19:31 2014 +0100 > > Allocate initial 1-limb mpz_t on the Stack and introduce MPZ# type > > We now allocate a 1-limb mpz_t on the stack instead of doing a more > expensive heap-allocation (especially if the heap-allocated copy becomes > garbage right away); this addresses #8647. > > In order to delay heap allocations of 1-limb `ByteArray#`s instead of > the previous `(# Int#, ByteArray# #)` pair, a 3-tuple > `(# Int#, ByteArray#, Word# #)` is returned now. This tuple is given the > type-synonym `MPZ#`. > > This 3-tuple representation uses either the 1st and the 2nd element, or > the 1st and the 3rd element to represent the limb(s) (NB: undefined > `ByteArray#` elements must not be accessed as they don't point to a > proper `ByteArray#`, see also `DUMMY_BYTE_ARR`); more specifically, the > following encoding is used (where `?` means undefined/unused): > > - (# 0#, ?, 0## #) -> value = 0 > - (# 1#, ?, w #) -> value = w > - (# -1#, ?, w #) -> value = -w > - (# s#, d, 0## #) -> value = J# s d > > The `mpzToInteger` helper takes care of converting `MPZ#` into an > `Integer`, and allocating a 1-limb `ByteArray#` in case the > value (`w`/`-w`) doesn't fit the `S# Int#` representation). > > The following nofib benchmarks benefit from this optimization: > > Program Size Allocs Runtime Elapsed TotalMem > ------------------------------------------------------------------ > bernouilli +0.2% -5.2% 0.12 0.12 +0.0% > gamteb +0.2% -1.7% 0.03 0.03 +0.0% > kahan +0.3% -13.2% 0.17 0.17 +0.0% > mandel +0.2% -24.6% 0.04 0.04 +0.0% > power +0.2% -2.6% -2.0% -2.0% -8.3% > primetest +0.1% -17.3% 0.06 0.06 +0.0% > rsa +0.2% -18.5% 0.02 0.02 +0.0% > scs +0.1% -2.9% -0.1% -0.1% +0.0% > sphere +0.3% -0.8% 0.03 0.03 +0.0% > symalg +0.2% -3.1% 0.01 0.01 +0.0% > ------------------------------------------------------------------ > Min +0.1% -24.6% -4.6% -4.6% -8.3% > Max +0.3% +0.0% +5.9% +5.9% +4.5% > Geometric Mean +0.2% -1.0% +0.2% +0.2% -0.0% > > Signed-off-by: Herbert Valerio Riedel > > >--------------------------------------------------------------- > > 7bdcadda7e884edffb1427f0685493f3a2e5c5fa > GHC/Integer/GMP/Prim.hs | 105 +++++++++++++++------- > GHC/Integer/Type.lhs | 164 ++++++++++++++++------------------ > cbits/gmp-wrappers.cmm | 224 +++++++++++++++++++++++++++++++++-------------- > 3 files changed, 306 insertions(+), 187 deletions(-) > > Diff suppressed because of size. To see it, use: > > git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7bdcadda7e884edffb1427f0685493f3a2e5c5fa From git at git.haskell.org Sat Feb 8 19:11:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Feb 2014 19:11:06 +0000 (UTC) Subject: [commit: ghc] master: Fix #8706, documenting that type operators are not promoted. (218dead) Message-ID: <20140208191106.EDC672406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/218dead0d85a136b5d5648e4d6c4c9cc9467eb45/ghc >--------------------------------------------------------------- commit 218dead0d85a136b5d5648e4d6c4c9cc9467eb45 Author: Richard Eisenberg Date: Fri Feb 7 17:24:07 2014 -0500 Fix #8706, documenting that type operators are not promoted. >--------------------------------------------------------------- 218dead0d85a136b5d5648e4d6c4c9cc9467eb45 docs/users_guide/glasgow_exts.xml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index fb3eb48..9910d2b 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -6652,6 +6652,18 @@ See also Trac #7347 + +Promoting type operators + +Type operators are not promoted to the kind level. Why not? Because +* is a kind, parsed the way identifiers are. Thus, if a programmer +tried to write Either * Bool, would it be Either +applied to * and Bool? Or would it be +* applied to Either and Bool. +To avoid this quagmire, we simply forbid promoting type operators to the kind level. + + + From git at git.haskell.org Sat Feb 8 23:26:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Feb 2014 23:26:06 +0000 (UTC) Subject: [commit: ghc] master: T8256 needs vector (4f6a0f4) Message-ID: <20140208232606.F24CC2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4f6a0f486fc2d015bc3605f505c0d6c58f70a39a/ghc >--------------------------------------------------------------- commit 4f6a0f486fc2d015bc3605f505c0d6c58f70a39a Author: Joachim Breitner Date: Sat Feb 8 23:25:52 2014 +0000 T8256 needs vector >--------------------------------------------------------------- 4f6a0f486fc2d015bc3605f505c0d6c58f70a39a testsuite/tests/codeGen/should_run/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 768d320..b1a9fd4 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -114,5 +114,5 @@ test('T7361', normal, compile_and_run, ['']) test('T7600', normal, compile_and_run, ['']) test('T8103', only_ways(['normal']), compile_and_run, ['']) test('T7953', reqlib('random'), compile_and_run, ['']) -test('T8256',normal, compile_and_run, ['']) +test('T8256', reqlib('vector'), compile_and_run, ['']) test('T6084',normal, compile_and_run, ['-O2']) From git at git.haskell.org Sun Feb 9 03:11:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Feb 2014 03:11:50 +0000 (UTC) Subject: [commit: ghc] master: Fix #8631. (674c969) Message-ID: <20140209031151.CA0062406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/674c969c240632da70ed2928fa30c20a9a52e5dc/ghc >--------------------------------------------------------------- commit 674c969c240632da70ed2928fa30c20a9a52e5dc Author: Richard Eisenberg Date: Sat Feb 8 22:09:12 2014 -0500 Fix #8631. This patch allows turning on ImpredicativeTypes while type-checking the code generated by GeneralizedNewtypeDeriving. It does this by adding a field ib_extensions to InstBindings, informing the type-checker what extensions should be enabled while type-checking the instance. >--------------------------------------------------------------- 674c969c240632da70ed2928fa30c20a9a52e5dc compiler/typecheck/TcDeriv.lhs | 15 ++++++++++----- compiler/typecheck/TcEnv.lhs | 4 ++++ compiler/typecheck/TcGenGenerics.lhs | 3 +++ compiler/typecheck/TcInstDcls.lhs | 7 ++++++- testsuite/tests/deriving/should_run/T8631.hs | 22 ++++++++++++++++++++++ testsuite/tests/deriving/should_run/all.T | 2 +- 6 files changed, 46 insertions(+), 7 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 674c969c240632da70ed2928fa30c20a9a52e5dc From git at git.haskell.org Sun Feb 9 09:24:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Feb 2014 09:24:09 +0000 (UTC) Subject: [commit: ghc] master: Issue an error for pattern synonyms defined in a local scope (#8757) (e0a5541) Message-ID: <20140209092409.070A22406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e0a55415545074bc7a757462624079f54f7785e2/ghc >--------------------------------------------------------------- commit e0a55415545074bc7a757462624079f54f7785e2 Author: Dr. ERDI Gergo Date: Sun Feb 9 17:20:34 2014 +0800 Issue an error for pattern synonyms defined in a local scope (#8757) This also fixes the internal crash when using pattern synonyms in GHCi (#8749) >--------------------------------------------------------------- e0a55415545074bc7a757462624079f54f7785e2 compiler/rename/RnBinds.lhs | 9 ++++++++- compiler/rename/RnPat.lhs | 5 +++++ testsuite/tests/patsyn/should_fail/all.T | 1 + 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index ed1343f..ba94a39 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -434,9 +434,16 @@ rnBindLHS name_maker _ bind@(FunBind { fun_id = name@(L nameLoc _) }) ; return (bind { fun_id = L nameLoc newname }) } rnBindLHS name_maker _ bind@(PatSynBind{ patsyn_id = rdrname@(L nameLoc _) }) - = do { addLocM checkConName rdrname + = do { unless (isTopRecNameMaker name_maker) $ + addErr localPatternSynonymErr + ; addLocM checkConName rdrname ; name <- applyNameMaker name_maker rdrname ; return (bind{ patsyn_id = L nameLoc name }) } + where + localPatternSynonymErr :: SDoc + localPatternSynonymErr + = hang (ptext (sLit "Illegal pattern synonym declaration")) + 2 (ptext (sLit "Pattern synonym declarations are only valid in the top-level scope")) rnBindLHS _ _ b = pprPanic "rnBindHS" (ppr b) diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs index 3fde563..3c48f34 100644 --- a/compiler/rename/RnPat.lhs +++ b/compiler/rename/RnPat.lhs @@ -23,6 +23,7 @@ module RnPat (-- main entry points NameMaker, applyNameMaker, -- a utility for making names: localRecNameMaker, topRecNameMaker, -- sometimes we want to make local names, -- sometimes we want to make top (qualified) names. + isTopRecNameMaker, rnHsRecFields1, HsRecFieldContext(..), @@ -193,6 +194,10 @@ data NameMaker topRecNameMaker :: MiniFixityEnv -> NameMaker topRecNameMaker fix_env = LetMk TopLevel fix_env +isTopRecNameMaker :: NameMaker -> Bool +isTopRecNameMaker (LetMk TopLevel _) = True +isTopRecNameMaker _ = False + localRecNameMaker :: MiniFixityEnv -> NameMaker localRecNameMaker fix_env = LetMk NotTopLevel fix_env diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index e1708d2..0a07aed 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -1,3 +1,4 @@ test('mono', normal, compile_fail, ['']) test('unidir', normal, compile_fail, ['']) +test('local', normal, compile_fail, ['']) From git at git.haskell.org Sun Feb 9 09:27:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Feb 2014 09:27:38 +0000 (UTC) Subject: [commit: ghc] master: Add test suite for #8757 (719108f) Message-ID: <20140209092738.8E73B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/719108f8d70aa50cdaccf564dbc463445a03988e/ghc >--------------------------------------------------------------- commit 719108f8d70aa50cdaccf564dbc463445a03988e Author: Dr. ERDI Gergo Date: Sun Feb 9 17:27:24 2014 +0800 Add test suite for #8757 >--------------------------------------------------------------- 719108f8d70aa50cdaccf564dbc463445a03988e testsuite/tests/patsyn/should_fail/local.hs | 7 +++++++ testsuite/tests/patsyn/should_fail/local.stderr | 4 ++++ 2 files changed, 11 insertions(+) diff --git a/testsuite/tests/patsyn/should_fail/local.hs b/testsuite/tests/patsyn/should_fail/local.hs new file mode 100644 index 0000000..08314ea --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/local.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PatternSynonyms #-} +module ShouldFail where + +varWithLocalPatSyn x = case x of + P -> () + where + pattern P = () diff --git a/testsuite/tests/patsyn/should_fail/local.stderr b/testsuite/tests/patsyn/should_fail/local.stderr new file mode 100644 index 0000000..a9a8d01 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/local.stderr @@ -0,0 +1,4 @@ + +local.hs:7:5: + Illegal pattern synonym declaration + Pattern synonym declarations are only valid in the top-level scope From git at git.haskell.org Sun Feb 9 14:04:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Feb 2014 14:04:00 +0000 (UTC) Subject: [commit: ghc] master: double-negate test for Stage1Only to fix `make clean` (7561e37) Message-ID: <20140209140400.567A22406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7561e37103041d6691c70683f910cdb97952483a/ghc >--------------------------------------------------------------- commit 7561e37103041d6691c70683f910cdb97952483a Author: Herbert Valerio Riedel Date: Sun Feb 9 14:59:49 2014 +0100 double-negate test for Stage1Only to fix `make clean` This was causing `utils/ghctags/dist-install` to not get removed on `make clean` as `Stage1Only` was unset. So testing for `!= YES` is less fragile than testing for `== NO` in this case. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 7561e37103041d6691c70683f910cdb97952483a ghc.mk | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ghc.mk b/ghc.mk index 6628878..288b113 100644 --- a/ghc.mk +++ b/ghc.mk @@ -427,7 +427,7 @@ endif # We normally install only the packages down to this point REGULAR_INSTALL_PACKAGES := $(addprefix libraries/,$(PACKAGES_STAGE1)) -ifeq "$(Stage1Only)" "NO" +ifneq "$(Stage1Only)" "YES" REGULAR_INSTALL_PACKAGES += compiler endif REGULAR_INSTALL_PACKAGES += $(addprefix libraries/,$(PACKAGES_STAGE2)) @@ -464,7 +464,7 @@ endif # If we want to just install everything, then we want all the packages SUPERSIZE_INSTALL_PACKAGES := $(addprefix libraries/,$(PACKAGES_STAGE1)) -ifeq "$(Stage1Only)" "NO" +ifneq "$(Stage1Only)" "YES" SUPERSIZE_INSTALL_PACKAGES += compiler endif SUPERSIZE_INSTALL_PACKAGES += $(addprefix libraries/,$(PACKAGES_STAGE2)) @@ -653,7 +653,7 @@ BUILD_DIRS += compiler BUILD_DIRS += utils/hsc2hs BUILD_DIRS += utils/ghc-pkg BUILD_DIRS += utils/testremove -ifeq "$(Stage1Only)" "NO" +ifneq "$(Stage1Only)" "YES" BUILD_DIRS += utils/ghctags endif BUILD_DIRS += utils/dll-split From git at git.haskell.org Sun Feb 9 14:26:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Feb 2014 14:26:02 +0000 (UTC) Subject: [commit: ghc] master: Let `make distclean` remove `/{ch01, ch02, index}.html` (65170fc) Message-ID: <20140209142602.5E92B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/65170fcb5c864f285bfbb9414be65cf001168e80/ghc >--------------------------------------------------------------- commit 65170fcb5c864f285bfbb9414be65cf001168e80 Author: Herbert Valerio Riedel Date: Sun Feb 9 15:24:00 2014 +0100 Let `make distclean` remove `/{ch01,ch02,index}.html` These files are created during `./configure` and therefore by convention are expected to be removed by `make distclean`. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 65170fcb5c864f285bfbb9414be65cf001168e80 ghc.mk | 1 + 1 file changed, 1 insertion(+) diff --git a/ghc.mk b/ghc.mk index 288b113..cb0dcde 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1263,6 +1263,7 @@ distclean : clean $(call removeFiles,docs/index.html) $(call removeFiles,libraries/prologue.txt) $(call removeFiles,distrib/configure.ac) + $(call removeFiles,ch01.html ch02.html index.html) # ./configure also makes these. $(call removeFiles,mk/config.h) From git at git.haskell.org Mon Feb 10 01:39:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 01:39:12 +0000 (UTC) Subject: [commit: ghc] master: Move test case for #8631 to the correct directory. (02c7135) Message-ID: <20140210013913.035A12406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/02c7135dfce049b53bd38aa35c175302652af507/ghc >--------------------------------------------------------------- commit 02c7135dfce049b53bd38aa35c175302652af507 Author: Richard Eisenberg Date: Sun Feb 9 10:57:44 2014 -0500 Move test case for #8631 to the correct directory. >--------------------------------------------------------------- 02c7135dfce049b53bd38aa35c175302652af507 testsuite/tests/deriving/{should_run => should_compile}/T8631.hs | 0 testsuite/tests/deriving/should_compile/all.T | 1 + testsuite/tests/deriving/should_run/all.T | 2 +- 3 files changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/deriving/should_run/T8631.hs b/testsuite/tests/deriving/should_compile/T8631.hs similarity index 100% rename from testsuite/tests/deriving/should_run/T8631.hs rename to testsuite/tests/deriving/should_compile/T8631.hs diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index 488c8e8..02b067e 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -42,3 +42,4 @@ test('T7710', normal, compile, ['']) test('AutoDeriveTypeable', normal, compile, ['']) test('T8138', reqlib('primitive'), compile, ['-O2']) +test('T8631', normal, compile, ['']) \ No newline at end of file diff --git a/testsuite/tests/deriving/should_run/all.T b/testsuite/tests/deriving/should_run/all.T index 15fa39b..572f95b 100644 --- a/testsuite/tests/deriving/should_run/all.T +++ b/testsuite/tests/deriving/should_run/all.T @@ -36,4 +36,4 @@ test('T5628', exit_code(1), compile_and_run, ['']) test('T5712', normal, compile_and_run, ['']) test('T7931', normal, compile_and_run, ['']) test('T8280', normal, compile_and_run, ['']) -test('T8631', normal, compile, ['']) + From git at git.haskell.org Mon Feb 10 01:39:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 01:39:16 +0000 (UTC) Subject: [commit: ghc] master: Fix #8758 by assuming RankNTypes when checking GND code. (8cc398f) Message-ID: <20140210013916.87A3B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8cc398ff8b3f7408327d99347f440693cb204c0a/ghc >--------------------------------------------------------------- commit 8cc398ff8b3f7408327d99347f440693cb204c0a Author: Richard Eisenberg Date: Sun Feb 9 11:08:07 2014 -0500 Fix #8758 by assuming RankNTypes when checking GND code. >--------------------------------------------------------------- 8cc398ff8b3f7408327d99347f440693cb204c0a compiler/typecheck/TcDeriv.lhs | 3 ++- testsuite/tests/deriving/should_compile/T8758.hs | 9 +++++++++ testsuite/tests/deriving/should_compile/T8758a.hs | 8 ++++++++ testsuite/tests/deriving/should_compile/all.T | 1 + 4 files changed, 20 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index f9f7c0a..8a4c19c 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -1969,7 +1969,8 @@ genInst standalone_deriv oflag comauxs , iBinds = InstBindings { ib_binds = gen_Newtype_binds loc clas tvs tys rhs_ty , ib_pragmas = [] - , ib_extensions = [Opt_ImpredicativeTypes] + , ib_extensions = [ Opt_ImpredicativeTypes + , Opt_RankNTypes ] , ib_standalone_deriving = standalone_deriv } } , emptyBag , Just $ getName $ head $ tyConDataCons rep_tycon ) } diff --git a/testsuite/tests/deriving/should_compile/T8758.hs b/testsuite/tests/deriving/should_compile/T8758.hs new file mode 100644 index 0000000..86c54c4 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T8758.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE RankNTypes #-} + +module T8758 where + +class C m where + foo :: (forall b. b -> m b) -> c -> m c + +instance C [] where + foo f c = f c \ No newline at end of file diff --git a/testsuite/tests/deriving/should_compile/T8758a.hs b/testsuite/tests/deriving/should_compile/T8758a.hs new file mode 100644 index 0000000..4b7fe44 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T8758a.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module T8758a where + +import T8758 + +newtype MyList a = Mk [a] + deriving C \ No newline at end of file diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index 02b067e..a7cc3df 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -43,3 +43,4 @@ test('AutoDeriveTypeable', normal, compile, ['']) test('T8138', reqlib('primitive'), compile, ['-O2']) test('T8631', normal, compile, ['']) +test('T8758', extra_clean(['T8758a.o', 'T8758a.hi']), multimod_compile, ['T8758a', '-v0']) \ No newline at end of file From git at git.haskell.org Mon Feb 10 01:39:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 01:39:19 +0000 (UTC) Subject: [commit: ghc] master: Test #6147, which was fixed with the roles commit. (9e0c1ae) Message-ID: <20140210013919.773E12406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9e0c1ae57526bacaca044a7ce5a6491fb6a7cb42/ghc >--------------------------------------------------------------- commit 9e0c1ae57526bacaca044a7ce5a6491fb6a7cb42 Author: Richard Eisenberg Date: Sun Feb 9 11:25:42 2014 -0500 Test #6147, which was fixed with the roles commit. >--------------------------------------------------------------- 9e0c1ae57526bacaca044a7ce5a6491fb6a7cb42 testsuite/tests/deriving/should_fail/T6147.hs | 13 +++++++++++++ testsuite/tests/deriving/should_fail/T6147.stderr | 11 +++++++++++ testsuite/tests/deriving/should_fail/all.T | 1 + 3 files changed, 25 insertions(+) diff --git a/testsuite/tests/deriving/should_fail/T6147.hs b/testsuite/tests/deriving/should_fail/T6147.hs new file mode 100644 index 0000000..f57f5af --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T6147.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-} +module T6147 where + +data family T a +data instance T Int = T_Int Int + +class C a where + foo :: a -> T a + +instance C Int where + foo = T_Int + +newtype Foo = Foo Int deriving(C) diff --git a/testsuite/tests/deriving/should_fail/T6147.stderr b/testsuite/tests/deriving/should_fail/T6147.stderr new file mode 100644 index 0000000..ffe584c --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T6147.stderr @@ -0,0 +1,11 @@ + +T6147.hs:13:32: + Could not coerce from ?T Int? to ?T Foo? + because the first type argument of ?T? has role Nominal, + but the arguments ?Int? and ?Foo? differ + arising from the coercion of the method ?foo? from type + ?Int -> T Int? to type ?Foo -> T Foo? + Possible fix: + use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (C Foo) diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T index b2b99ff..1ffa5fc 100644 --- a/testsuite/tests/deriving/should_fail/all.T +++ b/testsuite/tests/deriving/should_fail/all.T @@ -48,3 +48,4 @@ test('T7148', normal, compile_fail, ['']) test('T7148a', normal, compile_fail, ['']) test('T7800', normal, multimod_compile_fail, ['T7800','']) test('T5498', normal, compile_fail, ['']) +test('T6147', normal, compile_fail, ['']) \ No newline at end of file From git at git.haskell.org Mon Feb 10 01:39:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 01:39:22 +0000 (UTC) Subject: [commit: ghc] master: Test #7481, which had already been fixed. (d1dff94) Message-ID: <20140210013922.4664A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d1dff94c9a82ffeff0bf92d0f90231a639ade59c/ghc >--------------------------------------------------------------- commit d1dff94c9a82ffeff0bf92d0f90231a639ade59c Author: Richard Eisenberg Date: Sun Feb 9 11:34:19 2014 -0500 Test #7481, which had already been fixed. >--------------------------------------------------------------- d1dff94c9a82ffeff0bf92d0f90231a639ade59c testsuite/tests/polykinds/T7481.hs | 12 ++++++++++++ testsuite/tests/polykinds/T7481.stderr | 4 ++++ testsuite/tests/polykinds/all.T | 1 + 3 files changed, 17 insertions(+) diff --git a/testsuite/tests/polykinds/T7481.hs b/testsuite/tests/polykinds/T7481.hs new file mode 100644 index 0000000..cb64d39 --- /dev/null +++ b/testsuite/tests/polykinds/T7481.hs @@ -0,0 +1,12 @@ + {-# LANGUAGE DataKinds, PolyKinds, RankNTypes, GADTs #-} + +module T7481 where + +import Data.Proxy + +data D a where + D1 :: a -> D a + D2 :: (a~Int) => D a + D3 :: forall (a::k) b. Proxy a -> D b + +data Foo :: D * -> * \ No newline at end of file diff --git a/testsuite/tests/polykinds/T7481.stderr b/testsuite/tests/polykinds/T7481.stderr new file mode 100644 index 0000000..bd2d679 --- /dev/null +++ b/testsuite/tests/polykinds/T7481.stderr @@ -0,0 +1,4 @@ + +T7481.hs:12:13: + ?D? of kind ?* -> *? is not promotable + In the kind ?D * -> *? diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 34253fd..005c47a 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -97,3 +97,4 @@ test('T8534', normal, compile, ['']) test('T8566', normal, compile_fail,['']) test('T8616', normal, compile_fail,['']) test('T8566a', expect_broken(8566), compile,['']) +test('T7481', normal, compile_fail,['']) \ No newline at end of file From git at git.haskell.org Mon Feb 10 01:39:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 01:39:24 +0000 (UTC) Subject: [commit: ghc] master: Fix #8759 by not panicking with TH and patsyns. (6122efc) Message-ID: <20140210013925.013312406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6122efcabe6e08375f69ee19148ba3838c332559/ghc >--------------------------------------------------------------- commit 6122efcabe6e08375f69ee19148ba3838c332559 Author: Richard Eisenberg Date: Sun Feb 9 12:31:01 2014 -0500 Fix #8759 by not panicking with TH and patsyns. We should still have pattern synonyms in TH, though. >--------------------------------------------------------------- 6122efcabe6e08375f69ee19148ba3838c332559 compiler/deSugar/DsMeta.hs | 2 +- compiler/typecheck/TcSplice.lhs | 3 +++ testsuite/tests/th/T8759.hs | 11 +++++++++++ testsuite/tests/th/T8759.stderr | 3 +++ testsuite/tests/th/T8759a.hs | 5 +++++ testsuite/tests/th/T8759a.stderr | 4 ++++ testsuite/tests/th/all.T | 2 ++ 7 files changed, 29 insertions(+), 1 deletion(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 56fba14..9ee5bc1 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -1238,7 +1238,7 @@ rep_bind (L _ (VarBind { var_id = v, var_rhs = e})) ; return (srcLocSpan (getSrcLoc v), ans) } rep_bind (L _ (AbsBinds {})) = panic "rep_bind: AbsBinds" -rep_bind (L _ (PatSynBind {})) = panic "rep_bind: PatSynBind" +rep_bind (L _ dec@(PatSynBind {})) = notHandled "pattern synonyms" (ppr dec) ----------------------------------------------------------------------------- -- Since everything in a Bind is mutually recursive we need rename all -- all the variables simultaneously. For example: diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index b7e2699..0a47da1 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -70,6 +70,7 @@ import Class import Inst import TyCon import CoAxiom +import PatSyn ( patSynId ) import ConLike import DataCon import TcEvidence( TcEvBinds(..) ) @@ -1173,6 +1174,8 @@ reifyThing (AGlobal (AConLike (RealDataCon dc))) ; return (TH.DataConI (reifyName name) ty (reifyName (dataConOrigTyCon dc)) fix) } +reifyThing (AGlobal (AConLike (PatSynCon ps))) + = noTH (sLit "pattern synonyms") (ppr $ patSynId ps) reifyThing (ATcId {tct_id = id}) = do { ty1 <- zonkTcType (idType id) -- Make use of all the info we have, even diff --git a/testsuite/tests/th/T8759.hs b/testsuite/tests/th/T8759.hs new file mode 100644 index 0000000..298761a --- /dev/null +++ b/testsuite/tests/th/T8759.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell, PatternSynonyms #-} + +module T8759 where + +import Language.Haskell.TH + +pattern P = () + +$( do info <- reify 'P + reportWarning (show info) + return [] ) diff --git a/testsuite/tests/th/T8759.stderr b/testsuite/tests/th/T8759.stderr new file mode 100644 index 0000000..3b5474b --- /dev/null +++ b/testsuite/tests/th/T8759.stderr @@ -0,0 +1,3 @@ + +T8759.hs:9:4: + Can't represent pattern synonyms in Template Haskell: P diff --git a/testsuite/tests/th/T8759a.hs b/testsuite/tests/th/T8759a.hs new file mode 100644 index 0000000..3d8089c --- /dev/null +++ b/testsuite/tests/th/T8759a.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TemplateHaskell, PatternSynonyms #-} + +module T8759a where + +foo = [d| pattern Q = False |] diff --git a/testsuite/tests/th/T8759a.stderr b/testsuite/tests/th/T8759a.stderr new file mode 100644 index 0000000..ff0fd49 --- /dev/null +++ b/testsuite/tests/th/T8759a.stderr @@ -0,0 +1,4 @@ + +T8759a.hs:5:7: + pattern synonyms not (yet) handled by Template Haskell + pattern Q = False diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 5b064ba..3e88970 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -317,3 +317,5 @@ test('T8577', ['T8577', '-v0 ' + config.ghc_th_way_flags]) test('T8633', normal, compile_and_run, ['']) test('T8625', normal, ghci_script, ['T8625.script']) +test('T8759', normal, compile_fail, ['-v0']) +test('T8759a', normal, compile_fail, ['-v0']) \ No newline at end of file From git at git.haskell.org Mon Feb 10 01:39:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 01:39:27 +0000 (UTC) Subject: [commit: ghc] master: Apply changes relative to TH.Pred becoming a TH.Type's synonym (issue #7021) (e0dadc8) Message-ID: <20140210013927.751712406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e0dadc87b57ce7f4ec3b72eb52e4abe5a5218f52/ghc >--------------------------------------------------------------- commit e0dadc87b57ce7f4ec3b72eb52e4abe5a5218f52 Author: YoEight Date: Sat Jan 11 13:30:23 2014 +0100 Apply changes relative to TH.Pred becoming a TH.Type's synonym (issue #7021) Signed-off-by: Richard Eisenberg >--------------------------------------------------------------- e0dadc87b57ce7f4ec3b72eb52e4abe5a5218f52 compiler/deSugar/DsMeta.hs | 43 +++++++++++++++++---------------------- compiler/hsSyn/Convert.lhs | 16 ++++++--------- compiler/typecheck/TcSplice.lhs | 29 ++++++++++++++++++++++---- 3 files changed, 50 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 e0dadc87b57ce7f4ec3b72eb52e4abe5a5218f52 From git at git.haskell.org Mon Feb 10 01:39:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 01:39:30 +0000 (UTC) Subject: [commit: ghc] master: Fix tests due to issue #7021 (182ff9e) Message-ID: <20140210013930.850702406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/182ff9e814a917681b1600b2729c3340801630de/ghc >--------------------------------------------------------------- commit 182ff9e814a917681b1600b2729c3340801630de Author: YoEight Date: Sat Jan 11 13:47:24 2014 +0100 Fix tests due to issue #7021 Signed-off-by: Richard Eisenberg >--------------------------------------------------------------- 182ff9e814a917681b1600b2729c3340801630de testsuite/tests/th/T7021.hs | 7 +++++++ testsuite/tests/th/T7021a.hs | 31 +++++++++++++++++++++++++++++++ testsuite/tests/th/TH_genExLib.hs | 2 +- 3 files changed, 39 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/th/T7021.hs b/testsuite/tests/th/T7021.hs new file mode 100644 index 0000000..31e1843 --- /dev/null +++ b/testsuite/tests/th/T7021.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} +module T7021 where + +import T7021a + +func :: a -> Int +func = $(test) diff --git a/testsuite/tests/th/T7021a.hs b/testsuite/tests/th/T7021a.hs new file mode 100644 index 0000000..bd19133 --- /dev/null +++ b/testsuite/tests/th/T7021a.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE ConstraintKinds, TemplateHaskell, PolyKinds, TypeFamilies #-} + +module T7021a where + +import GHC.Prim +import Language.Haskell.TH + +type IOable a = (Show a, Read a) +type family ALittleSilly :: Constraint + +data Proxy a = Proxy + +foo :: IOable a => a +foo = undefined + +baz :: a b => Proxy a -> b +baz = undefined + +bar :: ALittleSilly => a +bar = undefined + +test :: Q Exp +test = do + Just fooName <- lookupValueName "foo" + Just bazName <- lookupValueName "baz" + Just barName <- lookupValueName "bar" + reify fooName + reify bazName + reify barName + [t| (Show a, (Read a, Num a)) => a -> a |] + [| \_ -> 0 |] diff --git a/testsuite/tests/th/TH_genExLib.hs b/testsuite/tests/th/TH_genExLib.hs index 02784ac..d439231 100644 --- a/testsuite/tests/th/TH_genExLib.hs +++ b/testsuite/tests/th/TH_genExLib.hs @@ -15,6 +15,6 @@ genAnyClass name decls = DataD [] anyName [] [constructor] [] where anyName = mkName ("Any" ++ nameBase name ++ "1111") - constructor = ForallC [PlainTV var_a] [ClassP name [VarT var_a]] $ + constructor = ForallC [PlainTV var_a] [AppT (ConT name) (VarT var_a)] $ NormalC anyName [(NotStrict, VarT var_a)] var_a = mkName "a" From git at git.haskell.org Mon Feb 10 01:39:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 01:39:32 +0000 (UTC) Subject: [commit: ghc] master: Refactor previous commit on fixing #7021. (8e303d7) Message-ID: <20140210013936.4F52E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8e303d725eba0d6e0f9e52c64da21a0f299fa422/ghc >--------------------------------------------------------------- commit 8e303d725eba0d6e0f9e52c64da21a0f299fa422 Author: Richard Eisenberg Date: Sun Feb 9 13:29:02 2014 -0500 Refactor previous commit on fixing #7021. >--------------------------------------------------------------- 8e303d725eba0d6e0f9e52c64da21a0f299fa422 compiler/deSugar/DsMeta.hs | 32 +++++++++++++++++--------------- compiler/typecheck/TcSplice.lhs | 34 ++-------------------------------- testsuite/tests/th/T8625.stdout | 4 ++-- testsuite/tests/th/all.T | 2 ++ 4 files changed, 23 insertions(+), 49 deletions(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 6a52e55..7fe77c5 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -767,6 +767,7 @@ repPred (HsParTy ty) = repLPred ty repPred ty | Just (cls, tys) <- splitHsClassTy_maybe ty + -- works even when cls is not a class (ConstraintKinds) = do cls1 <- lookupOcc cls tyco <- repNamedTyCon cls1 @@ -776,14 +777,15 @@ repPred (HsEqTy tyleft tyright) = do tyleft1 <- repLTy tyleft tyright1 <- repLTy tyright - repTequality tyleft1 tyright1 + eq <- repTequality + repTapps eq [tyleft1, tyright1] repPred (HsTupleTy _ lps) = do tupTy <- repTupleTyCon size - foldM go tupTy lps + tys' <- mapM repLTy lps + repTapps tupTy tys' where size = length lps - go ty' lp = repTapp ty' =<< repLPred lp repPred ty = notHandled "Exotic predicate type" (ppr ty) @@ -1818,8 +1820,8 @@ repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts } repTSig :: Core TH.TypeQ -> Core TH.Kind -> DsM (Core TH.TypeQ) repTSig (MkC ty) (MkC ki) = rep2 sigTName [ty, ki] -repTequality :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ) -repTequality (MkC t1) (MkC t2) = rep2 equalityTName [t1, t2] +repTequality :: DsM (Core TH.TypeQ) +repTequality = rep2 equalityTName [] repTPromotedList :: [Core TH.TypeQ] -> DsM (Core TH.TypeQ) repTPromotedList [] = repPromotedNilTyCon @@ -2715,22 +2717,22 @@ arrowTIdKey = mkPreludeMiscIdUnique 385 listTIdKey = mkPreludeMiscIdUnique 386 appTIdKey = mkPreludeMiscIdUnique 387 sigTIdKey = mkPreludeMiscIdUnique 388 -equalityTIdKey = mkPreludeMiscIdUnique 362 -litTIdKey = mkPreludeMiscIdUnique 389 -promotedTIdKey = mkPreludeMiscIdUnique 390 -promotedTupleTIdKey = mkPreludeMiscIdUnique 391 -promotedNilTIdKey = mkPreludeMiscIdUnique 392 -promotedConsTIdKey = mkPreludeMiscIdUnique 393 +equalityTIdKey = mkPreludeMiscIdUnique 389 +litTIdKey = mkPreludeMiscIdUnique 390 +promotedTIdKey = mkPreludeMiscIdUnique 391 +promotedTupleTIdKey = mkPreludeMiscIdUnique 392 +promotedNilTIdKey = mkPreludeMiscIdUnique 393 +promotedConsTIdKey = mkPreludeMiscIdUnique 394 -- data TyLit = ... numTyLitIdKey, strTyLitIdKey :: Unique -numTyLitIdKey = mkPreludeMiscIdUnique 394 -strTyLitIdKey = mkPreludeMiscIdUnique 395 +numTyLitIdKey = mkPreludeMiscIdUnique 395 +strTyLitIdKey = mkPreludeMiscIdUnique 396 -- data TyVarBndr = ... plainTVIdKey, kindedTVIdKey :: Unique -plainTVIdKey = mkPreludeMiscIdUnique 396 -kindedTVIdKey = mkPreludeMiscIdUnique 397 +plainTVIdKey = mkPreludeMiscIdUnique 397 +kindedTVIdKey = mkPreludeMiscIdUnique 398 -- data Role = ... nominalRIdKey, representationalRIdKey, phantomRIdKey, inferRIdKey :: Unique diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index 84e1670..9129ed8 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -1426,6 +1426,7 @@ reify_tc_app tc tys | tc `hasKey` listTyConKey = TH.ListT | tc `hasKey` nilDataConKey = TH.PromotedNilT | tc `hasKey` consDataConKey = TH.PromotedConsT + | tc `hasKey` eqTyConKey = TH.EqualityT | otherwise = TH.ConT (reifyName tc) removeKinds :: Kind -> [TypeRep.Type] -> [TypeRep.Type] removeKinds (FunTy k1 k2) (h:t) @@ -1441,38 +1442,7 @@ reifyPred ty -- We could reify the implicit paramter as a class but it seems -- nicer to support them properly... | isIPPred ty = noTH (sLit "implicit parameters") (ppr ty) - | otherwise - = case classifyPredType ty of - ClassPred cls tys -> do { tys' <- reifyTypes tys - ; let { name = reifyName cls - ; typ = foldl TH.AppT (TH.ConT name) tys' - } - ; return typ - } - EqPred ty1 ty2 -> do { ty1' <- reifyType ty1 - ; ty2' <- reifyType ty2 - ; return $ TH.AppT (TH.AppT TH.EqualityT ty1') ty2' - } - TuplePred xs -> do { xs' <- reifyTypes xs - ; let { size = length xs' - ; typ = foldl TH.AppT (TH.TupleT size) xs' - } - ; return typ } - IrredPred _ - | Just (ty1, ty2) <- splitAppTy_maybe ty - -> do { ty1' <- reifyType ty1 - ; ty2' <- reifyType ty2 - ; return $ TH.AppT ty1' ty2' - } - | Just (tyCon, tys) <- splitTyConApp_maybe ty - -> do { tys' <- reifyTypes tys - ; let { name = reifyName (tyConName tyCon) - ; typ = foldl TH.AppT (TH.ConT name) tys' - } - ; return typ - } - | otherwise -> noTH (sLit "unsupported irreducible predicates") (ppr ty) - + | otherwise = reifyType ty ------------------------------ reifyName :: NamedThing n => n -> TH.Name diff --git a/testsuite/tests/th/T8625.stdout b/testsuite/tests/th/T8625.stdout index e6ce48b..4453d69 100644 --- a/testsuite/tests/th/T8625.stdout +++ b/testsuite/tests/th/T8625.stdout @@ -1,2 +1,2 @@ -[InstanceD [EqualP (VarT y_0) (AppT (AppT ArrowT (VarT t_1)) (VarT t_1))] (AppT (ConT Ghci1.Member) (ConT GHC.Types.Bool)) []] -[SigD f_2 (ForallT [PlainTV y_3,PlainTV t_4] [EqualP (VarT y_3) (AppT (AppT ArrowT (VarT t_4)) (VarT t_4))] (AppT (AppT ArrowT (VarT y_3)) (VarT t_4))),FunD f_2 [Clause [VarP x_5] (NormalB (VarE x_5)) []]] +[InstanceD [AppT (AppT EqualityT (VarT y_0)) (AppT (AppT ArrowT (VarT t_1)) (VarT t_1))] (AppT (ConT Ghci1.Member) (ConT GHC.Types.Bool)) []] +[SigD f_2 (ForallT [PlainTV y_3,PlainTV t_4] [AppT (AppT EqualityT (VarT y_3)) (AppT (AppT ArrowT (VarT t_4)) (VarT t_4))] (AppT (AppT ArrowT (VarT y_3)) (VarT t_4))),FunD f_2 [Clause [VarP x_5] (NormalB (VarE x_5)) []]] diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 3e88970..e57b394 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -319,3 +319,5 @@ test('T8633', normal, compile_and_run, ['']) test('T8625', normal, ghci_script, ['T8625.script']) test('T8759', normal, compile_fail, ['-v0']) test('T8759a', normal, compile_fail, ['-v0']) +test('T7021', + extra_clean(['T7021a.hi', 'T7021a.o']), multimod_compile, ['T7021','-v0']) \ No newline at end of file From git at git.haskell.org Mon Feb 10 01:39:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 01:39:52 +0000 (UTC) Subject: [commit: packages/template-haskell] master: Make Pred a type synonym of Type (issue #7021) (57b662c) Message-ID: <20140210013952.DA0432406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/template-haskell On branch : master Link : http://git.haskell.org/packages/template-haskell.git/commitdiff/57b662c3efd8579595c8642fce2d4cd60ba4ec0b >--------------------------------------------------------------- commit 57b662c3efd8579595c8642fce2d4cd60ba4ec0b Author: YoEight Date: Fri Jan 10 21:42:01 2014 +0100 Make Pred a type synonym of Type (issue #7021) In order to make any type as a Predicate in Template Haskell, as allowed by ConstraintKinds Signed-off-by: Richard Eisenberg >--------------------------------------------------------------- 57b662c3efd8579595c8642fce2d4cd60ba4ec0b Language/Haskell/TH.hs | 7 +++---- Language/Haskell/TH/Lib.hs | 21 ++++++++------------- Language/Haskell/TH/Ppr.hs | 8 ++------ Language/Haskell/TH/Syntax.hs | 6 ++---- 4 files changed, 15 insertions(+), 27 deletions(-) diff --git a/Language/Haskell/TH.hs b/Language/Haskell/TH.hs index 2ab19bd..e9765a9 100644 --- a/Language/Haskell/TH.hs +++ b/Language/Haskell/TH.hs @@ -68,7 +68,7 @@ module Language.Haskell.TH( -- ** Patterns Pat(..), FieldExp, FieldPat, -- ** Types - Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred(..), Syntax.Role(..), + Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred, Syntax.Role(..), -- * Library functions -- ** Abbreviations @@ -105,14 +105,14 @@ module Language.Haskell.TH( bindS, letS, noBindS, parS, -- *** Types - forallT, varT, conT, appT, arrowT, listT, tupleT, sigT, litT, + forallT, varT, conT, appT, arrowT, equalityT, listT, tupleT, sigT, litT, promotedT, promotedTupleT, promotedNilT, promotedConsT, -- **** Type literals numTyLit, strTyLit, -- **** Strictness isStrict, notStrict, strictType, varStrictType, -- **** Class Contexts - cxt, classP, equalP, normalC, recC, infixC, forallC, + cxt, normalC, recC, infixC, forallC, -- *** Kinds varK, conK, tupleK, arrowK, listK, appK, starK, constraintK, @@ -146,4 +146,3 @@ module Language.Haskell.TH( import Language.Haskell.TH.Syntax as Syntax import Language.Haskell.TH.Lib import Language.Haskell.TH.Ppr - diff --git a/Language/Haskell/TH/Lib.hs b/Language/Haskell/TH/Lib.hs index b7a88d6..17e794b 100644 --- a/Language/Haskell/TH/Lib.hs +++ b/Language/Haskell/TH/Lib.hs @@ -466,19 +466,6 @@ tySynEqn lhs rhs = cxt :: [PredQ] -> CxtQ cxt = sequence -classP :: Name -> [TypeQ] -> PredQ -classP cla tys - = do - tys1 <- sequence tys - return (ClassP cla tys1) - -equalP :: TypeQ -> TypeQ -> PredQ -equalP tleft tright - = do - tleft1 <- tleft - tright1 <- tright - return (EqualP tleft1 tright1) - normalC :: Name -> [StrictTypeQ] -> ConQ normalC con strtys = liftM (NormalC con) $ sequence strtys @@ -536,6 +523,14 @@ sigT t k t' <- t return $ SigT t' k +equalityT :: TypeQ -> TypeQ -> TypeQ +equalityT tleft tright + = do + tleft1 <- tleft + tright1 <- tright + let typ = AppT (AppT EqualityT tleft1) tright1 + return typ + promotedT :: Name -> TypeQ promotedT = return . PromotedT diff --git a/Language/Haskell/TH/Ppr.hs b/Language/Haskell/TH/Ppr.hs index 2023f3a..e237066 100644 --- a/Language/Haskell/TH/Ppr.hs +++ b/Language/Haskell/TH/Ppr.hs @@ -496,6 +496,8 @@ instance Ppr Type where pprTyApp :: (Type, [Type]) -> Doc pprTyApp (ArrowT, [arg1,arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2] +pprTyApp (EqualityT, [arg1, arg2]) = + sep [pprFunArgType arg1 <+> text "~", ppr arg2] pprTyApp (ListT, [arg]) = brackets (ppr arg) pprTyApp (TupleT n, args) | length args == n = parens (sep (punctuate comma (map ppr args))) @@ -540,11 +542,6 @@ pprCxt [t] = ppr t <+> text "=>" pprCxt ts = parens (sep $ punctuate comma $ map ppr ts) <+> text "=>" ------------------------------ -instance Ppr Pred where - ppr (ClassP cla tys) = ppr cla <+> sep (map pprParendType tys) - ppr (EqualP ty1 ty2) = pprFunArgType ty1 <+> char '~' <+> pprFunArgType ty2 - ------------------------------- instance Ppr Range where ppr = brackets . pprRange where pprRange :: Range -> Doc @@ -569,4 +566,3 @@ hashParens d = text "(# " <> d <> text " #)" quoteParens :: Doc -> Doc quoteParens d = text "'(" <> d <> text ")" - diff --git a/Language/Haskell/TH/Syntax.hs b/Language/Haskell/TH/Syntax.hs index 3606f9d..17bb065 100644 --- a/Language/Haskell/TH/Syntax.hs +++ b/Language/Haskell/TH/Syntax.hs @@ -1346,9 +1346,7 @@ data AnnTarget = ModuleAnnotation type Cxt = [Pred] -- ^ @(Eq a, Ord b)@ -data Pred = ClassP Name [Type] -- ^ @Eq (Int, a)@ - | EqualP Type Type -- ^ @F a ~ Bool@ - deriving( Show, Eq, Data, Typeable ) +type Pred = Type data Strict = IsStrict | NotStrict | Unpacked deriving( Show, Eq, Data, Typeable ) @@ -1373,6 +1371,7 @@ data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \. \ -> \@ + | EqualityT -- ^ @~@ | ListT -- ^ @[]@ | PromotedTupleT Int -- ^ @'(), '(,), '(,,), etc.@ | PromotedNilT -- ^ @'[]@ @@ -1453,4 +1452,3 @@ cmpEq _ = False thenCmp :: Ordering -> Ordering -> Ordering thenCmp EQ o2 = o2 thenCmp o1 _ = o1 - From git at git.haskell.org Mon Feb 10 01:39:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 01:39:54 +0000 (UTC) Subject: [commit: packages/template-haskell] master: Change type of equalityT to be more parallel with others. (a02ef9d) Message-ID: <20140210013954.F0D072406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/template-haskell On branch : master Link : http://git.haskell.org/packages/template-haskell.git/commitdiff/a02ef9d827c4473e5e4efc84d7a8a987f51522aa >--------------------------------------------------------------- commit a02ef9d827c4473e5e4efc84d7a8a987f51522aa Author: Richard Eisenberg Date: Sun Feb 9 13:00:48 2014 -0500 Change type of equalityT to be more parallel with others. >--------------------------------------------------------------- a02ef9d827c4473e5e4efc84d7a8a987f51522aa Language/Haskell/TH/Lib.hs | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/Language/Haskell/TH/Lib.hs b/Language/Haskell/TH/Lib.hs index 17e794b..49baa96 100644 --- a/Language/Haskell/TH/Lib.hs +++ b/Language/Haskell/TH/Lib.hs @@ -523,13 +523,8 @@ sigT t k t' <- t return $ SigT t' k -equalityT :: TypeQ -> TypeQ -> TypeQ -equalityT tleft tright - = do - tleft1 <- tleft - tright1 <- tright - let typ = AppT (AppT EqualityT tleft1) tright1 - return typ +equalityT :: TypeQ +equalityT = return EqualityT promotedT :: Name -> TypeQ promotedT = return . PromotedT From git at git.haskell.org Mon Feb 10 01:39:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 01:39:56 +0000 (UTC) Subject: [commit: packages/template-haskell] master: Add documentation to why Pred has become a type synonym. (9b128b3) Message-ID: <20140210013956.E07E22406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/template-haskell On branch : master Link : http://git.haskell.org/packages/template-haskell.git/commitdiff/9b128b3c0317283edb0759479e2e26d351b86e58 >--------------------------------------------------------------- commit 9b128b3c0317283edb0759479e2e26d351b86e58 Author: Richard Eisenberg Date: Sun Feb 9 13:29:45 2014 -0500 Add documentation to why Pred has become a type synonym. >--------------------------------------------------------------- 9b128b3c0317283edb0759479e2e26d351b86e58 Language/Haskell/TH/Syntax.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Language/Haskell/TH/Syntax.hs b/Language/Haskell/TH/Syntax.hs index 17bb065..589c66a 100644 --- a/Language/Haskell/TH/Syntax.hs +++ b/Language/Haskell/TH/Syntax.hs @@ -1346,6 +1346,9 @@ data AnnTarget = ModuleAnnotation type Cxt = [Pred] -- ^ @(Eq a, Ord b)@ +-- | Since the advent of @ConstraintKinds@, constraints are really just types. +-- Equality constraints use the 'EqualityT' constructor. Constraints may also +-- be tuples of other constraints. type Pred = Type data Strict = IsStrict | NotStrict | Unpacked From git at git.haskell.org Mon Feb 10 01:40:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 01:40:10 +0000 (UTC) Subject: [commit: packages/dph] master: Fix breaking changes due to issue #7021 (aeef7aa) Message-ID: <20140210014012.8449D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/dph On branch : master Link : http://git.haskell.org/packages/dph.git/commitdiff/aeef7aad83aaa24c503fa18e321d2271829f003b >--------------------------------------------------------------- commit aeef7aad83aaa24c503fa18e321d2271829f003b Author: YoEight Date: Sat Jan 11 13:38:18 2014 +0100 Fix breaking changes due to issue #7021 Signed-off-by: Richard Eisenberg >--------------------------------------------------------------- aeef7aad83aaa24c503fa18e321d2271829f003b dph-lifted-copy/Data/Array/Parallel/Lifted/TH/Repr.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/dph-lifted-copy/Data/Array/Parallel/Lifted/TH/Repr.hs b/dph-lifted-copy/Data/Array/Parallel/Lifted/TH/Repr.hs index 9229723..fb6b02b 100644 --- a/dph-lifted-copy/Data/Array/Parallel/Lifted/TH/Repr.hs +++ b/dph-lifted-copy/Data/Array/Parallel/Lifted/TH/Repr.hs @@ -367,7 +367,7 @@ wrapPRInstance :: Name -> Name -> Name -> Name -> Q [Dec] wrapPRInstance ty wrap unwrap pwrap = do methods <- genPR_methods (recursiveMethod (wrapGen wrap unwrap pwrap)) - return [InstanceD [ClassP ''PA [a]] + return [InstanceD [ConT ''PA `AppT` a] (ConT ''PR `AppT` (ConT ty `AppT` a)) methods] where @@ -437,7 +437,7 @@ instance_PR_tup :: Int -> DecQ instance_PR_tup arity = do methods <- genPR_methods (recursiveMethod (tupGen arity)) - return $ InstanceD [ClassP ''PR [ty] | ty <- tys] + return $ InstanceD [ConT ''PR `AppT` ty | ty <- tys] (ConT ''PR `AppT` (TupleT arity `mkAppTs` tys)) methods where @@ -485,4 +485,3 @@ tupGen arity = Gen { recursiveCalls = arity pvs = take arity [c : "s" | c <- ['a' ..]] tyname = "(" ++ intercalate "," vs ++ ")" - From git at git.haskell.org Mon Feb 10 13:52:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 13:52:31 +0000 (UTC) Subject: [commit: packages/base] branch 'wip/T7994' deleted Message-ID: <20140210135231.4296E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base Deleted branch: wip/T7994 From git at git.haskell.org Mon Feb 10 13:52:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 13:52:33 +0000 (UTC) Subject: [commit: packages/base] master: Implement foldl with foldr (b63face) Message-ID: <20140210135233.52B0D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b63facef165b957183b65604ef99b2b8574747a5/base >--------------------------------------------------------------- commit b63facef165b957183b65604ef99b2b8574747a5 Author: Joachim Breitner Date: Tue Jan 28 14:31:05 2014 +0100 Implement foldl with foldr together with the call arity analysis and the following patch (about inlining maximum), we get nice benefits from fusing foldl and foldl' with good producers: Min -0.1% -74.5% -6.8% -8.3% -50.0% Max +0.2% 0.0% +38.5% +38.5% 0.0% Geometric Mean -0.0% -4.1% +7.7% +7.7% -0.8% Because this depends on a compiler optimisation, we have to watch out for cases where this is not an improvements, and whether they occur in the wild. >--------------------------------------------------------------- b63facef165b957183b65604ef99b2b8574747a5 Data/List.hs | 34 +++++++++------------------------- GHC/List.lhs | 13 +++++++------ 2 files changed, 16 insertions(+), 31 deletions(-) diff --git a/Data/List.hs b/Data/List.hs index 130ceb2..4796055 100644 --- a/Data/List.hs +++ b/Data/List.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-} +{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-} ----------------------------------------------------------------------------- -- | @@ -989,10 +989,11 @@ unfoldr f b = -- ----------------------------------------------------------------------------- -- | A strict version of 'foldl'. -foldl' :: (b -> a -> b) -> b -> [a] -> b -foldl' f z0 xs0 = lgo z0 xs0 - where lgo z [] = z - lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs +foldl' :: forall a b . (b -> a -> b) -> b -> [a] -> b +foldl' k z0 xs = foldr (\(v::a) (fn::b->b) (z::b) -> z `seq` fn (k z v)) (id :: b -> b) xs z0 +-- Implementing foldl' via foldr is only a good idea if the compiler can optimize +-- the resulting code (eta-expand the recursive "go"), so this needs -fcall-arity! +-- Also see #7994 -- | 'foldl1' is a variant of 'foldl' that has no starting value argument, -- and thus must be applied to non-empty lists. @@ -1008,32 +1009,15 @@ foldl1' _ [] = errorEmptyList "foldl1'" -- ----------------------------------------------------------------------------- -- List sum and product -{-# SPECIALISE sum :: [Int] -> Int #-} -{-# SPECIALISE sum :: [Integer] -> Integer #-} -{-# INLINABLE sum #-} -{-# SPECIALISE product :: [Int] -> Int #-} -{-# SPECIALISE product :: [Integer] -> Integer #-} -{-# INLINABLE product #-} --- We make 'sum' and 'product' inlinable so that we get specialisations --- at other types. See, for example, Trac #7507. - -- | The 'sum' function computes the sum of a finite list of numbers. sum :: (Num a) => [a] -> a -- | The 'product' function computes the product of a finite list of numbers. product :: (Num a) => [a] -> a -#ifdef USE_REPORT_PRELUDE + +{-# INLINE sum #-} sum = foldl (+) 0 +{-# INLINE product #-} product = foldl (*) 1 -#else -sum l = sum' l 0 - where - sum' [] a = a - sum' (x:xs) a = sum' xs (a+x) -product l = prod l 1 - where - prod [] a = a - prod (x:xs) a = prod xs (a*x) -#endif -- ----------------------------------------------------------------------------- -- Functions on strings diff --git a/GHC/List.lhs b/GHC/List.lhs index b7b78c7..e004ded 100644 --- a/GHC/List.lhs +++ b/GHC/List.lhs @@ -1,6 +1,6 @@ \begin{code} {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-} +{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- @@ -178,11 +178,12 @@ filterFB c p x r | p x = x `c` r -- can be inlined, and then (often) strictness-analysed, -- and hence the classic space leak on foldl (+) 0 xs -foldl :: (b -> a -> b) -> b -> [a] -> b -foldl f z0 xs0 = lgo z0 xs0 - where - lgo z [] = z - lgo z (x:xs) = lgo (f z x) xs +foldl :: forall a b. (b -> a -> b) -> b -> [a] -> b +{-# INLINE foldl #-} +foldl k z0 xs = foldr (\(v::a) (fn::b->b) (z::b) -> fn (k z v)) (id :: b -> b) xs z0 +-- Implementing foldl via foldr is only a good idea if the compiler can optimize +-- the resulting code (eta-expand the recursive "go"), so this needs -fcall-arity! +-- Also see #7994 -- | 'scanl' is similar to 'foldl', but returns a list of successive -- reduced values from the left: From git at git.haskell.org Mon Feb 10 13:52:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 13:52:35 +0000 (UTC) Subject: [commit: packages/base] master: Inline maximum/minium a bit more aggresively (4651b6a) Message-ID: <20140210135235.6B0DE2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4651b6a5508b796dac9c5c6d061176f0e561a273/base >--------------------------------------------------------------- commit 4651b6a5508b796dac9c5c6d061176f0e561a273 Author: Joachim Breitner Date: Wed Jan 29 17:29:53 2014 +0100 Inline maximum/minium a bit more aggresively in order to allow fusion of the foldr in the foldl in the foldl' therein. >--------------------------------------------------------------- 4651b6a5508b796dac9c5c6d061176f0e561a273 Data/List.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Data/List.hs b/Data/List.hs index 4796055..09aed9d 100644 --- a/Data/List.hs +++ b/Data/List.hs @@ -519,7 +519,7 @@ insertBy cmp x ys@(y:ys') -- It is a special case of 'Data.List.maximumBy', which allows the -- programmer to supply their own comparison function. maximum :: (Ord a) => [a] -> a -{-# NOINLINE [1] maximum #-} +{-# INLINE [1] maximum #-} maximum [] = errorEmptyList "maximum" maximum xs = foldl1 max xs @@ -540,7 +540,7 @@ strictMaximum xs = foldl1' max xs -- It is a special case of 'Data.List.minimumBy', which allows the -- programmer to supply their own comparison function. minimum :: (Ord a) => [a] -> a -{-# NOINLINE [1] minimum #-} +{-# INLINE [1] minimum #-} minimum [] = errorEmptyList "minimum" minimum xs = foldl1 min xs From git at git.haskell.org Mon Feb 10 13:53:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 13:53:11 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T7994-calledArity' deleted Message-ID: <20140210135311.1F0042406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T7994-calledArity From git at git.haskell.org Mon Feb 10 13:53:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 13:53:14 +0000 (UTC) Subject: [commit: ghc] master: Implement CallArity analysis (cdceadf) Message-ID: <20140210135314.D80B42406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cdceadf365335fdee5ffa8e6364f7fb00bc4b0f7/ghc >--------------------------------------------------------------- commit cdceadf365335fdee5ffa8e6364f7fb00bc4b0f7 Author: Joachim Breitner Date: Tue Jan 28 10:15:00 2014 +0000 Implement CallArity analysis This analysis finds out if a let-bound expression with lower manifest arity than type arity is always called with more arguments, as in that case eta-expansion is allowed and often viable. The analysis is very much tailored towards the code generated when foldl is implemented via foldr; without this analysis doing so would be a very bad idea! There are other ways to improve foldr/builder-fusion to cope with foldl, if any of these are implemented then this step can probably be moved to -O2 to save some compilation times. The current impact of adding this phase is just below +2% (measured running GHC's "make"). >--------------------------------------------------------------- cdceadf365335fdee5ffa8e6364f7fb00bc4b0f7 compiler/basicTypes/Id.lhs | 9 + compiler/basicTypes/IdInfo.lhs | 12 +- compiler/coreSyn/CoreArity.lhs | 3 +- compiler/coreSyn/PprCore.lhs | 12 +- compiler/ghc.cabal.in | 1 + compiler/main/DynFlags.hs | 5 + compiler/simplCore/CallArity.hs | 459 +++++++++++++++++++++++++++++++++++++ compiler/simplCore/CoreMonad.lhs | 3 + compiler/simplCore/SimplCore.lhs | 10 + compiler/simplCore/SimplUtils.lhs | 4 +- 10 files changed, 508 insertions(+), 10 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc cdceadf365335fdee5ffa8e6364f7fb00bc4b0f7 From git at git.haskell.org Mon Feb 10 13:53:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 13:53:17 +0000 (UTC) Subject: [commit: ghc] master: Add a unit test for CallArity (9bc8265) Message-ID: <20140210135318.1A21B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9bc826569ec2ae9bfd1e3bd882fcb406da8f26b3/ghc >--------------------------------------------------------------- commit 9bc826569ec2ae9bfd1e3bd882fcb406da8f26b3 Author: Joachim Breitner Date: Wed Jan 29 12:19:35 2014 +0000 Add a unit test for CallArity This also sets precedence for testing internals of GHC directly, i.e. without trying to come up with Haskell code and observable effects. Let's see how that goes. I put all the tests (including those where the analysis could do better) in one file because starting the GHC API is quite slow. >--------------------------------------------------------------- 9bc826569ec2ae9bfd1e3bd882fcb406da8f26b3 compiler/simplCore/CallArity.hs | 1 + testsuite/tests/callarity/CallArity1.hs | 160 ++++++++++++++++++++ testsuite/tests/callarity/CallArity1.stderr | 31 ++++ .../tests/{annotations => callarity}/Makefile | 0 testsuite/tests/callarity/all.T | 8 + 5 files changed, 200 insertions(+) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index b43d1fe..2527db0 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -4,6 +4,7 @@ module CallArity ( callArityAnalProgram + , callArityRHS -- for testing ) where import VarSet diff --git a/testsuite/tests/callarity/CallArity1.hs b/testsuite/tests/callarity/CallArity1.hs new file mode 100644 index 0000000..0da3c99 --- /dev/null +++ b/testsuite/tests/callarity/CallArity1.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE TupleSections #-} +import CoreSyn +import CoreUtils +import Id +import Type +import MkCore +import CallArity (callArityRHS) +import MkId +import SysTools +import DynFlags +import ErrUtils +import Outputable +import TysWiredIn +import Literal +import GHC +import Control.Monad +import Control.Monad.IO.Class +import System.Environment( getArgs ) +import VarSet +import PprCore +import Unique +import CoreLint +import FastString + +-- Build IDs. use mkTemplateLocal, more predictable than proper uniques +go, go2, x, d, n, y, z, scrut :: Id +[go, go2, x,d, n, y, z, scrut, f] = mkTestIds + (words "go go2 x d n y z scrut f") + [ mkFunTys [intTy, intTy] intTy + , mkFunTys [intTy, intTy] intTy + , intTy + , mkFunTys [intTy] intTy + , mkFunTys [intTy] intTy + , intTy + , intTy + , boolTy + , mkFunTys [intTy, intTy] intTy -- protoypical external function + ] + +exprs :: [(String, CoreExpr)] +exprs = + [ ("go2",) $ + mkRFun go [x] + (mkLet d (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y) + ) $ mkLams [z] $ Var d `mkVarApps` [x]) $ + go `mkLApps` [0, 0] + , ("nested_go2",) $ + mkRFun go [x] + (mkLet n (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y)) $ + mkACase (Var n) $ + mkFun go2 [y] + (mkLet d + (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y) ) $ + mkLams [z] $ Var d `mkVarApps` [x] )$ + Var go2 `mkApps` [mkLit 1] ) $ + go `mkLApps` [0, 0] + , ("d0",) $ + mkRFun go [x] + (mkLet d (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y) + ) $ mkLams [z] $ Var f `mkApps` [ Var d `mkVarApps` [x], Var d `mkVarApps` [x] ]) $ + go `mkLApps` [0, 0] + , ("go2 (in case crut)",) $ + mkRFun go [x] + (mkLet d (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y) + ) $ mkLams [z] $ Var d `mkVarApps` [x]) $ + Case (go `mkLApps` [0, 0]) z intTy + [(DEFAULT, [], Var f `mkVarApps` [z,z])] + , ("go2 (in function call)",) $ + mkRFun go [x] + (mkLet d (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y) + ) $ mkLams [z] $ Var d `mkVarApps` [x]) $ + f `mkLApps` [0] `mkApps` [go `mkLApps` [0, 0]] + , ("go2 (using surrounding interesting let; 'go 2' would be good!)",) $ + mkLet n (f `mkLApps` [0]) $ + mkRFun go [x] + (mkLet d (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y) + ) $ mkLams [z] $ Var d `mkVarApps` [x]) $ + Var f `mkApps` [n `mkLApps` [0], go `mkLApps` [0, 0]] + , ("go2 (using surrounding boring let)",) $ + mkLet z (mkLit 0) $ + mkRFun go [x] + (mkLet d (mkACase (Var go `mkVarApps` [x]) + (mkLams [y] $ Var y) + ) $ mkLams [z] $ Var d `mkVarApps` [x]) $ + Var f `mkApps` [Var z, go `mkLApps` [0, 0]] + , ("two recursions (both arity 1 would be good!)",) $ + mkRLet n (mkACase (mkLams [y] $ mkLit 0) (Var n)) $ + mkRLet d (mkACase (mkLams [y] $ mkLit 0) (Var d)) $ + Var n `mkApps` [d `mkLApps` [0]] + , ("two recursions (semantically like the previous case)",) $ + mkRLet n (mkACase (mkLams [y] $ mkLit 0) (Var n)) $ + mkRLet d (mkACase (mkLams [y] $ n `mkLApps` [0]) (Var d)) $ + d `mkLApps` [0] + ] + +main = do + [libdir] <- getArgs + runGhc (Just libdir) $ do + getSessionDynFlags >>= setSessionDynFlags . flip gopt_set Opt_SuppressUniques + dflags <- getSessionDynFlags + liftIO $ forM_ exprs $ \(n,e) -> do + case lintExpr [f,scrut] e of + Just msg -> putMsg dflags (msg $$ text "in" <+> text n) + Nothing -> return () + putMsg dflags (text n <> char ':') + -- liftIO $ putMsg dflags (ppr e) + let e' = callArityRHS e + let bndrs = varSetElems (allBoundIds e') + -- liftIO $ putMsg dflags (ppr e') + forM_ bndrs $ \v -> putMsg dflags $ nest 4 $ ppr v <+> ppr (idCallArity v) + +-- Utilities +mkLApps :: Id -> [Integer] -> CoreExpr +mkLApps v = mkApps (Var v) . map mkLit + +mkACase = mkIfThenElse (Var scrut) + +mkTestId :: Int -> String -> Type -> Id +mkTestId i s ty = mkSysLocal (mkFastString s) (mkBuiltinUnique i) ty + +mkTestIds :: [String] -> [Type] -> [Id] +mkTestIds ns tys = zipWith3 mkTestId [0..] ns tys + +mkLet :: Id -> CoreExpr -> CoreExpr -> CoreExpr +mkLet v rhs body = Let (NonRec v rhs) body + +mkRLet :: Id -> CoreExpr -> CoreExpr -> CoreExpr +mkRLet v rhs body = Let (Rec [(v, rhs)]) body + +mkFun :: Id -> [Id] -> CoreExpr -> CoreExpr -> CoreExpr +mkFun v xs rhs body = mkLet v (mkLams xs rhs) body + +mkRFun :: Id -> [Id] -> CoreExpr -> CoreExpr -> CoreExpr +mkRFun v xs rhs body = mkRLet v (mkLams xs rhs) body + +mkLit :: Integer -> CoreExpr +mkLit i = Lit (mkLitInteger i intTy) + +-- Collects all let-bound IDs +allBoundIds :: CoreExpr -> VarSet +allBoundIds (Let (NonRec v rhs) body) = allBoundIds rhs `unionVarSet` allBoundIds body `extendVarSet` v +allBoundIds (Let (Rec binds) body) = + allBoundIds body `unionVarSet` unionVarSets + [ allBoundIds rhs `extendVarSet` v | (v, rhs) <- binds ] +allBoundIds (App e1 e2) = allBoundIds e1 `unionVarSet` allBoundIds e2 +allBoundIds (Case scrut _ _ alts) = + allBoundIds scrut `unionVarSet` unionVarSets + [ allBoundIds e | (_, _ , e) <- alts ] +allBoundIds (Lam _ e) = allBoundIds e +allBoundIds (Tick _ e) = allBoundIds e +allBoundIds (Cast e _) = allBoundIds e +allBoundIds _ = emptyVarSet + diff --git a/testsuite/tests/callarity/CallArity1.stderr b/testsuite/tests/callarity/CallArity1.stderr new file mode 100644 index 0000000..ba8322b --- /dev/null +++ b/testsuite/tests/callarity/CallArity1.stderr @@ -0,0 +1,31 @@ +go2: + go 2 + d 1 +nested_go2: + go 2 + go2 2 + d 1 + n 1 +d0: + go 0 + d 0 +go2 (in case crut): + go 2 + d 1 +go2 (in function call): + go 2 + d 1 +go2 (using surrounding interesting let; 'go 2' would be good!): + go 0 + d 0 + n 1 +go2 (using surrounding boring let): + go 2 + d 1 + z 0 +two recursions (both arity 1 would be good!): + d 0 + n 1 +two recursions (semantically like the previous case): + d 1 + n 1 diff --git a/testsuite/tests/annotations/Makefile b/testsuite/tests/callarity/Makefile similarity index 100% copy from testsuite/tests/annotations/Makefile copy to testsuite/tests/callarity/Makefile diff --git a/testsuite/tests/callarity/all.T b/testsuite/tests/callarity/all.T new file mode 100644 index 0000000..e39c1d7 --- /dev/null +++ b/testsuite/tests/callarity/all.T @@ -0,0 +1,8 @@ +def f( name, opts ): + opts.only_ways = ['normal'] + +setTestOpts(f) +setTestOpts(extra_hc_opts('-package ghc')) +setTestOpts(extra_run_opts('"' + config.libdir + '"')) + +test('CallArity1', normal, compile_and_run, ['']) From git at git.haskell.org Mon Feb 10 13:53:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 13:53:20 +0000 (UTC) Subject: [commit: ghc] master: Update test cases due to call arity (393ea73) Message-ID: <20140210135320.3F8EB2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/393ea739567206d848f53e9ca75f532a49218694/ghc >--------------------------------------------------------------- commit 393ea739567206d848f53e9ca75f532a49218694 Author: Joachim Breitner Date: Mon Feb 10 11:13:19 2014 +0000 Update test cases due to call arity Some nice improvements on already succeeding test cases (#876, #7954 and #4267) Test #149 needed a little change, lest call arity causes a allocation change that we do not want to test here. >--------------------------------------------------------------- 393ea739567206d848f53e9ca75f532a49218694 testsuite/tests/perf/compiler/all.T | 21 ++++++++------------ testsuite/tests/perf/should_run/T149_A.hs | 2 +- testsuite/tests/perf/should_run/T149_B.hs | 2 +- testsuite/tests/perf/should_run/all.T | 10 +++++++--- .../tests/simplCore/should_compile/T3234.stderr | 2 +- .../tests/simplCore/should_compile/rule2.stderr | 2 +- 6 files changed, 19 insertions(+), 20 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index c77655b..ac6d5e8 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -69,7 +69,7 @@ test('T1969', # 2012-10-08 303930948 (x86/Linux, new codegen) # 2013-02-10 322937684 (x86/OSX) # 2014-01-22 316103268 (x86/Linux) - (wordsize(64), 698612512, 5)]), + (wordsize(64), 660922376, 5)]), # 17/11/2009 434845560 (amd64/Linux) # 08/12/2009 459776680 (amd64/Linux) # 17/05/2010 519377728 (amd64/Linux) @@ -77,19 +77,14 @@ test('T1969', # 16/07/2012 589168872 (amd64/Linux) # 20/07/2012 595936240 (amd64/Linux) # 23/08/2012 606230880 (amd64/Linux) - # 29/08/2012 633334184 (amd64/Linux) - # (^ new codegen) + # 29/08/2012 633334184 (amd64/Linux) new codegen # 18/09/2012 641959976 (amd64/Linux) - # 19/10/2012 661832592 (amd64/Linux) - # (^ -fPIC turned on) - # 23/10/2012 642594312 (amd64/Linux) - # (^ -fPIC turned off again) - # 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) + # 19/10/2012 661832592 (amd64/Linux) -fPIC turned on + # 23/10/2012 642594312 (amd64/Linux) -fPIC turned off again + # 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 only_ways(['normal']), extra_hc_opts('-dcore-lint -static') diff --git a/testsuite/tests/perf/should_run/T149_A.hs b/testsuite/tests/perf/should_run/T149_A.hs index dd74546..dc24f4c 100644 --- a/testsuite/tests/perf/should_run/T149_A.hs +++ b/testsuite/tests/perf/should_run/T149_A.hs @@ -21,5 +21,5 @@ playerMostOccur1 (x:xs) | otherwise = playerMostOccur1 xs numOccur :: Int -> [Int] -> Int -numOccur i is = length $ filter (i ==) is +numOccur i is = length is diff --git a/testsuite/tests/perf/should_run/T149_B.hs b/testsuite/tests/perf/should_run/T149_B.hs index fcc87cd..ef5b9c5 100644 --- a/testsuite/tests/perf/should_run/T149_B.hs +++ b/testsuite/tests/perf/should_run/T149_B.hs @@ -22,5 +22,5 @@ playerMostOccur2 (x:xs) where pmo = playerMostOccur2 xs numOccur :: Int -> [Int] -> Int -numOccur i is = length $ filter (i ==) is +numOccur i is = length is diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 98f9dc2..9ce4d45 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -57,8 +57,9 @@ test('lazy-bs-alloc', test('T876', [stats_num_field('bytes allocated', - [(wordsize(64), 1263712 , 5), + [(wordsize(64), 63216 , 5), # 2013-02-14: 1263712 (x86_64/Linux) + # 2014-02-10: 63216 (x86_64/Linux), call arity analysis (wordsize(32), 663712, 5)]), only_ways(['normal']), extra_run_opts('10000') @@ -289,7 +290,8 @@ test('T7797', test('T7954', [stats_num_field('bytes allocated', [(wordsize(32), 1380051408, 10), - (wordsize(64), 2720051528, 10)]), + (wordsize(64), 1680051336, 10)]), + # 2014-02-10: 1680051336 (x86_64/Linux), call arity analysis only_ways(['normal']) ], compile_and_run, @@ -313,8 +315,10 @@ test('T5949', test('T4267', [stats_num_field('bytes allocated', - [ (wordsize(64), 130000, 10)]), + [ (wordsize(64), 40992, 10)]), # previously, it was >170000 bytes + # 2014-01-17: 130000 + # 2014-02-10: 40992 (x86_64/Linux), call arity analysis only_ways(['normal'])], compile_and_run, ['-O']) diff --git a/testsuite/tests/simplCore/should_compile/T3234.stderr b/testsuite/tests/simplCore/should_compile/T3234.stderr index 4ccc5a1..c3591d0 100644 --- a/testsuite/tests/simplCore/should_compile/T3234.stderr +++ b/testsuite/tests/simplCore/should_compile/T3234.stderr @@ -61,6 +61,6 @@ Total ticks: 45 1 c 1 n 1 a -10 SimplifierDone 10 +11 SimplifierDone 11 diff --git a/testsuite/tests/simplCore/should_compile/rule2.stderr b/testsuite/tests/simplCore/should_compile/rule2.stderr index dbc7b0c..2c29fa4 100644 --- a/testsuite/tests/simplCore/should_compile/rule2.stderr +++ b/testsuite/tests/simplCore/should_compile/rule2.stderr @@ -25,6 +25,6 @@ Total ticks: 11 1 a 1 m 1 b -8 SimplifierDone 8 +9 SimplifierDone 9 From git at git.haskell.org Mon Feb 10 14:46:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 14:46:25 +0000 (UTC) Subject: [commit: ghc] master: Note [Eta expansion in match] (a4450ec) Message-ID: <20140210144625.BD1902406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a4450ece29ee42f6d04cdd6baf4c48ff596b687d/ghc >--------------------------------------------------------------- commit a4450ece29ee42f6d04cdd6baf4c48ff596b687d Author: Joachim Breitner Date: Mon Feb 10 14:46:14 2014 +0000 Note [Eta expansion in match] >--------------------------------------------------------------- a4450ece29ee42f6d04cdd6baf4c48ff596b687d compiler/specialise/Rules.lhs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs index b88888c..7fdf12c 100644 --- a/compiler/specialise/Rules.lhs +++ b/compiler/specialise/Rules.lhs @@ -682,6 +682,7 @@ match renv subst (Lam x1 e1) (Lam x2 e2) -- It's important that this is *after* the let rule, -- so that (\x.M) ~ (let y = e in \y.N) -- does the let thing, and then gets the lam/lam rule above +-- See Note [Eta expansion in match] match renv subst (Lam x1 e1) e2 = match renv' subst e1 (App e2 (varToCoreExpr new_x)) where @@ -998,6 +999,24 @@ at all. That is why the 'lookupRnInScope' call in the (Var v2) case of 'match' is so important. +Note [Eta expansion in match] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +At a first glance, this (eta-expansion of the thing to match if the template +contains a lambda) might waste work. For example + {-# RULES "f/expand" forall n. f (\x -> foo n x) = \x -> foo n x #-} +(for a non-inlined "f = id") will turn + go n = app (f (foo n)) +into + go n = app (\x -> foo n x) +and if foo had arity 1 and app calls its argument many times, are wasting work. + +In practice this does not occur (or at least I could not tickle this "bug") +because CSE turns it back into + go n = let lvl = foo n in app (\x -> lvl x) +which is fine. + + + %************************************************************************ %* * Rule-check the program From git at git.haskell.org Mon Feb 10 21:33:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 21:33:31 +0000 (UTC) Subject: [commit: haddock] master: Document module header. (1e21c67) Message-ID: <20140210213331.EB8822406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/1e21c673a42d3337e05607ed4f47024c65d0cc9d >--------------------------------------------------------------- commit 1e21c673a42d3337e05607ed4f47024c65d0cc9d Author: Mateusz Kowalczyk Date: Sun Feb 9 17:51:22 2014 +0000 Document module header. Fixes Haddock Trac #270. >--------------------------------------------------------------- 1e21c673a42d3337e05607ed4f47024c65d0cc9d doc/haddock.xml | 70 ++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 62 insertions(+), 8 deletions(-) diff --git a/doc/haddock.xml b/doc/haddock.xml index b5331c2..7c1ca91 100644 --- a/doc/haddock.xml +++ b/doc/haddock.xml @@ -100,7 +100,7 @@ We might want documentation in multiple formats - online and printed, for example. Haddock comes with HTML, LaTeX, and Hoogle backends, and it is structured in such a way that adding new - back-ends is straightforward. + backends is straightforward. @@ -1229,17 +1229,71 @@ f :: Int -- ^ The 'Int' argument
The module description - A module may contain a documentation comment before the - module header, in which case this comment is interpreted by - Haddock as an overall description of the module itself, and - placed in a section entitled Description in the - documentation for the module. For example: + A module itself may be documented with multiple fields + that can then be displayed by the backend. In particular, the + HTML backend displays all the fields it currently knows + about. We first show the most complete module documentation + example and then talk about the fields. --- | This is the description for module "Foo" -module Foo where +{-| +Module : W +Description : Short description +Copyright : (c) Some Guy, 2013 + Someone Else, 2014 +License : GPL-3 +Maintainer : sample at email.com +Stability : experimental +Portability : POSIX + +Here is a longer description of this module, containing some +commentary with @some markup at . +-} +module W where ... + + The Module field should be clear. It + currently doesn't affect the output of any of the backends but + you might want to include it for human information or for any + other tools that might be parsing these comments without the + help of GHC. + + The Description field accepts some short text + which outlines the general purpose of the module. If you're + generating HTML, it will show up next to the module link in + the module index. + + The Copyright, License, + Maintainer and Stability fields + should be obvious. An alternative spelling for the + License field is accepted as + Licence but the output will always prefer + License. + + The Portability field has seen varied use + by different library authors. Some people put down things like + operating system constraints there while others put down which + GHC extensions used. Note that you might want to consider using + the show-extensions module flag for the + latter. + + Finally, a module may contain a documentation comment + before the module header, in which case this comment is + interpreted by Haddock as an overall description of the module + itself, and placed in a section entitled + Description in the documentation for the module. + All usual Haddock markup is valid in this comment. + + All fields are optional but they must be in order if they + do appear. Multi-line fields are accepted but the consecutive + lines have to start indented more than their label. If your + label is indented one space as is often the case with + -- syntax, the consecutive lines have to start at + two spaces at the very least. Please note that we do not enforce + the format for any of the fields and the established formats are + just a convention. +
From git at git.haskell.org Mon Feb 10 22:37:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 22:37:02 +0000 (UTC) Subject: [commit: haddock] master: Insert a space between module link and description (01de3a3) Message-ID: <20140210223702.235102406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/01de3a355ee0db773eba5f4368ac8ef4d75425b5 >--------------------------------------------------------------- commit 01de3a355ee0db773eba5f4368ac8ef4d75425b5 Author: Mateusz Kowalczyk Date: Sun Feb 9 18:27:36 2014 +0000 Insert a space between module link and description Fixes Haddock Trac #277. >--------------------------------------------------------------- 01de3a355ee0db773eba5f4368ac8ef4d75425b5 src/Haddock/Backends/Xhtml.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index ac4282f..3168c7b 100644 --- a/src/Haddock/Backends/Xhtml.hs +++ b/src/Haddock/Backends/Xhtml.hs @@ -291,7 +291,7 @@ mkNodeList qual ss p ts = case ts of mkNode :: Qualification -> [String] -> String -> ModuleTree -> Html mkNode qual ss p (Node s leaf pkg short ts) = - htmlModule +++ shortDescr +++ htmlPkg +++ subtree + htmlModule <+> shortDescr +++ htmlPkg +++ subtree where modAttrs = case (ts, leaf) of (_:_, False) -> collapseControl p True "module" From git at git.haskell.org Mon Feb 10 23:28:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Feb 2014 23:28:49 +0000 (UTC) Subject: [commit: haddock] master: Ensure a space between type signature and ‘Source’ (860d650) Message-ID: <20140210232849.6CE9B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/860d6504530a163e7483960ca8837eb596e05634 >--------------------------------------------------------------- commit 860d6504530a163e7483960ca8837eb596e05634 Author: Mateusz Kowalczyk Date: Mon Feb 10 23:27:21 2014 +0000 Ensure a space between type signature and ?Source? This is briefly related to Haddock Trac #249 and employs effectively the suggested fix _but_ it doesn't actually fix the reported issue. This commit simply makes copying the full line a bit less of a pain. >--------------------------------------------------------------- 860d6504530a163e7483960ca8837eb596e05634 src/Haddock/Backends/Xhtml/Layout.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs index 3ddbd28..4584fd8 100644 --- a/src/Haddock/Backends/Xhtml/Layout.hs +++ b/src/Haddock/Backends/Xhtml/Layout.hs @@ -187,7 +187,7 @@ declElem = paragraph ! [theclass "src"] -- it adds a source and wiki link at the right hand side of the box topDeclElem :: LinksInfo -> SrcSpan -> [DocName] -> Html -> Html topDeclElem ((_,_,sourceMap), (_,_,maybe_wiki_url)) loc names html = - declElem << (html +++ srcLink +++ wikiLink) + declElem << (html <+> srcLink <+> wikiLink) where srcLink = case Map.lookup origPkg sourceMap of Nothing -> noHtml @@ -216,4 +216,3 @@ topDeclElem ((_,_,sourceMap), (_,_,maybe_wiki_url)) loc names html = fname = case loc of RealSrcSpan l -> unpackFS (srcSpanFile l) UnhelpfulSpan _ -> error "topDeclElem UnhelpfulSpan" - From git at git.haskell.org Tue Feb 11 15:40:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Feb 2014 15:40:21 +0000 (UTC) Subject: [commit: ghc] master: Replace forall'ed Coercible by ~R# in RULES (b4715d6) Message-ID: <20140211154021.CAD2E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b4715d67ae90f4cc847daa94f0fc056a40057d65/ghc >--------------------------------------------------------------- commit b4715d67ae90f4cc847daa94f0fc056a40057d65 Author: Joachim Breitner Date: Fri Jan 24 13:33:37 2014 +0000 Replace forall'ed Coercible by ~R# in RULES we want a rule "map coerce = coerce" to match the core generated for "map Age" (this is #2110). >--------------------------------------------------------------- b4715d67ae90f4cc847daa94f0fc056a40057d65 compiler/basicTypes/Id.lhs | 5 +++++ compiler/basicTypes/OccName.lhs | 9 ++++---- compiler/deSugar/Desugar.lhs | 46 +++++++++++++++++++++++++++++++++++++-- 3 files changed, 54 insertions(+), 6 deletions(-) diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs index 6194c50..aada6dc 100644 --- a/compiler/basicTypes/Id.lhs +++ b/compiler/basicTypes/Id.lhs @@ -30,6 +30,7 @@ module Id ( mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo, mkLocalId, mkLocalIdWithInfo, mkExportedLocalId, mkSysLocal, mkSysLocalM, mkUserLocal, mkUserLocalM, + mkDerivedLocalM, mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal, mkWorkerId, mkWiredInIdName, @@ -272,6 +273,10 @@ mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty mkUserLocalM :: MonadUnique m => OccName -> Type -> SrcSpan -> m Id mkUserLocalM occ ty loc = getUniqueM >>= (\uniq -> return (mkUserLocal occ uniq ty loc)) +mkDerivedLocalM :: MonadUnique m => (OccName -> OccName) -> Id -> Type -> m Id +mkDerivedLocalM deriv_name id ty + = getUniqueM >>= (\uniq -> return (mkLocalId (mkDerivedInternalName deriv_name uniq (getName id)) ty)) + mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name mkWiredInIdName mod fs uniq id = mkWiredInName mod (mkOccNameFS varName fs) uniq (AnId id) UserSyntax diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index 6dbae4b..e993767 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -62,9 +62,9 @@ module OccName ( mkGenDefMethodOcc, mkDerivedTyConOcc, mkNewTyCoOcc, mkClassOpAuxOcc, mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, - mkClassDataConOcc, mkDictOcc, mkIPOcc, - mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2, - mkGenD, mkGenR, mkGen1R, mkGenRCo, mkGenC, mkGenS, + mkClassDataConOcc, mkDictOcc, mkIPOcc, + mkSpecOcc, mkForeignExportOcc, mkRepEqOcc, mkGenOcc1, mkGenOcc2, + mkGenD, mkGenR, mkGen1R, mkGenRCo, mkGenC, mkGenS, mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc, mkInstTyCoOcc, mkEqPredCoOcc, @@ -572,7 +572,7 @@ isDerivedOccName occ = \begin{code} mkDataConWrapperOcc, mkWorkerOcc, mkMatcherOcc, mkDefaultMethodOcc, mkGenDefMethodOcc, mkDerivedTyConOcc, mkClassDataConOcc, mkDictOcc, - mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2, + mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkRepEqOcc, mkGenOcc1, mkGenOcc2, mkGenD, mkGenR, mkGen1R, mkGenRCo, mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc, mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc, @@ -593,6 +593,7 @@ mkDictOcc = mk_simple_deriv varName "$d" mkIPOcc = mk_simple_deriv varName "$i" mkSpecOcc = mk_simple_deriv varName "$s" mkForeignExportOcc = mk_simple_deriv varName "$f" +mkRepEqOcc = mk_simple_deriv tvName "$r" -- In RULES involving Coercible mkNewTyCoOcc = mk_simple_deriv tcName "NTCo:" -- Coercion for newtypes mkInstTyCoOcc = mk_simple_deriv tcName "TFCo:" -- Coercion for type functions mkEqPredCoOcc = mk_simple_deriv tcName "$co" diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs index e13767f..cd75de9 100644 --- a/compiler/deSugar/Desugar.lhs +++ b/compiler/deSugar/Desugar.lhs @@ -18,6 +18,7 @@ import Id import Name import Type import FamInstEnv +import Coercion import InstEnv import Class import Avail @@ -33,8 +34,11 @@ import Module import NameSet import NameEnv import Rules +import TysPrim (eqReprPrimTyCon) +import TysWiredIn (coercibleTyCon ) import BasicTypes ( Activation(.. ) ) import CoreMonad ( endPass, CoreToDo(..) ) +import MkCore import FastString import ErrUtils import Outputable @@ -347,6 +351,7 @@ Reason %************************************************************************ \begin{code} + dsRule :: LRuleDecl Id -> DsM (Maybe CoreRule) dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs)) = putSrcSpanDs loc $ @@ -359,9 +364,11 @@ dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs)) ; rhs' <- dsLExpr rhs ; dflags <- getDynFlags + ; (bndrs'', lhs'', rhs'') <- unfold_coerce bndrs' lhs' rhs' + -- Substitute the dict bindings eagerly, -- and take the body apart into a (f args) form - ; case decomposeRuleLhs bndrs' lhs' of { + ; case decomposeRuleLhs bndrs'' lhs'' of { Left msg -> do { warnDs msg; return Nothing } ; Right (final_bndrs, fn_id, args) -> do @@ -370,7 +377,7 @@ dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs)) -- we don't want to attach rules to the bindings of implicit Ids, -- because they don't show up in the bindings until just before code gen fn_name = idName fn_id - final_rhs = simpleOptExpr rhs' -- De-crap it + final_rhs = simpleOptExpr rhs'' -- De-crap it rule = mkRule False {- Not auto -} is_local name act fn_name final_bndrs args final_rhs @@ -398,6 +405,27 @@ dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs)) ; return (Just rule) } } } + +-- See Note [Desugaring coerce as cast] +unfold_coerce :: [Id] -> CoreExpr -> CoreExpr -> DsM ([Var], CoreExpr, CoreExpr) +unfold_coerce bndrs lhs rhs = do + (bndrs', wrap) <- go bndrs + return (bndrs', wrap lhs, wrap rhs) + where + go :: [Id] -> DsM ([Id], CoreExpr -> CoreExpr) + go [] = return ([], id) + go (v:vs) + | Just (tc, args) <- splitTyConApp_maybe (idType v) + , tc == coercibleTyCon = do + let ty' = mkTyConApp eqReprPrimTyCon args + v' <- mkDerivedLocalM mkRepEqOcc v ty' + + (bndrs, wrap) <- go vs + return (v':bndrs, mkCoreLet (NonRec v (mkEqBox (mkCoVarCo v'))) . wrap) + | otherwise = do + (bndrs,wrap) <- go vs + return (v:bndrs, wrap) + \end{code} Note [Desugaring RULE left hand sides] @@ -417,6 +445,20 @@ the rule is precisly to optimise them: {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} +Note [Desugaring coerce as cast] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We want the user to express a rule saying roughly ?mapping a coercion over a +list can be replaced by a coercion?. But the cast operator of Core (?) cannot +be written in Haskell. So we use `coerce` for that (#2110). The user writes + map coerce = coerce +as a RULE, and this optimizes any kind of mapped' casts aways, including `map +MkNewtype`. + +For that we replace any forall'ed `c :: Coercible a b` value in a RULE by +corresponding `co :: a ~#R b` and wrap the LHS and the RHS in +`let c = MkCoercible co in ...`. This is later simplified to the desired form +by simpleOptExpr (for the LHS) resp. the simplifiers (for the RHS). + %************************************************************************ %* * %* Desugaring vectorisation declarations From git at git.haskell.org Tue Feb 11 15:40:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Feb 2014 15:40:24 +0000 (UTC) Subject: [commit: ghc] master: In CoreSubst, optimize Coercible values aggressively (f4fb94f) Message-ID: <20140211154024.4AAE12406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f4fb94f366cc3c25f0d77e977611105ac75d9aa5/ghc >--------------------------------------------------------------- commit f4fb94f366cc3c25f0d77e977611105ac75d9aa5 Author: Joachim Breitner Date: Fri Jan 24 13:34:50 2014 +0000 In CoreSubst, optimize Coercible values aggressively just like boxed type equalities. >--------------------------------------------------------------- f4fb94f366cc3c25f0d77e977611105ac75d9aa5 compiler/coreSyn/CoreSubst.lhs | 4 ++-- testsuite/tests/ghci.debugger/scripts/print018.stdout | 6 +++--- testsuite/tests/perf/compiler/all.T | 5 +++-- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs index fef3e86..8531f92 100644 --- a/compiler/coreSyn/CoreSubst.lhs +++ b/compiler/coreSyn/CoreSubst.lhs @@ -61,7 +61,7 @@ import Coercion hiding ( substTy, substCo, extendTvSubst, substTyVarBndr, substC import TyCon ( tyConArity ) import DataCon -import PrelNames ( eqBoxDataConKey ) +import PrelNames ( eqBoxDataConKey, coercibleDataConKey ) import OptCoercion ( optCoercion ) import PprCore ( pprCoreBindings, pprRules ) import Module ( Module ) @@ -1039,7 +1039,7 @@ maybe_substitute subst b r trivial | exprIsTrivial r = True | (Var fun, args) <- collectArgs r , Just dc <- isDataConWorkId_maybe fun - , dc `hasKey` eqBoxDataConKey + , dc `hasKey` eqBoxDataConKey || dc `hasKey` coercibleDataConKey , all exprIsTrivial args = True -- See Note [Optimise coercion boxes agressively] | otherwise = False diff --git a/testsuite/tests/ghci.debugger/scripts/print018.stdout b/testsuite/tests/ghci.debugger/scripts/print018.stdout index 2686130..d5b7d46 100644 --- a/testsuite/tests/ghci.debugger/scripts/print018.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print018.stdout @@ -3,9 +3,9 @@ Stopped at ../Test.hs:40:1-17 _result :: () = _ Stopped at ../Test.hs:40:10-17 _result :: () = _ -x :: a = _ -x = (_t1::a) -x :: a +x :: a17 = _ +x = (_t1::a17) +x :: a17 () x = Unary x :: Unary diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index ac6d5e8..947c6f0 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -222,13 +222,14 @@ test('T3064', # 2012-10-30: 111189536 (x86/Windows) # 2013-11-13: 146626504 (x86/Windows, 64bit machine) # 2014-01-22: 162457940 (x86/Linux) - (wordsize(64), 329795912, 5)]), + (wordsize(64), 308422280, 5)]), # (amd64/Linux) (28/06/2011): 73259544 # (amd64/Linux) (07/02/2013): 224798696 # (amd64/Linux) (02/08/2013): 236404384, increase from roles # (amd64/Linux) (11/09/2013): 290165632, increase from AMP warnings # (amd64/Linux) (22/11/2013): 308300448, GND via Coercible and counters for constraints solving - # (amd64/Linux) (02/12/2013): 329795912, Coercible refactor + # (amd64/Linux) (02/12/2013): 329795912, Coercible refactor + # (amd64/Linux) (11/02/2014): 308422280, optimize Coercions in simpleOptExpr compiler_stats_num_field('max_bytes_used', [(wordsize(32), 7218200 , 20), From git at git.haskell.org Tue Feb 11 15:40:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Feb 2014 15:40:27 +0000 (UTC) Subject: [commit: ghc] master: In simpleOptExpr, unfold compulsary unfoldings (d557d8c) Message-ID: <20140211154027.56BB12406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d557d8c34b80a9513b6ea36aeab6453173d83fa3/ghc >--------------------------------------------------------------- commit d557d8c34b80a9513b6ea36aeab6453173d83fa3 Author: Joachim Breitner Date: Fri Jan 24 13:35:21 2014 +0000 In simpleOptExpr, unfold compulsary unfoldings such as that of coerce. >--------------------------------------------------------------- d557d8c34b80a9513b6ea36aeab6453173d83fa3 compiler/coreSyn/CoreSubst.lhs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs index 8531f92..20394f2 100644 --- a/compiler/coreSyn/CoreSubst.lhs +++ b/compiler/coreSyn/CoreSubst.lhs @@ -966,6 +966,10 @@ simple_app subst (Lam b e) (a:as) where (subst', b') = subst_opt_bndr subst b b2 = add_info subst' b b' +simple_app subst (Var v) as + | isCompulsoryUnfolding (idUnfolding v) + -- See Note [Unfold compulsory unfoldings in LHSs] + = simple_app subst (unfoldingTemplate (idUnfolding v)) as simple_app subst e as = foldl App (simple_opt_expr subst e) as @@ -1112,6 +1116,13 @@ we don't know what phase we're in. Here's an example When inlining 'foo' in 'bar' we want the let-binding for 'inner' to remain visible until Phase 1 +Note [Unfold compulsory unfoldings in LHSs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +When the user writes `map coerce = coerce` as a rule, the rule will only ever +match if we replace coerce by its unfolding on the LHS, because that is the +core that the rule matching engine will find. So do that for everything that +has a compulsory unfolding. Also see Note [Desugaring coerce as cast] %************************************************************************ %* * From git at git.haskell.org Tue Feb 11 15:40:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Feb 2014 15:40:29 +0000 (UTC) Subject: [commit: ghc] master: Add Case TyConAppCo to match_co (8f16233) Message-ID: <20140211154030.138852406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8f16233c154ab0645c4b90f0e4e98204650811c1/ghc >--------------------------------------------------------------- commit 8f16233c154ab0645c4b90f0e4e98204650811c1 Author: Joachim Breitner Date: Fri Jan 24 13:39:11 2014 +0000 Add Case TyConAppCo to match_co >--------------------------------------------------------------- 8f16233c154ab0645c4b90f0e4e98204650811c1 compiler/specialise/Rules.lhs | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs index 7fdf12c..4753e8f 100644 --- a/compiler/specialise/Rules.lhs +++ b/compiler/specialise/Rules.lhs @@ -730,9 +730,28 @@ match_co renv subst (Refl r1 ty1) co Refl r2 ty2 | r1 == r2 -> match_ty renv subst ty1 ty2 _ -> Nothing -match_co _ _ co1 _ - = pprTrace "match_co: needs more cases" (ppr co1) Nothing - -- Currently just deals with CoVarCo and Refl +match_co renv subst (TyConAppCo r1 tc1 cos1) co2 + = case co2 of + TyConAppCo r2 tc2 cos2 + | r1 == r2 && tc1 == tc2 + -> match_cos renv subst cos1 cos2 + _ -> Nothing +match_co _ _ co1 co2 + = pprTrace "match_co: needs more cases" (ppr co1 $$ ppr co2) Nothing + -- Currently just deals with CoVarCo, TyConAppCo and Refl + +match_cos :: RuleMatchEnv + -> RuleSubst + -> [Coercion] + -> [Coercion] + -> Maybe RuleSubst +match_cos renv subst (co1:cos1) (co2:cos2) = + case match_co renv subst co1 co2 of + Just subst' -> match_cos renv subst' cos1 cos2 + Nothing -> Nothing +match_cos _ subst [] [] = Just subst +match_cos _ _ cos1 cos2 = pprTrace "match_cos: not same length" (ppr cos1 $$ ppr cos2) Nothing + ------------- rnMatchBndr2 :: RuleMatchEnv -> RuleSubst -> Var -> Var -> RuleMatchEnv From git at git.haskell.org Tue Feb 11 15:40:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Feb 2014 15:40:32 +0000 (UTC) Subject: [commit: ghc] master: Test case for RULE map coerce = coerce (377672a) Message-ID: <20140211154032.8B85A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/377672ae068f6dbfa0354dfab95f41bdd26b0df4/ghc >--------------------------------------------------------------- commit 377672ae068f6dbfa0354dfab95f41bdd26b0df4 Author: Joachim Breitner Date: Mon Jan 27 10:36:34 2014 +0000 Test case for RULE map coerce = coerce (This tests #2110.) >--------------------------------------------------------------- 377672ae068f6dbfa0354dfab95f41bdd26b0df4 testsuite/tests/simplCore/should_run/T2110.hs | 28 +++++++++++++++++++++ testsuite/tests/simplCore/should_run/T2110.stdout | 3 +++ testsuite/tests/simplCore/should_run/all.T | 1 + 3 files changed, 32 insertions(+) diff --git a/testsuite/tests/simplCore/should_run/T2110.hs b/testsuite/tests/simplCore/should_run/T2110.hs new file mode 100644 index 0000000..fb65781 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T2110.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE MagicHash #-} + +import GHC.Exts +import Unsafe.Coerce + +{-# RULES +"map/coerce" map coerce = coerce + #-} + +newtype Age = Age Int + +fooAge :: [Int] -> [Age] +fooAge = map Age +fooCoerce :: [Int] -> [Age] +fooCoerce = map coerce +fooUnsafeCoerce :: [Int] -> [Age] +fooUnsafeCoerce = map unsafeCoerce + +same :: a -> b -> IO () +same x y = case reallyUnsafePtrEquality# (unsafeCoerce x) y of + 1# -> putStrLn "yes" + _ -> putStrLn "no" + +main = do + let l = [1,2,3] + same (fooAge l) l + same (fooCoerce l) l + same (fooUnsafeCoerce l) l diff --git a/testsuite/tests/simplCore/should_run/T2110.stdout b/testsuite/tests/simplCore/should_run/T2110.stdout new file mode 100644 index 0000000..55f7ebb --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T2110.stdout @@ -0,0 +1,3 @@ +yes +yes +yes diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 430d61f..6f5751e 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -51,6 +51,7 @@ test('T5453', normal, compile_and_run, ['']) test('T5441', extra_clean(['T5441a.o','T5441a.hi']), multimod_compile_and_run, ['T5441','']) test('T5603', normal, compile_and_run, ['']) +test('T2110', expect_broken(2110), compile_and_run, ['']) # Run these tests *without* optimisation too test('T5625', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run, ['']) From git at git.haskell.org Tue Feb 11 15:40:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Feb 2014 15:40:35 +0000 (UTC) Subject: [commit: ghc] master: Test case: Looking through unfoldings when matching lambdas (cde88e2) Message-ID: <20140211154035.7689E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cde88e20a880a5240831c330191610d536e48ccf/ghc >--------------------------------------------------------------- commit cde88e20a880a5240831c330191610d536e48ccf Author: Joachim Breitner Date: Tue Feb 11 11:24:28 2014 +0000 Test case: Looking through unfoldings when matching lambdas >--------------------------------------------------------------- cde88e20a880a5240831c330191610d536e48ccf testsuite/tests/simplCore/should_run/all.T | 1 + .../tests/simplCore/should_run/simplrun011.hs | 37 ++++++++++++++++++++ .../tests/simplCore/should_run/simplrun011.stdout | 6 ++++ 3 files changed, 44 insertions(+) diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index fa11dc5..530e4e5 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -21,6 +21,7 @@ test('simplrun009', normal, compile_and_run, ['']) test('simplrun010', [extra_run_opts('24 16 8 +RTS -M10m -RTS'), exit_code(251)] , compile_and_run, ['']) +test('simplrun011', normal, compile_and_run, ['']) # Really we'd like to run T2486 too, to check that its # runtime has not gone up, but here I just compile it so that diff --git a/testsuite/tests/simplCore/should_run/simplrun011.hs b/testsuite/tests/simplCore/should_run/simplrun011.hs new file mode 100644 index 0000000..e7f6646 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/simplrun011.hs @@ -0,0 +1,37 @@ +module Main where + +import GHC.Exts + +-- This checks that rules look through unfoldings when matching +-- lambdas, but only in the right phase + +foo :: (Int -> IO ()) -> IO () +foo f = putStr "not fired: " >> f 0 +{-# NOINLINE foo #-} + +f1 :: Int -> IO () +f1 _ = putStrLn "f1" +{-# NOINLINE[0] f1 #-} + +f2 :: Int -> IO () +f2 _ = putStrLn "f2" +{-# NOINLINE f2 #-} + +newtype Age = MkAge Int + +-- It also checks that this can look through casted lambdas + +f3 :: Age -> IO () +f3 _ = putStrLn "f3" +{-# NOINLINE[0] f3 #-} + + +{-# RULES "foo" [0] forall g . foo (\x -> g) = putStr "fired: " >> g #-} + +main = do + foo f1 + foo f1 + foo f2 + foo f2 + foo (coerce f3) + foo (coerce f3) diff --git a/testsuite/tests/simplCore/should_run/simplrun011.stdout b/testsuite/tests/simplCore/should_run/simplrun011.stdout new file mode 100644 index 0000000..3751791 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/simplrun011.stdout @@ -0,0 +1,6 @@ +fired: f1 +fired: f1 +not fired: f2 +not fired: f2 +fired: f3 +fired: f3 From git at git.haskell.org Tue Feb 11 15:40:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Feb 2014 15:40:37 +0000 (UTC) Subject: [commit: ghc] master: Use exprIsLambda_maybe in match (a27b298) Message-ID: <20140211154037.F0FA02406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a27b2985511800fa3b740fef82ad3da9c8683302/ghc >--------------------------------------------------------------- commit a27b2985511800fa3b740fef82ad3da9c8683302 Author: Joachim Breitner Date: Tue Feb 11 10:42:50 2014 +0000 Use exprIsLambda_maybe in match when matching a lambda in the template against an expression. When matching, look through coercions (only for value lambdas for now), and look through currently active unfoldings, if these are undersaturated, i.e. produce a lambda. This replaces the existing, somewhat fishy eta-expansion. >--------------------------------------------------------------- a27b2985511800fa3b740fef82ad3da9c8683302 compiler/coreSyn/CoreSubst.lhs | 76 +++++++++++++++++++++++++++- compiler/specialise/Rules.lhs | 43 ++++------------ testsuite/tests/simplCore/should_run/all.T | 2 +- 3 files changed, 85 insertions(+), 36 deletions(-) diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs index 20394f2..7dfa25f 100644 --- a/compiler/coreSyn/CoreSubst.lhs +++ b/compiler/coreSyn/CoreSubst.lhs @@ -40,7 +40,7 @@ module CoreSubst ( -- ** Simple expression optimiser simpleOptPgm, simpleOptExpr, simpleOptExprWith, - exprIsConApp_maybe, exprIsLiteral_maybe + exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe, ) where #include "HsVersions.h" @@ -1301,3 +1301,77 @@ exprIsLiteral_maybe env@(_, id_unf) e -> exprIsLiteral_maybe env rhs _ -> Nothing \end{code} + +Note [exprIsLiteral_maybe] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +This function will, given an expression `e`, try to turn it into the form +`Lam v e'` (returned as `Just (v,e')`). Besides using lambdas, it looks through +casts (using the Push rule), and it unfoldes function calls if the unfolding +has a greater arity than arguments are present. + +Currently, it is used in Rules.match, and is required to make +"map coerce = coerce" match. + +\begin{code} +-- See Note [exprIsLiteral_maybe] +exprIsLambda_maybe :: InScopeEnv -> CoreExpr -> Maybe (Var, CoreExpr) + +-- The simpe case: It is a lambda +exprIsLambda_maybe _ (Lam x e) + = Just (x, e) + +-- Also possible: A casted lambda. Push the coercion insinde +exprIsLambda_maybe (in_scope_set, id_unf) (Cast casted_e co) + | Just (x, e) <- exprIsLambda_maybe (in_scope_set, id_unf) casted_e + -- Only do value lambdas. + -- this implies that x is not in scope in gamma (makes this code simpler) + , not (isTyVar x) && not (isCoVar x) + , ASSERT( not $ x `elemVarSet` tyCoVarsOfCo co) True + , let res = pushCoercionIntoLambda in_scope_set x e co + = -- pprTrace "exprIsLambda_maybe:Cast" (vcat [ppr casted_e, ppr co, ppr res]) + res + +-- Another attempt: See if we find a partial unfolding +exprIsLambda_maybe (in_scope_set, id_unf) e + | (Var f, as) <- collectArgs e + , let unfolding = id_unf f + , Just rhs <- expandUnfolding_maybe unfolding + -- Make sure there is hope to get a lamda + , unfoldingArity unfolding > length (filter isValArg as) + -- Optimize, for beta-reduction + , let e' = simpleOptExprWith (mkEmptySubst in_scope_set) (rhs `mkApps` as) + -- Recurse, because of possible casts + , Just (x', e'') <- exprIsLambda_maybe (in_scope_set, id_unf) e' + , let res = Just (x', e'') + = -- pprTrace "exprIsLambda_maybe:Unfold" (vcat [ppr e, ppr res]) + res + +exprIsLambda_maybe _ _e + = -- pprTrace "exprIsLambda_maybe:Fail" (vcat [ppr _e]) + Nothing + + +pushCoercionIntoLambda + :: InScopeSet -> Var -> CoreExpr -> Coercion -> Maybe (Var, CoreExpr) +pushCoercionIntoLambda in_scope x e co + -- This implements the Push rule from the paper on coercions + -- Compare with simplCast in Simplify + | ASSERT (not (isTyVar x) && not (isCoVar x)) True + , Pair s1s2 t1t2 <- coercionKind co + , Just (_s1,_s2) <- splitFunTy_maybe s1s2 + , Just (t1,_t2) <- splitFunTy_maybe t1t2 + = let [co1, co2] = decomposeCo 2 co + -- Should we optimize the coercions here? + -- Otherwise they might not match too well + x' = x `setIdType` t1 + in_scope' = in_scope `extendInScopeSet` x' + subst = extendIdSubst (mkEmptySubst in_scope') + x + (mkCast (Var x') co1) + in Just (x', subst_expr subst e `mkCast` co2) + | otherwise + = pprTrace "exprIsLambda_maybe: Unexpected lambda in case" (ppr (Lam x e)) + Nothing + +\end{code} diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs index 4753e8f..c85bc06 100644 --- a/compiler/specialise/Rules.lhs +++ b/compiler/specialise/Rules.lhs @@ -578,6 +578,9 @@ data RuleMatchEnv , rv_unf :: IdUnfoldingFun } +rvInScopeEnv :: RuleMatchEnv -> InScopeEnv +rvInScopeEnv renv = (rnInScopeSet (rv_lcl renv), rv_unf renv) + data RuleSubst = RS { rs_tv_subst :: TvSubstEnv -- Range is the , rs_id_subst :: IdSubstEnv -- template variables , rs_binds :: BindWrapper -- Floated bindings @@ -638,7 +641,8 @@ match renv subst e1 (Var v2) -- Note [Expanding variables] -- because of the not-inRnEnvR match renv subst e1 (Let bind e2) - | okToFloat (rv_lcl renv) (bindFreeVars bind) -- See Note [Matching lets] + | -- pprTrace "match:Let" (vcat [ppr bind, ppr $ okToFloat (rv_lcl renv) (bindFreeVars bind)]) $ + okToFloat (rv_lcl renv) (bindFreeVars bind) -- See Note [Matching lets] = match (renv { rv_fltR = flt_subst' }) (subst { rs_binds = rs_binds subst . Let bind' , rs_bndrs = extendVarSetList (rs_bndrs subst) new_bndrs }) @@ -671,23 +675,11 @@ match renv subst (App f1 a1) (App f2 a2) = do { subst' <- match renv subst f1 f2 ; match renv subst' a1 a2 } -match renv subst (Lam x1 e1) (Lam x2 e2) - = match renv' subst e1 e2 - where - renv' = renv { rv_lcl = rnBndr2 (rv_lcl renv) x1 x2 - , rv_fltR = delBndr (rv_fltR renv) x2 } - --- This rule does eta expansion --- (\x.M) ~ N iff M ~ N x --- It's important that this is *after* the let rule, --- so that (\x.M) ~ (let y = e in \y.N) --- does the let thing, and then gets the lam/lam rule above --- See Note [Eta expansion in match] match renv subst (Lam x1 e1) e2 - = match renv' subst e1 (App e2 (varToCoreExpr new_x)) - where - (rn_env', new_x) = rnEtaL (rv_lcl renv) x1 - renv' = renv { rv_lcl = rn_env' } + | Just (x2, e2) <- exprIsLambda_maybe (rvInScopeEnv renv) e2 + = let renv' = renv { rv_lcl = rnBndr2 (rv_lcl renv) x1 x2 + , rv_fltR = delBndr (rv_fltR renv) x2 } + in match renv' subst e1 e2 -- Eta expansion the other way -- M ~ (\y.N) iff M y ~ N @@ -1018,23 +1010,6 @@ at all. That is why the 'lookupRnInScope' call in the (Var v2) case of 'match' is so important. -Note [Eta expansion in match] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -At a first glance, this (eta-expansion of the thing to match if the template -contains a lambda) might waste work. For example - {-# RULES "f/expand" forall n. f (\x -> foo n x) = \x -> foo n x #-} -(for a non-inlined "f = id") will turn - go n = app (f (foo n)) -into - go n = app (\x -> foo n x) -and if foo had arity 1 and app calls its argument many times, are wasting work. - -In practice this does not occur (or at least I could not tickle this "bug") -because CSE turns it back into - go n = let lvl = foo n in app (\x -> lvl x) -which is fine. - - %************************************************************************ %* * diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 6f5751e..fa11dc5 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -51,7 +51,7 @@ test('T5453', normal, compile_and_run, ['']) test('T5441', extra_clean(['T5441a.o','T5441a.hi']), multimod_compile_and_run, ['T5441','']) test('T5603', normal, compile_and_run, ['']) -test('T2110', expect_broken(2110), compile_and_run, ['']) +test('T2110', normal, compile_and_run, ['']) # Run these tests *without* optimisation too test('T5625', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run, ['']) From git at git.haskell.org Tue Feb 11 15:42:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Feb 2014 15:42:24 +0000 (UTC) Subject: [commit: ghc] branch 'wip/nomeata-T2110' deleted Message-ID: <20140211154224.CB06A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/nomeata-T2110 From git at git.haskell.org Tue Feb 11 15:59:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Feb 2014 15:59:18 +0000 (UTC) Subject: [commit: haddock] master: Add support for type/data families (e0718f2) Message-ID: <20140211155918.1A8D62406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/e0718f203f2448ba2029e70d14aed075860b7fac >--------------------------------------------------------------- commit e0718f203f2448ba2029e70d14aed075860b7fac Author: nand Date: Tue Feb 4 22:13:27 2014 +0100 Add support for type/data families This adds support for type/data families with their respective instances, as well as closed type families and associated type/data families. Signed-off-by: Mateusz Kowalczyk >--------------------------------------------------------------- e0718f203f2448ba2029e70d14aed075860b7fac CHANGES | 2 + doc/haddock.xml | 12 +- html-test/ref/TypeFamilies.html | 674 +++++++++++++++++--- .../{HiddenInstancesB.html => TypeFamilies2.html} | 94 +-- html-test/ref/ocean.css | 19 + html-test/src/TypeFamilies.hs | 76 ++- html-test/src/TypeFamilies2.hs | 12 + resources/html/Ocean.std-theme/ocean.css | 13 + src/Haddock/Backends/LaTeX.hs | 16 +- src/Haddock/Backends/Xhtml.hs | 1 + src/Haddock/Backends/Xhtml/Decl.hs | 42 +- src/Haddock/Backends/Xhtml/Layout.hs | 5 + src/Haddock/Convert.hs | 34 +- src/Haddock/GhcUtils.hs | 11 + src/Haddock/Interface/AttachInstances.hs | 57 +- src/Haddock/Interface/Create.hs | 122 ++-- src/Haddock/Interface/Rename.hs | 9 +- src/Haddock/Types.hs | 22 +- 18 files changed, 924 insertions(+), 297 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e0718f203f2448ba2029e70d14aed075860b7fac From git at git.haskell.org Tue Feb 11 15:59:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Feb 2014 15:59:20 +0000 (UTC) Subject: [commit: haddock] master: Improve display of poly-kinded type operators (bc5756d) Message-ID: <20140211155920.822212406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/bc5756d062bbc5cad5d4fa60798435ed020c518e >--------------------------------------------------------------- commit bc5756d062bbc5cad5d4fa60798435ed020c518e Author: nand Date: Tue Feb 11 11:52:48 2014 +0100 Improve display of poly-kinded type operators This now displays them as (==) k a b c ... to mirror GHC's behavior, instead of the old (k == a) b c ... which was just wrong. Signed-off-by: Mateusz Kowalczyk >--------------------------------------------------------------- bc5756d062bbc5cad5d4fa60798435ed020c518e CHANGES | 2 + html-test/ref/TypeFamilies.html | 292 ++++++++++++++++++++++++++++-------- html-test/src/TypeFamilies.hs | 14 +- src/Haddock/Backends/LaTeX.hs | 22 +-- src/Haddock/Backends/Xhtml.hs | 2 +- src/Haddock/Backends/Xhtml/Decl.hs | 30 ++-- src/Haddock/Convert.hs | 10 +- src/Haddock/Interface/Rename.hs | 5 +- src/Haddock/Types.hs | 6 +- 9 files changed, 280 insertions(+), 103 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc bc5756d062bbc5cad5d4fa60798435ed020c518e From git at git.haskell.org Tue Feb 11 15:59:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Feb 2014 15:59:22 +0000 (UTC) Subject: [commit: haddock] master: Add test case for PatternSynonyms (7e53f62) Message-ID: <20140211155922.2690A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/7e53f628440169f90cfb6aeeaf74ffbe2b1cfa6d >--------------------------------------------------------------- commit 7e53f628440169f90cfb6aeeaf74ffbe2b1cfa6d Author: nand Date: Tue Feb 11 16:51:27 2014 +0100 Add test case for PatternSynonyms This just tests various stuff including poly-kinded patterns and operator patterns to make sure the rendering isn't broken. Signed-off-by: Mateusz Kowalczyk >--------------------------------------------------------------- 7e53f628440169f90cfb6aeeaf74ffbe2b1cfa6d html-test/ref/PatternSyns.html | 241 ++++++++++++++++++++++++++++++++++++++++ html-test/src/PatternSyns.hs | 22 ++++ 2 files changed, 263 insertions(+) diff --git a/html-test/ref/PatternSyns.html b/html-test/ref/PatternSyns.html new file mode 100644 index 0000000..36b3c3b --- /dev/null +++ b/html-test/ref/PatternSyns.html @@ -0,0 +1,241 @@ + +PatternSyns
Safe HaskellSafe-Inferred

PatternSyns

Description

Testing some pattern synonyms

Synopsis

Documentation

data FooType x

FooType doc

Constructors

FooCtor x 

pattern Foo t :: FooType t

Pattern synonym for Foo x

pattern Bar t :: FooType (FooType t)

Pattern synonym for Bar x

pattern t :<-> t :: (FooType t, FooType (FooType t))

Pattern synonym for (:<->)

data a >< b

Doc for (><)

Constructors

Empty 

pattern E :: (><) k t t

Pattern for Empty

diff --git a/html-test/src/PatternSyns.hs b/html-test/src/PatternSyns.hs new file mode 100644 index 0000000..8af5eb2 --- /dev/null +++ b/html-test/src/PatternSyns.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE PatternSynonyms, PolyKinds, TypeOperators #-} + +-- | Testing some pattern synonyms +module PatternSyns where + +-- | FooType doc +data FooType x = FooCtor x + +-- | Pattern synonym for 'Foo' x +pattern Foo x = FooCtor x + +-- | Pattern synonym for 'Bar' x +pattern Bar x = FooCtor (Foo x) + +-- | Pattern synonym for (':<->') +pattern x :<-> y = (Foo x, Bar y) + +-- | Doc for ('><') +data (a :: *) >< b = Empty + +-- | Pattern for 'Empty' +pattern E = Empty From git at git.haskell.org Tue Feb 11 17:14:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Feb 2014 17:14:44 +0000 (UTC) Subject: [commit: ghc] master: Remove eta-expansion in Rules.match (5d04603) Message-ID: <20140211171444.A93322406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5d04603b33d2855657745d15f698664a444f6550/ghc >--------------------------------------------------------------- commit 5d04603b33d2855657745d15f698664a444f6550 Author: Joachim Breitner Date: Tue Feb 11 17:46:05 2014 +0100 Remove eta-expansion in Rules.match It validates and nofib shows no change, so possibly dead code. Removing in the interest of code cleanliness, someone disagrees please revert (and preferably add a testcase, or at least describe the situation this is important in in a Note). >--------------------------------------------------------------- 5d04603b33d2855657745d15f698664a444f6550 compiler/specialise/Rules.lhs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs index c85bc06..70fc09a 100644 --- a/compiler/specialise/Rules.lhs +++ b/compiler/specialise/Rules.lhs @@ -681,14 +681,6 @@ match renv subst (Lam x1 e1) e2 , rv_fltR = delBndr (rv_fltR renv) x2 } in match renv' subst e1 e2 --- Eta expansion the other way --- M ~ (\y.N) iff M y ~ N -match renv subst e1 (Lam x2 e2) - = match renv' subst (App e1 (varToCoreExpr new_x)) e2 - where - (rn_env', new_x) = rnEtaR (rv_lcl renv) x2 - renv' = renv { rv_lcl = rn_env' } - match renv subst (Case e1 x1 ty1 alts1) (Case e2 x2 ty2 alts2) = do { subst1 <- match_ty renv subst ty1 ty2 ; subst2 <- match renv subst1 e1 e2 From git at git.haskell.org Thu Feb 13 09:12:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Feb 2014 09:12:29 +0000 (UTC) Subject: [commit: ghc] master: Cleaned up Maybes.lhs (e16826b) Message-ID: <20140213091229.18FBA2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e16826b12e8a086fa9d75f2835d128c0a8dd532c/ghc >--------------------------------------------------------------- commit e16826b12e8a086fa9d75f2835d128c0a8dd532c Author: Baldur Bl?ndal Date: Thu Feb 13 09:01:03 2014 +0100 Cleaned up Maybes.lhs >--------------------------------------------------------------- e16826b12e8a086fa9d75f2835d128c0a8dd532c compiler/basicTypes/NameEnv.lhs | 2 +- compiler/basicTypes/RdrName.lhs | 6 +++--- compiler/codeGen/StgCmmBind.hs | 4 ++-- compiler/deSugar/DsCCall.lhs | 7 ++++--- compiler/iface/MkIface.lhs | 2 +- compiler/main/GhcMake.hs | 4 ++-- compiler/main/TidyPgm.lhs | 2 +- compiler/rename/RnEnv.lhs | 2 +- compiler/stgSyn/CoreToStg.lhs | 4 ++-- compiler/typecheck/TcBinds.lhs | 2 +- compiler/typecheck/TcClassDcl.lhs | 3 ++- compiler/typecheck/TcDeriv.lhs | 6 +++--- compiler/typecheck/TcErrors.lhs | 7 ++++--- compiler/typecheck/TcSMonad.lhs | 8 ++++---- compiler/typecheck/TcTyDecls.lhs | 2 +- compiler/typecheck/TcType.lhs | 4 ++-- compiler/typecheck/TcValidity.lhs | 4 ++-- compiler/types/OptCoercion.lhs | 3 ++- compiler/utils/Maybes.lhs | 38 ++++--------------------------------- 19 files changed, 42 insertions(+), 68 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e16826b12e8a086fa9d75f2835d128c0a8dd532c From git at git.haskell.org Thu Feb 13 09:22:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Feb 2014 09:22:17 +0000 (UTC) Subject: [commit: ghc] master: Link to #minimal-pragma from release notes (9f607ee) Message-ID: <20140213092217.842342406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9f607eeb6227635a219b316926891e825557682c/ghc >--------------------------------------------------------------- commit 9f607eeb6227635a219b316926891e825557682c Author: Joachim Breitner Date: Thu Feb 13 09:22:07 2014 +0000 Link to #minimal-pragma from release notes >--------------------------------------------------------------- 9f607eeb6227635a219b316926891e825557682c docs/users_guide/7.8.1-notes.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/users_guide/7.8.1-notes.xml b/docs/users_guide/7.8.1-notes.xml index c04a129..c60bacf 100644 --- a/docs/users_guide/7.8.1-notes.xml +++ b/docs/users_guide/7.8.1-notes.xml @@ -291,6 +291,7 @@ explicitly declare the minimal complete definition of a class. Should an instance not provide the minimal required definitions, a warning will be emitted. + See for details. From git at git.haskell.org Thu Feb 13 09:48:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Feb 2014 09:48:01 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Link to #minimal-pragma from release notes (a90da92) Message-ID: <20140213094801.61D672406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/a90da927b4c84d03608efbdaeb3c78750a700ec4/ghc >--------------------------------------------------------------- commit a90da927b4c84d03608efbdaeb3c78750a700ec4 Author: Joachim Breitner Date: Thu Feb 13 09:22:07 2014 +0000 Link to #minimal-pragma from release notes (cherry picked from commit 9f607eeb6227635a219b316926891e825557682c) Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- a90da927b4c84d03608efbdaeb3c78750a700ec4 docs/users_guide/7.8.1-notes.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/users_guide/7.8.1-notes.xml b/docs/users_guide/7.8.1-notes.xml index c04a129..c60bacf 100644 --- a/docs/users_guide/7.8.1-notes.xml +++ b/docs/users_guide/7.8.1-notes.xml @@ -291,6 +291,7 @@ explicitly declare the minimal complete definition of a class. Should an instance not provide the minimal required definitions, a warning will be emitted. + See for details. From git at git.haskell.org Thu Feb 13 10:30:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Feb 2014 10:30:29 +0000 (UTC) Subject: [commit: ghc] master: Manual hlinting: or (map f) = any f (e2cacb6) Message-ID: <20140213103031.00FA52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e2cacb66e10c7b991e77d7a3c0d9f5dc7c4c2cf8/ghc >--------------------------------------------------------------- commit e2cacb66e10c7b991e77d7a3c0d9f5dc7c4c2cf8 Author: Joachim Breitner Date: Thu Feb 13 10:30:21 2014 +0000 Manual hlinting: or (map f) = any f >--------------------------------------------------------------- e2cacb66e10c7b991e77d7a3c0d9f5dc7c4c2cf8 compiler/deSugar/Check.lhs | 4 ++-- compiler/nativeGen/X86/Instr.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs index 960475ce..91c2e8b 100644 --- a/compiler/deSugar/Check.lhs +++ b/compiler/deSugar/Check.lhs @@ -421,8 +421,8 @@ compare_cons _ _ = panic "Check.compare_cons: Not ConPatOut with RealDataCon" remove_dups :: [Pat Id] -> [Pat Id] remove_dups [] = [] -remove_dups (x:xs) | or (map (\y -> compare_cons x y) xs) = remove_dups xs - | otherwise = x : remove_dups xs +remove_dups (x:xs) | any (\y -> compare_cons x y) = remove_dups xs + | otherwise = x : remove_dups xs get_used_cons :: [(EqnNo, EquationInfo)] -> [Pat Id] get_used_cons qs = remove_dups [pat | q <- qs, let pat = firstPatN q, diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index d10591e..8284270 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -788,7 +788,7 @@ i386_insert_ffrees -> [GenBasicBlock Instr] i386_insert_ffrees blocks - | or (map (any is_G_instr) [ instrs | BasicBlock _ instrs <- blocks ]) + | any (any is_G_instr) [ instrs | BasicBlock _ instrs <- blocks ] = map insertGFREEs blocks | otherwise = blocks From git at git.haskell.org Thu Feb 13 11:41:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Feb 2014 11:41:15 +0000 (UTC) Subject: [commit: ghc] master: Fix Manual hlinting patch (3477216) Message-ID: <20140213114116.14BDE2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/347721659cb3abd8e8b0d7a4e5d56eb8ac62f3fe/ghc >--------------------------------------------------------------- commit 347721659cb3abd8e8b0d7a4e5d56eb8ac62f3fe Author: Joachim Breitner Date: Thu Feb 13 11:36:32 2014 +0000 Fix Manual hlinting patch >--------------------------------------------------------------- 347721659cb3abd8e8b0d7a4e5d56eb8ac62f3fe compiler/deSugar/Check.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs index 91c2e8b..c0fe9c0 100644 --- a/compiler/deSugar/Check.lhs +++ b/compiler/deSugar/Check.lhs @@ -421,8 +421,8 @@ compare_cons _ _ = panic "Check.compare_cons: Not ConPatOut with RealDataCon" remove_dups :: [Pat Id] -> [Pat Id] remove_dups [] = [] -remove_dups (x:xs) | any (\y -> compare_cons x y) = remove_dups xs - | otherwise = x : remove_dups xs +remove_dups (x:xs) | any (\y -> compare_cons x y) xs = remove_dups xs + | otherwise = x : remove_dups xs get_used_cons :: [(EqnNo, EquationInfo)] -> [Pat Id] get_used_cons qs = remove_dups [pat | q <- qs, let pat = firstPatN q, From git at git.haskell.org Thu Feb 13 19:56:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Feb 2014 19:56:31 +0000 (UTC) Subject: [commit: ghc] master: Fix some typos in comments (3d80787) Message-ID: <20140213195631.E10432406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3d80787f8bd76015fbbcc127204bddc670f93872/ghc >--------------------------------------------------------------- commit 3d80787f8bd76015fbbcc127204bddc670f93872 Author: Gabor Greif Date: Thu Feb 13 20:54:58 2014 +0100 Fix some typos in comments >--------------------------------------------------------------- 3d80787f8bd76015fbbcc127204bddc670f93872 compiler/coreSyn/CoreSubst.lhs | 6 +++--- compiler/specialise/SpecConstr.lhs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs index 7dfa25f..833f19e 100644 --- a/compiler/coreSyn/CoreSubst.lhs +++ b/compiler/coreSyn/CoreSubst.lhs @@ -1307,7 +1307,7 @@ Note [exprIsLiteral_maybe] This function will, given an expression `e`, try to turn it into the form `Lam v e'` (returned as `Just (v,e')`). Besides using lambdas, it looks through -casts (using the Push rule), and it unfoldes function calls if the unfolding +casts (using the Push rule), and it unfolds function calls if the unfolding has a greater arity than arguments are present. Currently, it is used in Rules.match, and is required to make @@ -1321,7 +1321,7 @@ exprIsLambda_maybe :: InScopeEnv -> CoreExpr -> Maybe (Var, CoreExpr) exprIsLambda_maybe _ (Lam x e) = Just (x, e) --- Also possible: A casted lambda. Push the coercion insinde +-- Also possible: A casted lambda. Push the coercion inside exprIsLambda_maybe (in_scope_set, id_unf) (Cast casted_e co) | Just (x, e) <- exprIsLambda_maybe (in_scope_set, id_unf) casted_e -- Only do value lambdas. @@ -1337,7 +1337,7 @@ exprIsLambda_maybe (in_scope_set, id_unf) e | (Var f, as) <- collectArgs e , let unfolding = id_unf f , Just rhs <- expandUnfolding_maybe unfolding - -- Make sure there is hope to get a lamda + -- Make sure there is hope to get a lambda , unfoldingArity unfolding > length (filter isValArg as) -- Optimize, for beta-reduction , let e' = simpleOptExprWith (mkEmptySubst in_scope_set) (rhs `mkApps` as) diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs index 060c705..86a56f4 100644 --- a/compiler/specialise/SpecConstr.lhs +++ b/compiler/specialise/SpecConstr.lhs @@ -335,7 +335,7 @@ I wonder if SpecConstr couldn't be extended to handle this? After all, lambda is a sort of constructor for functions and perhaps it already has most of the necessary machinery? -Furthermore, there's an immediate win, because you don't need to allocate the lamda +Furthermore, there's an immediate win, because you don't need to allocate the lambda at the call site; and if perchance it's called in the recursive call, then you may avoid allocating it altogether. Just like for constructors. From git at git.haskell.org Thu Feb 13 20:15:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Feb 2014 20:15:18 +0000 (UTC) Subject: [commit: ghc] master: Remove space after ASSERT. (3d9644c) Message-ID: <20140213201518.5DEA22406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3d9644c2fc705ec80a8a63b0b698d74cd2d49212/ghc >--------------------------------------------------------------- commit 3d9644c2fc705ec80a8a63b0b698d74cd2d49212 Author: Julian K. Arni Date: Wed Feb 12 04:11:31 2014 -0200 Remove space after ASSERT. Which on OS X leaves macro unexpanded. >--------------------------------------------------------------- 3d9644c2fc705ec80a8a63b0b698d74cd2d49212 compiler/coreSyn/CoreSubst.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs index 833f19e..d1fc056 100644 --- a/compiler/coreSyn/CoreSubst.lhs +++ b/compiler/coreSyn/CoreSubst.lhs @@ -1357,7 +1357,7 @@ pushCoercionIntoLambda pushCoercionIntoLambda in_scope x e co -- This implements the Push rule from the paper on coercions -- Compare with simplCast in Simplify - | ASSERT (not (isTyVar x) && not (isCoVar x)) True + | ASSERT(not (isTyVar x) && not (isCoVar x)) True , Pair s1s2 t1t2 <- coercionKind co , Just (_s1,_s2) <- splitFunTy_maybe s1s2 , Just (t1,_t2) <- splitFunTy_maybe t1t2 From git at git.haskell.org Thu Feb 13 21:53:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Feb 2014 21:53:59 +0000 (UTC) Subject: [commit: haddock] master: Get rid of re-implementation of sortBy (d86f688) Message-ID: <20140213215359.CCFD42406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/d86f68860c40d45d2cec94edd15d4bf4fc4292d8 >--------------------------------------------------------------- commit d86f68860c40d45d2cec94edd15d4bf4fc4292d8 Author: Niklas Haas Date: Thu Feb 13 22:21:36 2014 +0100 Get rid of re-implementation of sortBy I have no idea what this was doing lying around here, and due to the usage of tuples it's actually slower, too. Signed-off-by: Mateusz Kowalczyk >--------------------------------------------------------------- d86f68860c40d45d2cec94edd15d4bf4fc4292d8 src/Haddock/Interface/AttachInstances.hs | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs index a56759a..8c9d45c 100644 --- a/src/Haddock/Interface/AttachInstances.hs +++ b/src/Haddock/Interface/AttachInstances.hs @@ -19,6 +19,7 @@ import Haddock.Convert import Control.Arrow import Data.List +import Data.Ord (comparing) import qualified Data.Map as Map import qualified Data.Set as Set @@ -67,12 +68,12 @@ attachToExportItem expInfo iface ifaceMap instIfaceMap export = case mb_info of Just (_, _, cls_instances, fam_instances) -> let fam_insts = [ (synifyFamInst i, n) - | i <- sortImage instFam fam_instances + | i <- sortBy (comparing instFam) fam_instances , let n = lookupInstDoc (getName i) iface ifaceMap instIfaceMap ] cls_insts = [ (synifyInstHead i, lookupInstDoc n iface ifaceMap instIfaceMap) | let is = [ (instanceHead' i, getName i) | i <- cls_instances ] - , (i@(_,_,cls,tys), n) <- sortImage (first instHead) is + , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is , not $ isInstanceHidden expInfo cls tys ] in cls_insts ++ fam_insts @@ -163,11 +164,6 @@ instFam :: FamInst -> ([Int], Name, [SimpleType], Int, SimpleType) instFam FamInst { fi_fam = n, fi_tys = ts, fi_rhs = t } = (map argCount ts, n, map simplify ts, argCount t, simplify t) --- sortImage f = sortBy (\x y -> compare (f x) (f y)) -sortImage :: Ord b => (a -> b) -> [a] -> [a] -sortImage f xs = map snd $ sortBy cmp_fst [(f x, x) | x <- xs] - where cmp_fst (x,_) (y,_) = compare x y - funTyConName :: Name funTyConName = mkWiredInName gHC_PRIM From git at git.haskell.org Thu Feb 13 23:10:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Feb 2014 23:10:07 +0000 (UTC) Subject: [commit: ghc] master: Fix #5682. Now, '(:) parses. (473f12a) Message-ID: <20140213231008.05B292406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/473f12a3be27a00b035f1fdc7050a0ff31bf12ff/ghc >--------------------------------------------------------------- commit 473f12a3be27a00b035f1fdc7050a0ff31bf12ff Author: Richard Eisenberg Date: Thu Feb 13 13:35:40 2014 -0500 Fix #5682. Now, '(:) parses. >--------------------------------------------------------------- 473f12a3be27a00b035f1fdc7050a0ff31bf12ff compiler/parser/Parser.y.pp | 2 ++ testsuite/tests/parser/should_compile/T5682.hs | 12 ++++++++++++ testsuite/tests/parser/should_compile/all.T | 1 + 3 files changed, 15 insertions(+) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 1715f6c..d2bc463 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -1155,6 +1155,8 @@ atype :: { LHsType RdrName } | SIMPLEQUOTE '(' ')' { LL $ HsTyVar $ getRdrName unitDataCon } | SIMPLEQUOTE '(' ctype ',' comma_types1 ')' { LL $ HsExplicitTupleTy [] ($3 : $5) } | SIMPLEQUOTE '[' comma_types0 ']' { LL $ HsExplicitListTy placeHolderKind $3 } + | SIMPLEQUOTE '(' qconop ')' { LL $ HsTyVar (unLoc $3) } + | SIMPLEQUOTE '(' varop ')' { LL $ HsTyVar (unLoc $3) } | '[' ctype ',' comma_types1 ']' { LL $ HsExplicitListTy placeHolderKind ($2 : $4) } | INTEGER {% mkTyLit $ LL $ HsNumTy $ getINTEGER $1 } | STRING {% mkTyLit $ LL $ HsStrTy $ getSTRING $1 } diff --git a/testsuite/tests/parser/should_compile/T5682.hs b/testsuite/tests/parser/should_compile/T5682.hs new file mode 100644 index 0000000..bfd6752 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T5682.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds, DeriveDataTypeable, StandaloneDeriving, TypeOperators #-} + +module T5682 where + +import Data.Typeable + +data a :+: b = Mk a b +data Foo = Bool :+: Bool + +type X = True ':+: False + +deriving instance Typeable '(:+:) \ No newline at end of file diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T index 1129856..e9cc99e 100644 --- a/testsuite/tests/parser/should_compile/all.T +++ b/testsuite/tests/parser/should_compile/all.T @@ -96,3 +96,4 @@ test('T5243', extra_clean(['T5243A.hi', 'T5243A.o']), multimod_compile, ['T5243','']) test('T7118', normal, compile, ['']) test('T7776', normal, compile, ['']) +test('T5682', normal, compile, ['']) \ No newline at end of file From git at git.haskell.org Thu Feb 13 23:10:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Feb 2014 23:10:10 +0000 (UTC) Subject: [commit: ghc] master: Fix #8773. (1382975) Message-ID: <20140213231010.CD0422406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/138297585f88351352e0ed878b25f26e1d6edfef/ghc >--------------------------------------------------------------- commit 138297585f88351352e0ed878b25f26e1d6edfef Author: Richard Eisenberg Date: Thu Feb 13 14:22:20 2014 -0500 Fix #8773. To make a role annotation on a class asserting a role other than nominal, you now need -XIncoherentInstances. See the ticket for more information as to why this is a good idea. >--------------------------------------------------------------- 138297585f88351352e0ed878b25f26e1d6edfef compiler/typecheck/TcTyClsDecls.lhs | 14 ++++++++++++++ testsuite/tests/roles/should_compile/Roles14.hs | 7 +++++++ testsuite/tests/roles/should_compile/Roles14.stderr | 14 ++++++++++++++ testsuite/tests/roles/should_compile/Roles4.hs | 4 ---- testsuite/tests/roles/should_compile/Roles4.stderr | 6 ------ testsuite/tests/roles/should_compile/all.T | 1 + testsuite/tests/roles/should_fail/T8773.hs | 7 +++++++ testsuite/tests/roles/should_fail/T8773.stderr | 5 +++++ testsuite/tests/roles/should_fail/all.T | 1 + 9 files changed, 49 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 1fbdbb2..0c5ceea 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1694,6 +1694,15 @@ checkValidRoleAnnots role_annots thing ; checkTc (type_vars `equalLength` the_role_annots) (wrongNumberOfRoles type_vars decl) ; _ <- zipWith3M checkRoleAnnot type_vars the_role_annots type_roles + -- Representational or phantom roles for class parameters + -- quickly lead to incoherence. So, we require + -- IncoherentInstances to have them. See #8773. + ; incoherent_roles_ok <- xoptM Opt_IncoherentInstances + ; checkTc ( incoherent_roles_ok + || (not $ isClassTyCon tc) + || (all (== Nominal) type_roles)) + incoherentRoles + ; lint <- goptM Opt_DoCoreLinting ; when lint $ checkValidRoles tc } @@ -2180,6 +2189,11 @@ needXRoleAnnotations tc = ptext (sLit "Illegal role annotation for") <+> ppr tc <> char ';' $$ ptext (sLit "did you intend to use RoleAnnotations?") +incoherentRoles :: SDoc +incoherentRoles = (text "Roles other than" <+> quotes (text "nominal") <+> + text "for class parameters can lead to incoherence.") $$ + (text "Use IncoherentInstances to allow this; bad role found") + addTyThingCtxt :: TyThing -> TcM a -> TcM a addTyThingCtxt thing = addErrCtxt ctxt diff --git a/testsuite/tests/roles/should_compile/Roles14.hs b/testsuite/tests/roles/should_compile/Roles14.hs new file mode 100644 index 0000000..121aad7 --- /dev/null +++ b/testsuite/tests/roles/should_compile/Roles14.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RoleAnnotations, IncoherentInstances #-} + +module Roles12 where + +type role C2 representational +class C2 a where + meth2 :: a -> a diff --git a/testsuite/tests/roles/should_compile/Roles14.stderr b/testsuite/tests/roles/should_compile/Roles14.stderr new file mode 100644 index 0000000..1323193 --- /dev/null +++ b/testsuite/tests/roles/should_compile/Roles14.stderr @@ -0,0 +1,14 @@ +TYPE SIGNATURES +TYPE CONSTRUCTORS + C2 :: * -> Constraint + class C2 a + Roles: [representational] + RecFlag NonRecursive + meth2 :: a -> a +COERCION AXIOMS + axiom Roles12.NTCo:C2 :: C2 a = a -> a +Dependent modules: [] +Dependent packages: [base, ghc-prim, integer-gmp] + +==================== Typechecker ==================== + diff --git a/testsuite/tests/roles/should_compile/Roles4.hs b/testsuite/tests/roles/should_compile/Roles4.hs index b5c404a..d7aa78f 100644 --- a/testsuite/tests/roles/should_compile/Roles4.hs +++ b/testsuite/tests/roles/should_compile/Roles4.hs @@ -6,10 +6,6 @@ type role C1 nominal class C1 a where meth1 :: a -> a -type role C2 representational -class C2 a where - meth2 :: a -> a - type Syn1 a = [a] class C3 a where diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr index e69b852..32862ea 100644 --- a/testsuite/tests/roles/should_compile/Roles4.stderr +++ b/testsuite/tests/roles/should_compile/Roles4.stderr @@ -5,11 +5,6 @@ TYPE CONSTRUCTORS Roles: [nominal] RecFlag NonRecursive meth1 :: a -> a - C2 :: * -> Constraint - class C2 a - Roles: [representational] - RecFlag NonRecursive - meth2 :: a -> a C3 :: * -> Constraint class C3 a Roles: [nominal] @@ -19,7 +14,6 @@ TYPE CONSTRUCTORS type Syn1 a = [a] COERCION AXIOMS axiom Roles4.NTCo:C1 :: C1 a = a -> a - axiom Roles4.NTCo:C2 :: C2 a = a -> a axiom Roles4.NTCo:C3 :: C3 a = a -> Syn1 a Dependent modules: [] Dependent packages: [base, ghc-prim, integer-gmp] diff --git a/testsuite/tests/roles/should_compile/all.T b/testsuite/tests/roles/should_compile/all.T index 266a260..a016de3 100644 --- a/testsuite/tests/roles/should_compile/all.T +++ b/testsuite/tests/roles/should_compile/all.T @@ -3,4 +3,5 @@ test('Roles2', only_ways('normal'), compile, ['-ddump-tc']) test('Roles3', only_ways('normal'), compile, ['-ddump-tc']) 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, ['']) \ No newline at end of file diff --git a/testsuite/tests/roles/should_fail/T8773.hs b/testsuite/tests/roles/should_fail/T8773.hs new file mode 100644 index 0000000..d0984b4 --- /dev/null +++ b/testsuite/tests/roles/should_fail/T8773.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RoleAnnotations #-} + +module T8773 where + +type role C2 representational +class C2 a where + meth2 :: a -> a diff --git a/testsuite/tests/roles/should_fail/T8773.stderr b/testsuite/tests/roles/should_fail/T8773.stderr new file mode 100644 index 0000000..838d587 --- /dev/null +++ b/testsuite/tests/roles/should_fail/T8773.stderr @@ -0,0 +1,5 @@ + +T8773.hs:5:1: + Roles other than ?nominal? for class parameters can lead to incoherence. + Use IncoherentInstances to allow this; bad role found + while checking a role annotation for ?C2? diff --git a/testsuite/tests/roles/should_fail/all.T b/testsuite/tests/roles/should_fail/all.T index 0e30472..d0d5c4d 100644 --- a/testsuite/tests/roles/should_fail/all.T +++ b/testsuite/tests/roles/should_fail/all.T @@ -7,3 +7,4 @@ test('Roles11', normal, compile_fail, ['']) test('Roles12', extra_clean(['Roles12.o-boot', 'Roles12.hi-boot']), run_command, ['$MAKE --no-print-directory -s Roles12']) +test('T8773', normal, compile_fail, ['']) \ No newline at end of file From git at git.haskell.org Thu Feb 13 23:58:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Feb 2014 23:58:46 +0000 (UTC) Subject: [commit: haddock] master: Only warn about missing docs when docs are missing (50d1d18) Message-ID: <20140213235846.E773B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/50d1d18cc70cf6c8ffcf247743cd8af0ff9aae16 >--------------------------------------------------------------- commit 50d1d18cc70cf6c8ffcf247743cd8af0ff9aae16 Author: Mateusz Kowalczyk Date: Thu Feb 13 23:57:16 2014 +0000 Only warn about missing docs when docs are missing This fixes the ?Missing documentation for?? message for modules with 100% coverage. >--------------------------------------------------------------- 50d1d18cc70cf6c8ffcf247743cd8af0ff9aae16 src/Haddock/Interface.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Haddock/Interface.hs b/src/Haddock/Interface.hs index 24d4791..60a20fe 100644 --- a/src/Haddock/Interface.hs +++ b/src/Haddock/Interface.hs @@ -195,7 +195,8 @@ processModule verbosity modsum flags modMap instIfaceMap = do else n out verbosity normal coverageMsg - when (Flag_PrintMissingDocs `elem` flags && (header || not (null undocumentedExports))) $ do + when (Flag_PrintMissingDocs `elem` flags + && not (null undocumentedExports && header)) $ do out verbosity normal " Missing documentation for:" unless header $ out verbosity normal " Module header" mapM_ (out verbosity normal . (" " ++)) undocumentedExports From git at git.haskell.org Fri Feb 14 10:17:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Feb 2014 10:17:03 +0000 (UTC) Subject: [commit: packages/base] master: Improve list fusion for [n::Integer..m] (a60eecc) Message-ID: <20140214101704.044532406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a60eeccf06c28bee3b87c561450320d17c7399e3/base >--------------------------------------------------------------- commit a60eeccf06c28bee3b87c561450320d17c7399e3 Author: Joachim Breitner Date: Fri Feb 14 09:17:22 2014 +0000 Improve list fusion for [n::Integer..m] enumFromTo for Integers goes via enumDeltaToInteger, which is less efficient, as the "delta > = 0" check prevents more inlining which is required for good fusion code. This rule avoids tihs check for the common case of "delta = 1", makes up_fb visible and hence inlineable, which greatly improves "length [n:Integer..m]"; even more so with CallArity enabled. (#8766) >--------------------------------------------------------------- a60eeccf06c28bee3b87c561450320d17c7399e3 GHC/Enum.lhs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/GHC/Enum.lhs b/GHC/Enum.lhs index 332d205..2934c72 100644 --- a/GHC/Enum.lhs +++ b/GHC/Enum.lhs @@ -701,6 +701,13 @@ enumDeltaToIntegerFB c n x delta lim | delta >= 0 = up_fb c n x delta lim | otherwise = dn_fb c n x delta lim +{-# RULES +"enumDeltaToInteger1" [0] forall c n x . enumDeltaToIntegerFB c n x 1 = up_fb c n x 1 + #-} +-- This rule ensures that in the common case (delta = 1), we do not do the check here, +-- and also that we have the chance to inline up_fb, which would allow the constuctor to be +-- inlined and good things to happen. + {-# NOINLINE [1] enumDeltaToInteger #-} enumDeltaToInteger :: Integer -> Integer -> Integer -> [Integer] enumDeltaToInteger x delta lim From git at git.haskell.org Fri Feb 14 10:17:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Feb 2014 10:17:05 +0000 (UTC) Subject: [commit: packages/base] master: Test case for #8374 (d455e2d) Message-ID: <20140214101706.1AACC2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d455e2dfb6d1a7b4b22784f0c49178bd346e15e0/base >--------------------------------------------------------------- commit d455e2dfb6d1a7b4b22784f0c49178bd346e15e0 Author: Joachim Breitner Date: Fri Feb 14 10:17:52 2014 +0000 Test case for #8374 >--------------------------------------------------------------- d455e2dfb6d1a7b4b22784f0c49178bd346e15e0 tests/T8374.hs | 4 ++++ tests/T8374.stdout | 1 + tests/all.T | 9 +++++++++ 3 files changed, 14 insertions(+) diff --git a/tests/T8374.hs b/tests/T8374.hs new file mode 100644 index 0000000..48f2b23 --- /dev/null +++ b/tests/T8374.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO() +main = print $ length [1..(2^(20::Int)::Integer)] diff --git a/tests/T8374.stdout b/tests/T8374.stdout new file mode 100644 index 0000000..6820bf1 --- /dev/null +++ b/tests/T8374.stdout @@ -0,0 +1 @@ +1048576 diff --git a/tests/all.T b/tests/all.T index f722538..0d62dfd 100644 --- a/tests/all.T +++ b/tests/all.T @@ -154,3 +154,12 @@ test('topHandler03', exit_code(143) # actually signal 15 SIGTERM ], compile_and_run, ['']) + +test('T8374', + [ stats_num_field('bytes allocated', (16828144, 5)), + # with GHC-7.6.3: 83937384 (but faster execution than the next line) + # before: 58771216 (without call-arity-analysis) + # expected value: 16828144 (2014-01-14) + only_ways(['normal'])], + compile_and_run, + ['-O']) From git at git.haskell.org Fri Feb 14 10:18:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Feb 2014 10:18:45 +0000 (UTC) Subject: [commit: packages/base] master: Wrong bug number (f28ee96) Message-ID: <20140214101845.D2E182406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f28ee96d7c246f78d5e8cb9c853f417e54ff3d91/base >--------------------------------------------------------------- commit f28ee96d7c246f78d5e8cb9c853f417e54ff3d91 Author: Joachim Breitner Date: Fri Feb 14 10:19:35 2014 +0000 Wrong bug number the previous commit added a testcase for #8766, not #8374 -- too many tabs open. >--------------------------------------------------------------- f28ee96d7c246f78d5e8cb9c853f417e54ff3d91 tests/{T8374.hs => T8766.hs} | 0 tests/{T8374.stdout => T8766.stdout} | 0 tests/all.T | 2 +- 3 files changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/T8374.hs b/tests/T8766.hs similarity index 100% rename from tests/T8374.hs rename to tests/T8766.hs diff --git a/tests/T8374.stdout b/tests/T8766.stdout similarity index 100% rename from tests/T8374.stdout rename to tests/T8766.stdout diff --git a/tests/all.T b/tests/all.T index 0d62dfd..d4a6c05 100644 --- a/tests/all.T +++ b/tests/all.T @@ -155,7 +155,7 @@ test('topHandler03', ], compile_and_run, ['']) -test('T8374', +test('T8766', [ stats_num_field('bytes allocated', (16828144, 5)), # with GHC-7.6.3: 83937384 (but faster execution than the next line) # before: 58771216 (without call-arity-analysis) From git at git.haskell.org Sat Feb 15 21:57:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 15 Feb 2014 21:57:11 +0000 (UTC) Subject: [commit: haddock] master: Add test case for inter-module type/data family instances (6b35adf) Message-ID: <20140215215712.A18392406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/6b35adfb811d9e41e5bfa1c11963e441740c2836 >--------------------------------------------------------------- commit 6b35adfb811d9e41e5bfa1c11963e441740c2836 Author: Niklas Haas Date: Sat Feb 15 08:41:40 2014 +0100 Add test case for inter-module type/data family instances These should show up in every place where the class is visible, and indeed they do right now. Signed-off-by: Mateusz Kowalczyk >--------------------------------------------------------------- 6b35adfb811d9e41e5bfa1c11963e441740c2836 html-test/ref/TypeFamilies.html | 28 +++++++++++++++ html-test/ref/TypeFamilies2.html | 72 ++++++++++++++++++++++++++++++++++++++ html-test/src/TypeFamilies.hs | 8 +++++ html-test/src/TypeFamilies2.hs | 5 ++- 4 files changed, 112 insertions(+), 1 deletion(-) diff --git a/html-test/ref/TypeFamilies.html b/html-test/ref/TypeFamilies.html index 6584510..53a8b9d 100644 --- a/html-test/ref/TypeFamilies.html +++ b/html-test/ref/TypeFamilies.html @@ -235,6 +235,22 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");}; >type Foo X = Y

External instance

data Batdata Bar Y data Bat data Bar X = BarX Y type Foo type Foo X = Y

External instance

data family Bar a

Instances

data Bar X = BarX Y 
data Bar Y 
XX = 'X class (><) (a :: k) (b :: k) instance XX >< XXX + +-- | External instance + +type instance TF.Foo X = Y + +data instance TF.Bar Y diff --git a/html-test/src/TypeFamilies2.hs b/html-test/src/TypeFamilies2.hs index 718e11d..093f77c 100644 --- a/html-test/src/TypeFamilies2.hs +++ b/html-test/src/TypeFamilies2.hs @@ -3,10 +3,13 @@ -- in type instances. The expected behaviour is -- that we get the instance, Y is not linked and -- Haddock shows a linking warning. -module TypeFamilies2 (X, Foo) where +module TypeFamilies2 (X, Foo, Bar) where data X data Y type family Foo a type instance Foo X = Y + +data family Bar a +data instance Bar X = BarX Y From git at git.haskell.org Mon Feb 17 07:48:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 07:48:41 +0000 (UTC) Subject: [commit: ghc] master: rts/package.conf.in: fix UNREG on --with-system-libffi when include-dir is passed explicitely (2d0fa9a) Message-ID: <20140217074841.E841C2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2d0fa9aee78e5bfffb9a4580954825025a651be5/ghc >--------------------------------------------------------------- commit 2d0fa9aee78e5bfffb9a4580954825025a651be5 Author: Sergei Trofimovich Date: Thu Feb 13 07:29:14 2014 -0600 rts/package.conf.in: fix UNREG on --with-system-libffi when include-dir is passed explicitely Issue #8748 Signed-off-by: Sergei Trofimovich Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2d0fa9aee78e5bfffb9a4580954825025a651be5 rts/package.conf.in | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/package.conf.in b/rts/package.conf.in index 010305f..4c8686f 100644 --- a/rts/package.conf.in +++ b/rts/package.conf.in @@ -57,9 +57,9 @@ extra-libraries: #endif #ifdef INSTALLING -include-dirs: INCLUDE_DIR PAPI_INCLUDE_DIR +include-dirs: INCLUDE_DIR PAPI_INCLUDE_DIR FFI_INCLUDE_DIR #else /* !INSTALLING */ -include-dirs: TOP"/rts/dist/build" TOP"/includes" TOP"/includes/dist-derivedconstants/header" +include-dirs: TOP"/rts/dist/build" TOP"/includes" TOP"/includes/dist-derivedconstants/header" FFI_INCLUDE_DIR #endif includes: Stg.h From git at git.haskell.org Mon Feb 17 07:48:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 07:48:44 +0000 (UTC) Subject: [commit: ghc] master: Fix --enable-unregistered by declaring missing RTS functions (#8748) (4bb50ed) Message-ID: <20140217074844.5C7BB2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4bb50ed0c6246e2d45e22e79f5658db1fa8a58b3/ghc >--------------------------------------------------------------- commit 4bb50ed0c6246e2d45e22e79f5658db1fa8a58b3 Author: Sergei Trofimovich Date: Thu Feb 13 07:23:48 2014 -0600 Fix --enable-unregistered by declaring missing RTS functions (#8748) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 4bb50ed0c6246e2d45e22e79f5658db1fa8a58b3 includes/stg/MiscClosures.h | 2 ++ 1 file changed, 2 insertions(+) diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index f8c8f0d..ff781dd 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -465,6 +465,8 @@ extern StgWord RTS_VAR(CCS_LIST); /* registered CCS list */ extern StgWord CCS_SYSTEM[]; extern unsigned int RTS_VAR(CC_ID); /* global ids */ extern unsigned int RTS_VAR(CCS_ID); +RTS_FUN_DECL(enterFunCCS); +RTS_FUN_DECL(pushCostCentre); // Capability.c extern unsigned int n_capabilities; From git at git.haskell.org Mon Feb 17 07:48:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 07:48:47 +0000 (UTC) Subject: [commit: ghc] master: mk/config.mk.in: lower -O2 optimization down to -O1 on UNREG (2d5372c) Message-ID: <20140217074847.20A9D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2d5372cfdc2236a77ec49df249f3379b93224e06/ghc >--------------------------------------------------------------- commit 2d5372cfdc2236a77ec49df249f3379b93224e06 Author: Sergei Trofimovich Date: Thu Feb 13 07:29:50 2014 -0600 mk/config.mk.in: lower -O2 optimization down to -O1 on UNREG Disable -O2 optimization. Otherwise amount of generated C code makes things very slow to compile (~5 minutes on core-i7 for 'compiler/hsSyn/HsExpr.lhs') And sometimes not compile at all (powerpc64 overflows something on 'compiler/hsSyn/HsExpr.lhs'). Issue #8748 Signed-off-by: Sergei Trofimovich Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2d5372cfdc2236a77ec49df249f3379b93224e06 mk/config.mk.in | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/mk/config.mk.in b/mk/config.mk.in index b3d6995..6207cce 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -422,6 +422,16 @@ BIN_DIST_TAR_BZ2 = $(BIN_DIST_NAME)-$(TARGETPLATFORM).tar.bz2 # SRC_HC_OPTS += -H32m -O +# Disable -O2 optimization. Otherwise amount of generated C code +# makes things very slow to compile (~5 minutes on core-i7 for 'compiler/hsSyn/HsExpr.lhs') +# and sometimes not compile at all (powerpc64 overflows something +# on 'compiler/hsSyn/HsExpr.lhs'). +ifeq "$(GhcUnregisterised)" "YES" +GhcStage1HcOpts= +GhcStage2HcOpts= +GhcStage3HcOpts= +endif + # ----------------------------------------------------------------------------- # Names of programs in the GHC tree From git at git.haskell.org Mon Feb 17 07:48:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 07:48:52 +0000 (UTC) Subject: [commit: ghc] master: Fix --enable-unregistered by passing NOSMP to .hc compiler (#8748) (68f0a6a) Message-ID: <20140217074852.63C2E2406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/68f0a6a6cd5bf3374fbc4a4fb09df4cbda97b61c/ghc >--------------------------------------------------------------- commit 68f0a6a6cd5bf3374fbc4a4fb09df4cbda97b61c Author: Sergei Trofimovich Date: Thu Feb 13 07:23:02 2014 -0600 Fix --enable-unregistered by passing NOSMP to .hc compiler (#8748) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 68f0a6a6cd5bf3374fbc4a4fb09df4cbda97b61c compiler/ghc.mk | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/ghc.mk b/compiler/ghc.mk index 0a18713..4977e28 100644 --- a/compiler/ghc.mk +++ b/compiler/ghc.mk @@ -353,6 +353,11 @@ else compiler_CONFIGURE_OPTS += --ghc-option=-DNO_REGS endif +ifneq "$(GhcWithSMP)" "YES" +compiler_CONFIGURE_OPTS += --ghc-option=-DNOSMP +compiler_CONFIGURE_OPTS += --ghc-option=-optc-DNOSMP +endif + # Careful optimisation of the parser: we don't want to throw everything # at it, because that takes too long and doesn't buy much, but we do want # to inline certain key external functions, so we instruct GHC not to From git at git.haskell.org Mon Feb 17 07:48:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 07:48:54 +0000 (UTC) Subject: [commit: ghc] master: rts/Capability.c: fix crash in -threaded mode on UNREG build (ebace69) Message-ID: <20140217074854.D24572406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ebace6969f0ec85b1caa0fea265a5f9990a23b2e/ghc >--------------------------------------------------------------- commit ebace6969f0ec85b1caa0fea265a5f9990a23b2e Author: Sergei Trofimovich Date: Thu Feb 13 07:26:05 2014 -0600 rts/Capability.c: fix crash in -threaded mode on UNREG build UNREG mode has quite nasty invariant to maintain: capabilities[0] == &MainCapability and it's a non-heap memory, while other capabilities are dynamically allocated. Issue #8748 Signed-off-by: Sergei Trofimovich Signed-off-by: Austin Seipp >--------------------------------------------------------------- ebace6969f0ec85b1caa0fea265a5f9990a23b2e rts/Capability.c | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/rts/Capability.c b/rts/Capability.c index 5988d42..16b71b7 100644 --- a/rts/Capability.c +++ b/rts/Capability.c @@ -357,15 +357,18 @@ moreCapabilities (nat from USED_IF_THREADS, nat to USED_IF_THREADS) // BaseReg (eg. unregisterised), so in this case // capabilities[0] must coincide with &MainCapability. capabilities[0] = &MainCapability; + initCapability(&MainCapability, 0); } - - for (i = 0; i < to; i++) { - if (i < from) { - capabilities[i] = old_capabilities[i]; - } else { - capabilities[i] = stgMallocBytes(sizeof(Capability), - "moreCapabilities"); - initCapability(capabilities[i], i); + else + { + for (i = 0; i < to; i++) { + if (i < from) { + capabilities[i] = old_capabilities[i]; + } else { + capabilities[i] = stgMallocBytes(sizeof(Capability), + "moreCapabilities"); + initCapability(capabilities[i], i); + } } } @@ -983,7 +986,8 @@ freeCapabilities (void) nat i; for (i=0; i < n_capabilities; i++) { freeCapability(capabilities[i]); - stgFree(capabilities[i]); + if (capabilities[i] != &MainCapability) + stgFree(capabilities[i]); } #else freeCapability(&MainCapability); From git at git.haskell.org Mon Feb 17 07:48:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 07:48:49 +0000 (UTC) Subject: [commit: ghc] master: includes/Stg.h: add declarations for hs_popcnt and frinds (858a807) Message-ID: <20140217074849.DC8542406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/858a807d5522145e8ede9148a15bb65a0d851c00/ghc >--------------------------------------------------------------- commit 858a807d5522145e8ede9148a15bb65a0d851c00 Author: Sergei Trofimovich Date: Thu Feb 13 07:27:46 2014 -0600 includes/Stg.h: add declarations for hs_popcnt and frinds This fixes most of implicit function declarations emitted C codegen in UNREG mode. Found by adding the following to mk/build.mk: SRC_CC_OPTS += -Werror=implicit-function-declaration SRC_HC_OPTS += -optc-Werror=implicit-function-declaration Issue #8748 Signed-off-by: Sergei Trofimovich Signed-off-by: Austin Seipp >--------------------------------------------------------------- 858a807d5522145e8ede9148a15bb65a0d851c00 includes/Stg.h | 1 + includes/stg/Prim.h | 39 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+) diff --git a/includes/Stg.h b/includes/Stg.h index 09de8d4..be966aa 100644 --- a/includes/Stg.h +++ b/includes/Stg.h @@ -240,6 +240,7 @@ typedef StgFunPtr F_; #include "stg/MiscClosures.h" #endif +#include "stg/Prim.h" /* ghc-prim fallbacks */ #include "stg/SMP.h" // write_barrier() inline is required /* ----------------------------------------------------------------------------- diff --git a/includes/stg/Prim.h b/includes/stg/Prim.h new file mode 100644 index 0000000..2b23c3d --- /dev/null +++ b/includes/stg/Prim.h @@ -0,0 +1,39 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 2014-2014 + * + * Declarations for C fallback primitives implemented by 'ghc-prim' package. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes + * + * -------------------------------------------------------------------------- */ + +#ifndef PRIM_H +#define PRIM_H + +/* libraries/ghc-prim/cbits/bswap.c */ +StgWord16 hs_bswap16(StgWord16 x); +StgWord32 hs_bswap32(StgWord32 x); +StgWord64 hs_bswap64(StgWord64 x); + +/* TODO: longlong.c */ + +/* libraries/ghc-prim/cbits/popcnt.c */ +StgWord hs_popcnt8(StgWord8 x); +StgWord hs_popcnt16(StgWord16 x); +StgWord hs_popcnt32(StgWord32 x); +StgWord hs_popcnt64(StgWord64 x); +#ifdef i386_HOST_ARCH +StgWord hs_popcnt(StgWord32 x); +#else +StgWord hs_popcnt(StgWord64 x); +#endif + +/* libraries/ghc-prim/cbits/word2float.c */ +StgFloat hs_word2float32(StgWord x); +StgDouble hs_word2float64(StgWord x); + +#endif /* PRIM_H */ From git at git.haskell.org Mon Feb 17 07:48:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 07:48:57 +0000 (UTC) Subject: [commit: ghc] master: Fix installation of hpc (#8735) (a365eab) Message-ID: <20140217074858.C893E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a365eabd465a1700f479f78ad99fc1a31915e639/ghc >--------------------------------------------------------------- commit a365eabd465a1700f479f78ad99fc1a31915e639 Author: Austin Seipp Date: Thu Feb 13 07:19:39 2014 -0600 Fix installation of hpc (#8735) Signed-off-by: Austin Seipp >--------------------------------------------------------------- a365eabd465a1700f479f78ad99fc1a31915e639 utils/hpc/ghc.mk | 3 +++ utils/hpc/hpc.wrapper | 2 ++ 2 files changed, 5 insertions(+) diff --git a/utils/hpc/ghc.mk b/utils/hpc/ghc.mk index 7280729..f70be94 100644 --- a/utils/hpc/ghc.mk +++ b/utils/hpc/ghc.mk @@ -15,4 +15,7 @@ utils/hpc_PACKAGE = hpc-bin utils/hpc_dist-install_INSTALL = YES utils/hpc_dist-install_INSTALL_INPLACE = YES utils/hpc_dist-install_PROGNAME = hpc +utils/hpc_dist-install_SHELL_WRAPPER = YES +utils/hpc_dist-install_INSTALL_SHELL_WRAPPER_NAME = hpc + $(eval $(call build-prog,utils/hpc,dist-install,1)) diff --git a/utils/hpc/hpc.wrapper b/utils/hpc/hpc.wrapper new file mode 100644 index 0000000..22982ef --- /dev/null +++ b/utils/hpc/hpc.wrapper @@ -0,0 +1,2 @@ +#!/bin/sh +exec "$executablename" ${1+"$@"} From git at git.haskell.org Mon Feb 17 07:48:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 07:48:59 +0000 (UTC) Subject: [commit: ghc] master: Fix #8745 - GND is now -XSafe compatible. (a8a01e7) Message-ID: <20140217074900.16FD72406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a8a01e742434df11b830ab99af12d9045dfcbc4b/ghc >--------------------------------------------------------------- commit a8a01e742434df11b830ab99af12d9045dfcbc4b Author: Austin Seipp Date: Sun Feb 16 19:14:36 2014 -0600 Fix #8745 - GND is now -XSafe compatible. As discussed in the ticket, after the landing of #8773, GND is now -XSafe compatible. This fixes the test fallout as well. In particular SafeLang07 was removed following in the steps of SafeLang06, since it no longer failed from GND, but failed due to roles and was thus invalid. The other tests were tweaked to use TemplateHaskell instead of GND in order to trigger safety warnings. Signed-off-by: Austin Seipp >--------------------------------------------------------------- a8a01e742434df11b830ab99af12d9045dfcbc4b compiler/main/DynFlags.hs | 5 +-- testsuite/tests/safeHaskell/ghci/p1.stderr | 3 -- testsuite/tests/safeHaskell/ghci/p16.stderr | 15 ------- testsuite/tests/safeHaskell/ghci/p16.stdout | 1 + .../safeHaskell/safeInfered/UnsafeInfered03_A.hs | 2 +- .../tests/safeHaskell/safeLanguage/SafeLang02.hs | 2 +- .../safeHaskell/safeLanguage/SafeLang02.stderr | 2 +- .../tests/safeHaskell/safeLanguage/SafeLang07.hs | 41 -------------------- .../safeHaskell/safeLanguage/SafeLang07.stderr | 7 ---- .../tests/safeHaskell/safeLanguage/SafeLang07_A.hs | 24 ------------ testsuite/tests/safeHaskell/safeLanguage/all.T | 7 ++-- 11 files changed, 8 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 a8a01e742434df11b830ab99af12d9045dfcbc4b From git at git.haskell.org Mon Feb 17 07:49:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 07:49:02 +0000 (UTC) Subject: [commit: ghc] master: Fix #8754 in a round-about way. (5023c91) Message-ID: <20140217074903.2958C2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5023c91780e90947680fe0640f7564a4f6448bea/ghc >--------------------------------------------------------------- commit 5023c91780e90947680fe0640f7564a4f6448bea Author: Austin Seipp Date: Sun Feb 16 19:10:16 2014 -0600 Fix #8754 in a round-about way. For some reason on OS X, it seems like -Bsymbolic (which we use for hooks into the RTS) isn't working, which results in #8754, where stats don't work because defaultHooks doesn't initialize the stats flag. This seems to work on Linux static/dynamically, but only on OS X statically. After talking with Simon, really, the entire hooks thing is a bit fragile. For now, we just work around it (since GHCi is dynamically linked) by calling into the defaultHooks ourselves when GHC starts. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 5023c91780e90947680fe0640f7564a4f6448bea ghc/Main.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ghc/Main.hs b/ghc/Main.hs index 868042b..1aa6553 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -1,4 +1,5 @@ {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} +{-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- @@ -76,6 +77,7 @@ import Data.Maybe main :: IO () main = do + defaultsHook hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do @@ -818,3 +820,5 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs (case fuzzyMatch f (nub allFlags) of [] -> "" suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) + +foreign import ccall safe "defaultsHook" defaultsHook :: IO () From git at git.haskell.org Mon Feb 17 07:49:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 07:49:05 +0000 (UTC) Subject: [commit: ghc] master: Fix check for TLS support in Storage.c (c83eabf) Message-ID: <20140217074905.8E5962406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c83eabf37b884398d911609e46707df771c3fde9/ghc >--------------------------------------------------------------- commit c83eabf37b884398d911609e46707df771c3fde9 Author: Austin Seipp Date: Sun Feb 16 18:49:43 2014 -0600 Fix check for TLS support in Storage.c This should have manifested earlier, but for some reason it only seemed to trigger on Mavericks. Signed-off-by: Austin Seipp >--------------------------------------------------------------- c83eabf37b884398d911609e46707df771c3fde9 rts/sm/Storage.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index c7126fe..df5f4b3 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -237,7 +237,7 @@ void storageAddCapabilities (nat from, nat to) } } -#if defined(THREADED_RTS) && defined(llvm_CC_FLAVOR) +#if defined(THREADED_RTS) && defined(llvm_CC_FLAVOR) && (CC_SUPPORTS_TLS == 0) newThreadLocalKey(&gctKey); #endif @@ -261,7 +261,7 @@ freeStorage (rtsBool free_heap) closeMutex(&sm_mutex); #endif stgFree(nurseries); -#if defined(THREADED_RTS) && defined(llvm_CC_FLAVOR) +#if defined(THREADED_RTS) && defined(llvm_CC_FLAVOR) && (CC_SUPPORTS_TLS == 0) freeThreadLocalKey(&gctKey); #endif freeGcThreads(); From git at git.haskell.org Mon Feb 17 07:49:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 07:49:08 +0000 (UTC) Subject: [commit: ghc] master: Fix #8770 (dc08091) Message-ID: <20140217074908.C12A92406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dc080915597065087b3821b3ded0a621a7e2fae7/ghc >--------------------------------------------------------------- commit dc080915597065087b3821b3ded0a621a7e2fae7 Author: Austin Seipp Date: Thu Feb 13 07:17:30 2014 -0600 Fix #8770 As usual, Mac OS X is extremely annoying (or the software is, anyway), because not only does it load dynamic libraries with the .dylib extension, but also the .so extension. For whatever reason. At least it's easy to fix. Signed-off-by: Austin Seipp >--------------------------------------------------------------- dc080915597065087b3821b3ded0a621a7e2fae7 compiler/ghci/Linker.lhs | 11 ++++++++++- compiler/main/DriverPhases.hs | 10 +++++----- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index eb3e226..274f2fb 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -378,7 +378,16 @@ preloadLib dflags lib_paths framework_paths lib_spec -> do maybe_errstr <- loadDLL (mkSOName platform dll_unadorned) case maybe_errstr of Nothing -> maybePutStrLn dflags "done" - Just mm -> preloadFailed mm lib_paths lib_spec + Just mm | platformOS platform /= OSDarwin -> + preloadFailed mm lib_paths lib_spec + Just mm | otherwise -> do + -- As a backup, on Darwin, try to also load a .so file + -- since (apparently) some things install that way - see + -- ticket #8770. + err2 <- loadDLL $ ("lib" ++ dll_unadorned) <.> "so" + case err2 of + Nothing -> maybePutStrLn dflags "done" + Just _ -> preloadFailed mm lib_paths lib_spec DLLPath dll_path -> do maybe_errstr <- loadDLL dll_path diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs index 2de19b9..c406f6a 100644 --- a/compiler/main/DriverPhases.hs +++ b/compiler/main/DriverPhases.hs @@ -240,14 +240,14 @@ objish_suffixes :: Platform -> [String] -- Use the appropriate suffix for the system on which -- the GHC-compiled code will run objish_suffixes platform = case platformOS platform of - OSMinGW32 -> [ "o", "O", "obj", "OBJ" ] - _ -> [ "o" ] + OSMinGW32 -> [ "o", "O", "obj", "OBJ" ] + _ -> [ "o" ] dynlib_suffixes :: Platform -> [String] dynlib_suffixes platform = case platformOS platform of - OSMinGW32 -> ["dll", "DLL"] - OSDarwin -> ["dylib"] - _ -> ["so"] + OSMinGW32 -> ["dll", "DLL"] + OSDarwin -> ["dylib", "so"] + _ -> ["so"] isHaskellishSuffix, isHaskellSrcSuffix, isCishSuffix, isExtCoreSuffix, isHaskellUserSrcSuffix From git at git.haskell.org Mon Feb 17 09:14:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:14:31 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Final fix to #7134 (and #8717 as well.) (86ffdef) Message-ID: <20140217091432.7F1DF2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/86ffdef3db704f6963fb34940199b1a1d2281637/ghc >--------------------------------------------------------------- commit 86ffdef3db704f6963fb34940199b1a1d2281637 Author: Kyrill Briantsev Date: Tue Feb 4 05:00:33 2014 -0600 Final fix to #7134 (and #8717 as well.) Signed-off-by: Austin Seipp (cherry picked from commit 2b33f6e8045fcd00f19883bb5e8895cbaf1bf81e) >--------------------------------------------------------------- 86ffdef3db704f6963fb34940199b1a1d2281637 rts/Linker.c | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/rts/Linker.c b/rts/Linker.c index 9bb377c..b9c8fd0 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -3491,8 +3491,8 @@ allocateImageAndTrampolines ( /* For 32-bit case we don't need this, hence we use macro PEi386_IMAGE_OFFSET, which equals to 4 for 64-bit case and 0 for 32-bit case. */ /* We allocate trampolines area for all symbols right behind - image data, aligned on 16. */ - size = ((PEi386_IMAGE_OFFSET + size + 0xf) & ~0xf) + image data, aligned on 8. */ + size = ((PEi386_IMAGE_OFFSET + size + 0x7) & ~0x7) + hdr.NumberOfSymbols * sizeof(SymbolExtra); #endif image = VirtualAlloc(NULL, size, @@ -4147,7 +4147,7 @@ static int ocAllocateSymbolExtras_PEi386 ( ObjectCode* oc ) { oc->symbol_extras = (SymbolExtra*)(oc->image - PEi386_IMAGE_OFFSET - + ((PEi386_IMAGE_OFFSET + oc->fileSize + 0xf) & ~0xf)); + + ((PEi386_IMAGE_OFFSET + oc->fileSize + 0x7) & ~0x7)); oc->first_symbol_extra = 0; oc->n_symbol_extras = ((COFF_header*)oc->image)->NumberOfSymbols; @@ -4161,7 +4161,7 @@ makeSymbolExtra_PEi386( ObjectCode* oc, size_t s, char* symbol ) SymbolExtra *extra; curr_thunk = oc->first_symbol_extra; - if (curr_thunk > oc->n_symbol_extras) { + if (curr_thunk >= oc->n_symbol_extras) { barf("Can't allocate thunk for %s", symbol); } @@ -4172,14 +4172,6 @@ makeSymbolExtra_PEi386( ObjectCode* oc, size_t s, char* symbol ) extra->addr = (uint64_t)s; memcpy(extra->jumpIsland, jmp, 6); - /* DLL-imported symbols are inserted here. - Others are inserted in ocGetNames_PEi386. - */ - if(lookupStrHashTable(symhash, symbol) == NULL) { - ghciInsertSymbolTable(oc->fileName, symhash, symbol, extra->jumpIsland, - HS_BOOL_FALSE, oc); - } - oc->first_symbol_extra++; return (size_t)extra->jumpIsland; From git at git.haskell.org Mon Feb 17 09:14:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:14:33 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Add test-case for #8726 (6c349a4) Message-ID: <20140217091433.BB8282406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/6c349a4c72a7795a982f3fd68364f21ae7972645/ghc >--------------------------------------------------------------- commit 6c349a4c72a7795a982f3fd68364f21ae7972645 Author: Herbert Valerio Riedel Date: Sun Feb 2 12:08:06 2014 +0100 Add test-case for #8726 This tests various properties expected to hold for quotRem, divMod, div, mod, quot, and rem. Signed-off-by: Herbert Valerio Riedel (cherry picked from commit 5f64b2c6e8f1799d7015098598f7d6e826707e6c) >--------------------------------------------------------------- 6c349a4c72a7795a982f3fd68364f21ae7972645 testsuite/tests/numeric/should_run/T8726.hs | 85 +++++++++++++++++++++++++++ testsuite/tests/numeric/should_run/all.T | 1 + 2 files changed, 86 insertions(+) diff --git a/testsuite/tests/numeric/should_run/T8726.hs b/testsuite/tests/numeric/should_run/T8726.hs new file mode 100644 index 0000000..ba5803a --- /dev/null +++ b/testsuite/tests/numeric/should_run/T8726.hs @@ -0,0 +1,85 @@ +import Control.Monad +import Data.Bits +import Data.List +import Data.Ord + +-- | test-values to use as numerator/denominator +posvals :: [Integer] +posvals = [1,2,3,4,5,9,10,14,15,16,17] ++ + [ n | e <- ([5..70]++[96,128,160,192,224]) + , ofs <- [-1..1], let n = bit e + ofs ] + +posvalsSum :: Integer +posvalsSum = 0x300000003000000030000000300000003000001800000000000000000 + +vals :: [Integer] +vals = sortBy (comparing abs) $ map negate posvals ++ [0] ++ posvals + + +main :: IO () +main = do + unless (sum posvals == posvalsSum) $ + fail $ "sum posvals == " ++ show (sum posvals) + + forM_ [ (n,d) | n <- vals, d <- vals, d /= 0 ] $ \(n,d) -> do + let check sp p = unless (p n d) $ fail (sp ++ " " ++ show n ++ " " ++ show d) + + check "rem0" prop_rem0 + check "mod0" prop_mod0 + + check "divMod0" prop_divMod0 + check "divMod1" prop_divMod1 + check "divMod2" prop_divMod2 + + check "quotRem0" prop_quotRem0 + check "quotRem1" prop_quotRem1 + check "quotRem2" prop_quotRem2 + + -- putStrLn "passed" + +-- QuickCheck style properties + +prop_rem0 :: Integer -> Integer -> Bool +prop_rem0 n d + | n >= 0 = (n `rem` d) `inside` (-1,abs d) + | otherwise = (n `rem` d) `inside` (-(abs d),1) + where + inside v (l,u) = l < v && v < u + +prop_mod0 :: Integer -> Integer -> Bool +prop_mod0 n d + | d >= 0 = (n `mod` d) `inside` (-1,d) + | otherwise = (n `mod` d) `inside` (d,1) + where + inside v (l,u) = l < v && v < u + +-- | Invariant from Haskell Report +prop_divMod0 :: Integer -> Integer -> Bool +prop_divMod0 n d = (n `div` d) * d + (n `mod` d) == n + +prop_divMod1 :: Integer -> Integer -> Bool +prop_divMod1 n d = divMod n d == (n `div` d, n `mod` d) + +-- | Compare IUT to implementation of 'divMod' in terms of 'quotRem' +prop_divMod2 :: Integer -> Integer -> Bool +prop_divMod2 n d = divMod n d == divMod' n d + where + divMod' x y = if signum r == negate (signum y) then (q-1, r+y) else qr + where qr@(q,r) = quotRem x y + +-- | Invariant from Haskell Report +prop_quotRem0 :: Integer -> Integer -> Bool +prop_quotRem0 n d = (n `quot` d) * d + (n `rem` d) == n + +prop_quotRem1 :: Integer -> Integer -> Bool +prop_quotRem1 n d = quotRem n d == (n `quot` d, n `rem` d) + +-- | Test symmetry properties of 'quotRem' +prop_quotRem2 :: Integer -> Integer -> Bool +prop_quotRem2 n d = (qr == negQ (quotRem n (-d)) && + qr == negR (quotRem (-n) (-d)) && + qr == (negQ . negR) (quotRem (-n) d)) + where + qr = quotRem n d + negQ (q,r) = (-q,r) + negR (q,r) = (q,-r) diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index 8f658de..3953fe6 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -61,3 +61,4 @@ test('T7014', test('T7233', normal, compile_and_run, ['']) test('NumDecimals', normal, compile_and_run, ['']) +test('T8726', normal, compile_and_run, ['']) From git at git.haskell.org Mon Feb 17 09:14:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:14:36 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Tweak holes documentation (93cf514) Message-ID: <20140217091436.394EE2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/93cf5149cc296ab245a2b035a7e823f879713c59/ghc >--------------------------------------------------------------- commit 93cf5149cc296ab245a2b035a7e823f879713c59 Author: Krzysztof Gogolewski Date: Tue Feb 4 23:42:00 2014 +0100 Tweak holes documentation type holes -> typed holes, reorder, minor changes Signed-off-by: Austin Seipp (cherry picked from commit 2f6d36f64730f044bb038e2d3da2b97ee571d763) >--------------------------------------------------------------- 93cf5149cc296ab245a2b035a7e823f879713c59 docs/users_guide/glasgow_exts.xml | 28 +++++++++++++--------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 60f8acf..a3913cc 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -7978,17 +7978,7 @@ with but type inference becomes less predica , which is enabled by default. -The goal of the typed holes warning is not to change the type system, but to help with writing Haskell -code. Type holes can be used to obtain extra information from the type checker, which might otherwise be hard -to get. -Normally, the type checker is used to decide if a module is well typed or not. Using GHCi, -users can inspect the (inferred) type signatures of all top-level bindings. However, determining the -type of a single term is still hard. Yet while writing code, it could be helpful to know the type of -the term you're about to write. - - - -This extension allows special placeholders, written with a leading underscore (e.g. "_", +This option allows special placeholders, written with a leading underscore (e.g. "_", "_foo", "_bar"), to be used as an expression. During compilation these holes will generate an error message describing what type is expected there, information about the origin of any free type variables, and a list of local bindings @@ -7996,6 +7986,15 @@ that might help fill the hole with actual code. +The goal of the typed holes warning is not to change the type system, but to help with writing Haskell +code. Typed holes can be used to obtain extra information from the type checker, which might otherwise be hard +to get. +Normally, using GHCi, users can inspect the (inferred) type signatures of all top-level bindings. +However, this method is less convenient with terms which are not defined on top-level or +inside complex expressions. Holes allow to check the type of the term you're about to write. + + + Holes work together well with deferring type errors to runtime: with -fdefer-type-errors, the error from a hole is also deferred, effctively making the hole typecheck just like undefined, but with the added benefit that it will show its warning message @@ -8023,15 +8022,15 @@ hole.hs:2:7: -Multiple type holes can be used to find common type variables between expressions. For example: +Multiple typed holes can be used to find common type variables between expressions. For example: sum :: [Int] -> Int -sum xx = foldr _f _z xs +sum xs = foldr _f _z xs Shows: holes.hs:2:15: - Found hole `_f' with type: Int-> Int -> Int + Found hole `_f' with type: Int -> Int -> Int In the first argument of `foldr', namely `_' In the expression: foldr _a _b _c In an equation for `sum': sum x = foldr _a _b _c @@ -8070,7 +8069,6 @@ unbound.hs:1:13: In the second argument of `(:)', namely `_x' In the expression: _x : _x In an equation for `cons': cons = _x : _x -Failed, modules loaded: none. This ensures that an unbound identifier is never reported with a too polymorphic type, like forall a. a, when used multiple times for types that can not be unified. From git at git.haskell.org Mon Feb 17 09:14:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:14:38 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix #8698 by properly handling long section names and reenabling .ctors handling (5541c0a) Message-ID: <20140217091438.AF3C22406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/5541c0a1101d80ea4f53bb034ecf10e494cffbec/ghc >--------------------------------------------------------------- commit 5541c0a1101d80ea4f53bb034ecf10e494cffbec Author: Edward Z. Yang Date: Tue Feb 4 15:59:55 2014 -0800 Fix #8698 by properly handling long section names and reenabling .ctors handling Our old function for searching for sections could only deal with section names that were eight bytes or shorter; this patch adds support for long section names. Signed-off-by: Edward Z. Yang (cherry picked from commit 40ce20357fb6266471a53cec7de0a810a3070f36) >--------------------------------------------------------------- 5541c0a1101d80ea4f53bb034ecf10e494cffbec rts/Linker.c | 59 +++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 36 insertions(+), 23 deletions(-) diff --git a/rts/Linker.c b/rts/Linker.c index b9c8fd0..8f57873 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -211,9 +211,7 @@ static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc ); static int ocVerifyImage_PEi386 ( ObjectCode* oc ); static int ocGetNames_PEi386 ( ObjectCode* oc ); static int ocResolve_PEi386 ( ObjectCode* oc ); -#if !defined(x86_64_HOST_ARCH) static int ocRunInit_PEi386 ( ObjectCode* oc ); -#endif static void *lookupSymbolInDLLs ( unsigned char *lbl ); static void zapTrailingAtSign ( unsigned char *sym ); static char *allocateImageAndTrampolines ( @@ -2875,10 +2873,7 @@ resolveObjs( void ) #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) -#if !defined(x86_64_HOST_ARCH) - /* It does not work on x86_64 yet. #8698. */ r = ocRunInit_PEi386 ( oc ); -#endif #elif defined(OBJFORMAT_MACHO) r = ocRunInit_MachO ( oc ); #else @@ -3608,9 +3603,10 @@ cstring_from_section_name (UChar* name, UChar* strtab) /* Just compares the short names (first 8 chars) */ static COFF_section * -findPEi386SectionCalled ( ObjectCode* oc, UChar* name ) +findPEi386SectionCalled ( ObjectCode* oc, UChar* name, UChar* strtab ) { int i; + rtsBool long_name = rtsFalse; COFF_header* hdr = (COFF_header*)(oc->image); COFF_section* sectab @@ -3618,6 +3614,14 @@ findPEi386SectionCalled ( ObjectCode* oc, UChar* name ) ((UChar*)(oc->image)) + sizeof_COFF_header + hdr->SizeOfOptionalHeader ); + // String is longer than 8 bytes, swap in the proper + // (NULL-terminated) version, and make a note that this + // is a long name. + if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) { + UInt32 strtab_offset = * (UInt32*)(name+4); + name = ((UChar*)strtab) + strtab_offset; + long_name = rtsTrue; + } for (i = 0; i < hdr->NumberOfSections; i++) { UChar* n1; UChar* n2; @@ -3626,10 +3630,28 @@ findPEi386SectionCalled ( ObjectCode* oc, UChar* name ) myindex ( sizeof_COFF_section, sectab, i ); n1 = (UChar*) &(section_i->Name); n2 = name; - if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] && - n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] && - n1[6]==n2[6] && n1[7]==n2[7]) - return section_i; + // Long section names are prefixed with a slash, see + // also cstring_from_section_name + if (n1[0] == '/' && long_name) { + // Long name check + // We don't really want to make an assumption that the string + // table indexes are the same, so we'll do a proper check. + int n1_strtab_offset = strtol((char*)n1+1,NULL,10); + n1 = (UChar*) (((char*)strtab) + n1_strtab_offset); + if (0==strcmp((const char*)n1, (const char*)n2)) { + return section_i; + } + } else if (n1[0] != '/' && !long_name) { + // Short name check + if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] && + n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] && + n1[6]==n2[6] && n1[7]==n2[7]) { + return section_i; + } + } else { + // guaranteed to mismatch, because we never attempt to link + // in an executable where the section name may be truncated + } } return NULL; @@ -4235,14 +4257,6 @@ ocResolve_PEi386 ( ObjectCode* oc ) continue; } -#if defined(x86_64_HOST_ARCH) - /* It does not work on x86_64 yet. #8698. */ - if (0 == strcmp(".ctors", (char*)secname)) { - stgFree(secname); - continue; - } -#endif - stgFree(secname); if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) { @@ -4304,9 +4318,11 @@ ocResolve_PEi386 ( ObjectCode* oc ) if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) { COFF_section* section_sym - = findPEi386SectionCalled ( oc, sym->Name ); + = findPEi386SectionCalled ( oc, sym->Name, strtab ); if (!section_sym) { - errorBelch("%" PATH_FMT ": can't find section `%s' in %s", oc->fileName, sym->Name, secname); + errorBelch("%" PATH_FMT ": can't find section named: ", oc->fileName); + printName(sym->Name, strtab); + errorBelch(" in %s", secname); return 0; } S = ((size_t)(oc->image)) @@ -4414,8 +4430,6 @@ ocResolve_PEi386 ( ObjectCode* oc ) return 1; } -/* It does not work on x86_64 yet. #8698. */ -#if !defined(x86_64_HOST_ARCH) static int ocRunInit_PEi386 ( ObjectCode *oc ) { @@ -4458,7 +4472,6 @@ ocRunInit_PEi386 ( ObjectCode *oc ) freeProgEnvv(envc, envv); return 1; } -#endif #endif /* defined(OBJFORMAT_PEi386) */ From git at git.haskell.org Mon Feb 17 09:14:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:14:41 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Mention that MR is off by default in GHCi in documentation (f543e2f) Message-ID: <20140217091441.945052406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/f543e2f88b2d91cf3b90fbf61fab2c7c6bf0541d/ghc >--------------------------------------------------------------- commit f543e2f88b2d91cf3b90fbf61fab2c7c6bf0541d Author: Krzysztof Gogolewski Date: Wed Feb 5 20:40:13 2014 +0100 Mention that MR is off by default in GHCi in documentation (cherry picked from commit 5bda0d08d8fec86433917b65a93836d2372a5b5c) >--------------------------------------------------------------- f543e2f88b2d91cf3b90fbf61fab2c7c6bf0541d 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 a3913cc..1564f38 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -7862,7 +7862,8 @@ scope over the methods defined in the where part. For exampl 4.5.5 of the Haskell Report) can be completely switched off by -. +. Since GHC 7.8.1, it is +switched off by default in GHCi. From git at git.haskell.org Mon Feb 17 09:14:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:14:44 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Tweak documentation of monomorphism restriction (be6d9df) Message-ID: <20140217091444.BB6D52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/be6d9df23794372e9ec83b5526be27d15ed5b10a/ghc >--------------------------------------------------------------- commit be6d9df23794372e9ec83b5526be27d15ed5b10a Author: Krzysztof Gogolewski Date: Thu Feb 6 23:15:50 2014 +0100 Tweak documentation of monomorphism restriction Suggested by Gabor Greif on ghc-devs (cherry picked from commit 41cfc96b55a4a44953fc20aa72ef50789ba6ceab) >--------------------------------------------------------------- be6d9df23794372e9ec83b5526be27d15ed5b10a 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 1564f38..fb3eb48 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -7862,8 +7862,8 @@ scope over the methods defined in the where part. For exampl 4.5.5 of the Haskell Report) can be completely switched off by -. Since GHC 7.8.1, it is -switched off by default in GHCi. +. Since GHC 7.8.1, the monomorphism +restriction is switched off by default in GHCi. From git at git.haskell.org Mon Feb 17 09:14:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:14:47 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix __thread detection (#8722) (744493d) Message-ID: <20140217091447.B120D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/744493db1399e9db02b151fc79066f005f5a7e46/ghc >--------------------------------------------------------------- commit 744493db1399e9db02b151fc79066f005f5a7e46 Author: Peter Trommler Date: Thu Feb 6 22:57:34 2014 -0600 Fix __thread detection (#8722) Signed-off-by: Austin Seipp (cherry picked from commit 298a25bdfd02bb591fde2dd0590bd7af81a91b94) >--------------------------------------------------------------- 744493db1399e9db02b151fc79066f005f5a7e46 configure.ac | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index 70749b1..1c58da0 100644 --- a/configure.ac +++ b/configure.ac @@ -867,11 +867,11 @@ AC_COMPILE_IFELSE( [ AC_LANG_SOURCE([[__thread int tester = 0;]]) ], [ AC_MSG_RESULT(yes) - AC_DEFINE([CC_SUPPORTS_TLS],[0],[Define to 1 if __thread is supported]) + AC_DEFINE([CC_SUPPORTS_TLS],[1],[Define to 1 if __thread is supported]) ], [ AC_MSG_RESULT(no) - AC_DEFINE([CC_SUPPORTS_TLS],[1],[Define to 1 if __thread is supported]) + AC_DEFINE([CC_SUPPORTS_TLS],[0],[Define to 1 if __thread is supported]) ]) From git at git.haskell.org Mon Feb 17 09:14:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:14:50 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Remove ios_HOST check for GCTDecl.h (8ac9e06) Message-ID: <20140217091450.5F3032406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/8ac9e061cb4e4b266f9e2ff4f2cfe3bab85ffd7a/ghc >--------------------------------------------------------------- commit 8ac9e061cb4e4b266f9e2ff4f2cfe3bab85ffd7a Author: Austin Seipp Date: Thu Feb 6 22:58:30 2014 -0600 Remove ios_HOST check for GCTDecl.h Following 298a25bdf and #8722 as Peter mentioned, this probably isn't needed anymore. Signed-off-by: Austin Seipp (cherry picked from commit b4eb630c7480bc56c673a463f274aec18e237e8c) >--------------------------------------------------------------- 8ac9e061cb4e4b266f9e2ff4f2cfe3bab85ffd7a rts/sm/GCTDecl.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/sm/GCTDecl.h b/rts/sm/GCTDecl.h index 2489430..5602cb8 100644 --- a/rts/sm/GCTDecl.h +++ b/rts/sm/GCTDecl.h @@ -57,7 +57,7 @@ extern StgWord8 the_gc_thread[]; Also, the iOS Clang compiler doesn't support __thread either for some bizarre reason, so there's not much we can do about that... */ -#if (defined(llvm_CC_FLAVOR) && (CC_SUPPORTS_TLS == 0)) || defined(ios_HOST_OS) +#if defined(llvm_CC_FLAVOR) && (CC_SUPPORTS_TLS == 0) #define gct ((gc_thread *)(pthread_getspecific(gctKey))) #define SET_GCT(to) (pthread_setspecific(gctKey, to)) #define DECLARE_GCT ThreadLocalKey gctKey; From git at git.haskell.org Mon Feb 17 09:14:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:14:53 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Add test case for #8743 (2920547) Message-ID: <20140217091453.5384B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/29205476afba5e2f72e233ede981055283a52d65/ghc >--------------------------------------------------------------- commit 29205476afba5e2f72e233ede981055283a52d65 Author: Joachim Breitner Date: Fri Feb 7 17:56:18 2014 +0000 Add test case for #8743 which only occurs when the instance being compiled is also present from a .hs-boot file. (cherry picked from commit c3ff5f29c80680a09c7779aee2535fa64b880cd9) >--------------------------------------------------------------- 29205476afba5e2f72e233ede981055283a52d65 testsuite/tests/stranal/should_compile/T8743.hs | 11 +++++++++++ testsuite/tests/stranal/should_compile/T8743.hs-boot | 3 +++ testsuite/tests/stranal/should_compile/all.T | 2 ++ 3 files changed, 16 insertions(+) diff --git a/testsuite/tests/stranal/should_compile/T8743.hs b/testsuite/tests/stranal/should_compile/T8743.hs new file mode 100644 index 0000000..a69e522 --- /dev/null +++ b/testsuite/tests/stranal/should_compile/T8743.hs @@ -0,0 +1,11 @@ +module T8743 where + +-- Without the following import, it does not fail +import {-# SOURCE #-} T8743 () + +-- [()] required, () does not work. +class ToRow a where toRow :: a -> [()] + +instance ToRow (Maybe a) where + toRow Nothing = [()] + toRow (Just _) = [()] diff --git a/testsuite/tests/stranal/should_compile/T8743.hs-boot b/testsuite/tests/stranal/should_compile/T8743.hs-boot new file mode 100644 index 0000000..7f22b24 --- /dev/null +++ b/testsuite/tests/stranal/should_compile/T8743.hs-boot @@ -0,0 +1,3 @@ +module T8743 where +class ToRow a +instance ToRow (Maybe a) diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index 7ee45ad..2c53ebb 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -18,3 +18,5 @@ test('newtype', req_profiling, compile, ['-prof -auto-all']) test('T1988', normal, compile, ['']) test('T8467', normal, compile, ['']) test('T8037', normal, compile, ['']) +test('T8743', [ expect_broken(8743), extra_clean(['T8743.o-boot', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0']) + From git at git.haskell.org Mon Feb 17 09:14:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:14:55 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: In deepSplitCprType_maybe, be more forgiving (6e3feef) Message-ID: <20140217091455.9CB312406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/6e3feefb818ae04ff326ba7815ccaf4aa9d3f2ab/ghc >--------------------------------------------------------------- commit 6e3feefb818ae04ff326ba7815ccaf4aa9d3f2ab Author: Joachim Breitner Date: Fri Feb 7 17:59:29 2014 +0000 In deepSplitCprType_maybe, be more forgiving the ConTag may be out of range (e.g. if the type constructor is imported via SOURCE and we don't know any of its data constructors); just return Nothing without complaining in that case. This fixes #8743. (cherry picked from commit 312686c172eefb74237c8a61e2cca1b2af7459c1) >--------------------------------------------------------------- 6e3feefb818ae04ff326ba7815ccaf4aa9d3f2ab compiler/stranal/WwLib.lhs | 4 +++- testsuite/tests/stranal/should_compile/all.T | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs index 57937d6..f88c9ad 100644 --- a/compiler/stranal/WwLib.lhs +++ b/compiler/stranal/WwLib.lhs @@ -529,7 +529,9 @@ deepSplitCprType_maybe fam_envs con_tag ty , Just (tc, tc_args) <- splitTyConApp_maybe ty1 , isDataTyCon tc , let cons = tyConDataCons tc - con = ASSERT( cons `lengthAtLeast` con_tag ) cons !! (con_tag - fIRST_TAG) + , cons `lengthAtLeast` con_tag -- This might not be true if we import the + -- type constructor via a .hs-bool file (#8743) + , let con = cons !! (con_tag - fIRST_TAG) = Just (con, tc_args, dataConInstArgTys con tc_args, co) deepSplitCprType_maybe _ _ _ = Nothing \end{code} diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index 2c53ebb..0d10a99 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -18,5 +18,5 @@ test('newtype', req_profiling, compile, ['-prof -auto-all']) test('T1988', normal, compile, ['']) test('T8467', normal, compile, ['']) test('T8037', normal, compile, ['']) -test('T8743', [ expect_broken(8743), extra_clean(['T8743.o-boot', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0']) +test('T8743', [ extra_clean(['T8743.o-boot', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0']) From git at git.haskell.org Mon Feb 17 09:14:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:14:58 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix #8706, documenting that type operators are not promoted. (bc62cdd) Message-ID: <20140217091458.91E8E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/bc62cdd88a4b61088632ab53314b4685d0a48304/ghc >--------------------------------------------------------------- commit bc62cdd88a4b61088632ab53314b4685d0a48304 Author: Richard Eisenberg Date: Fri Feb 7 17:24:07 2014 -0500 Fix #8706, documenting that type operators are not promoted. (cherry picked from commit 218dead0d85a136b5d5648e4d6c4c9cc9467eb45) >--------------------------------------------------------------- bc62cdd88a4b61088632ab53314b4685d0a48304 docs/users_guide/glasgow_exts.xml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index fb3eb48..9910d2b 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -6652,6 +6652,18 @@ See also Trac #7347 + +Promoting type operators + +Type operators are not promoted to the kind level. Why not? Because +* is a kind, parsed the way identifiers are. Thus, if a programmer +tried to write Either * Bool, would it be Either +applied to * and Bool? Or would it be +* applied to Either and Bool. +To avoid this quagmire, we simply forbid promoting type operators to the kind level. + + + From git at git.haskell.org Mon Feb 17 09:15:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:15:03 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix #8631. (96f711b) Message-ID: <20140217091503.D39DC24069@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/96f711b4597f2cf704a226113760ab514b9554d3/ghc >--------------------------------------------------------------- commit 96f711b4597f2cf704a226113760ab514b9554d3 Author: Richard Eisenberg Date: Sat Feb 8 22:09:12 2014 -0500 Fix #8631. This patch allows turning on ImpredicativeTypes while type-checking the code generated by GeneralizedNewtypeDeriving. It does this by adding a field ib_extensions to InstBindings, informing the type-checker what extensions should be enabled while type-checking the instance. (cherry picked from commit 674c969c240632da70ed2928fa30c20a9a52e5dc) >--------------------------------------------------------------- 96f711b4597f2cf704a226113760ab514b9554d3 compiler/typecheck/TcDeriv.lhs | 15 ++++++++++----- compiler/typecheck/TcEnv.lhs | 4 ++++ compiler/typecheck/TcGenGenerics.lhs | 3 +++ compiler/typecheck/TcInstDcls.lhs | 7 ++++++- testsuite/tests/deriving/should_run/T8631.hs | 22 ++++++++++++++++++++++ testsuite/tests/deriving/should_run/all.T | 2 +- 6 files changed, 46 insertions(+), 7 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 96f711b4597f2cf704a226113760ab514b9554d3 From git at git.haskell.org Mon Feb 17 09:15:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:15:06 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Issue an error for pattern synonyms defined in a local scope (#8757) (4c5b195) Message-ID: <20140217091506.DDEDC2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/4c5b195b6846e83845cb2d5df9385906c19fd172/ghc >--------------------------------------------------------------- commit 4c5b195b6846e83845cb2d5df9385906c19fd172 Author: Dr. ERDI Gergo Date: Sun Feb 9 17:20:34 2014 +0800 Issue an error for pattern synonyms defined in a local scope (#8757) This also fixes the internal crash when using pattern synonyms in GHCi (#8749) (cherry picked from commit e0a55415545074bc7a757462624079f54f7785e2) >--------------------------------------------------------------- 4c5b195b6846e83845cb2d5df9385906c19fd172 compiler/rename/RnBinds.lhs | 9 ++++++++- compiler/rename/RnPat.lhs | 5 +++++ testsuite/tests/patsyn/should_fail/all.T | 1 + 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index ed1343f..ba94a39 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -434,9 +434,16 @@ rnBindLHS name_maker _ bind@(FunBind { fun_id = name@(L nameLoc _) }) ; return (bind { fun_id = L nameLoc newname }) } rnBindLHS name_maker _ bind@(PatSynBind{ patsyn_id = rdrname@(L nameLoc _) }) - = do { addLocM checkConName rdrname + = do { unless (isTopRecNameMaker name_maker) $ + addErr localPatternSynonymErr + ; addLocM checkConName rdrname ; name <- applyNameMaker name_maker rdrname ; return (bind{ patsyn_id = L nameLoc name }) } + where + localPatternSynonymErr :: SDoc + localPatternSynonymErr + = hang (ptext (sLit "Illegal pattern synonym declaration")) + 2 (ptext (sLit "Pattern synonym declarations are only valid in the top-level scope")) rnBindLHS _ _ b = pprPanic "rnBindHS" (ppr b) diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs index 3fde563..3c48f34 100644 --- a/compiler/rename/RnPat.lhs +++ b/compiler/rename/RnPat.lhs @@ -23,6 +23,7 @@ module RnPat (-- main entry points NameMaker, applyNameMaker, -- a utility for making names: localRecNameMaker, topRecNameMaker, -- sometimes we want to make local names, -- sometimes we want to make top (qualified) names. + isTopRecNameMaker, rnHsRecFields1, HsRecFieldContext(..), @@ -193,6 +194,10 @@ data NameMaker topRecNameMaker :: MiniFixityEnv -> NameMaker topRecNameMaker fix_env = LetMk TopLevel fix_env +isTopRecNameMaker :: NameMaker -> Bool +isTopRecNameMaker (LetMk TopLevel _) = True +isTopRecNameMaker _ = False + localRecNameMaker :: MiniFixityEnv -> NameMaker localRecNameMaker fix_env = LetMk NotTopLevel fix_env diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index e1708d2..0a07aed 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -1,3 +1,4 @@ test('mono', normal, compile_fail, ['']) test('unidir', normal, compile_fail, ['']) +test('local', normal, compile_fail, ['']) From git at git.haskell.org Mon Feb 17 09:15:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:15:09 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Add test suite for #8757 (40705fb) Message-ID: <20140217091509.C948C2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/40705fbe3e57196cd91baa41a1e8571955f94841/ghc >--------------------------------------------------------------- commit 40705fbe3e57196cd91baa41a1e8571955f94841 Author: Dr. ERDI Gergo Date: Sun Feb 9 17:27:24 2014 +0800 Add test suite for #8757 (cherry picked from commit 719108f8d70aa50cdaccf564dbc463445a03988e) >--------------------------------------------------------------- 40705fbe3e57196cd91baa41a1e8571955f94841 testsuite/tests/patsyn/should_fail/local.hs | 7 +++++++ testsuite/tests/patsyn/should_fail/local.stderr | 4 ++++ 2 files changed, 11 insertions(+) diff --git a/testsuite/tests/patsyn/should_fail/local.hs b/testsuite/tests/patsyn/should_fail/local.hs new file mode 100644 index 0000000..08314ea --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/local.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PatternSynonyms #-} +module ShouldFail where + +varWithLocalPatSyn x = case x of + P -> () + where + pattern P = () diff --git a/testsuite/tests/patsyn/should_fail/local.stderr b/testsuite/tests/patsyn/should_fail/local.stderr new file mode 100644 index 0000000..a9a8d01 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/local.stderr @@ -0,0 +1,4 @@ + +local.hs:7:5: + Illegal pattern synonym declaration + Pattern synonym declarations are only valid in the top-level scope From git at git.haskell.org Mon Feb 17 09:15:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:15:12 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Move test case for #8631 to the correct directory. (6e68886) Message-ID: <20140217091513.BE6002406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/6e68886a29634fddf5777f46a508aba62447ac39/ghc >--------------------------------------------------------------- commit 6e68886a29634fddf5777f46a508aba62447ac39 Author: Richard Eisenberg Date: Sun Feb 9 10:57:44 2014 -0500 Move test case for #8631 to the correct directory. (cherry picked from commit 02c7135dfce049b53bd38aa35c175302652af507) >--------------------------------------------------------------- 6e68886a29634fddf5777f46a508aba62447ac39 testsuite/tests/deriving/{should_run => should_compile}/T8631.hs | 0 testsuite/tests/deriving/should_compile/all.T | 1 + testsuite/tests/deriving/should_run/all.T | 2 +- 3 files changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/deriving/should_run/T8631.hs b/testsuite/tests/deriving/should_compile/T8631.hs similarity index 100% rename from testsuite/tests/deriving/should_run/T8631.hs rename to testsuite/tests/deriving/should_compile/T8631.hs diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index 488c8e8..02b067e 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -42,3 +42,4 @@ test('T7710', normal, compile, ['']) test('AutoDeriveTypeable', normal, compile, ['']) test('T8138', reqlib('primitive'), compile, ['-O2']) +test('T8631', normal, compile, ['']) \ No newline at end of file diff --git a/testsuite/tests/deriving/should_run/all.T b/testsuite/tests/deriving/should_run/all.T index 15fa39b..572f95b 100644 --- a/testsuite/tests/deriving/should_run/all.T +++ b/testsuite/tests/deriving/should_run/all.T @@ -36,4 +36,4 @@ test('T5628', exit_code(1), compile_and_run, ['']) test('T5712', normal, compile_and_run, ['']) test('T7931', normal, compile_and_run, ['']) test('T8280', normal, compile_and_run, ['']) -test('T8631', normal, compile, ['']) + From git at git.haskell.org Mon Feb 17 09:15:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:15:15 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix #8758 by assuming RankNTypes when checking GND code. (c032967) Message-ID: <20140217091515.833AB2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/c0329679818f873ed65b23f4d7e1f72c8b2dd26a/ghc >--------------------------------------------------------------- commit c0329679818f873ed65b23f4d7e1f72c8b2dd26a Author: Richard Eisenberg Date: Sun Feb 9 11:08:07 2014 -0500 Fix #8758 by assuming RankNTypes when checking GND code. (cherry picked from commit 8cc398ff8b3f7408327d99347f440693cb204c0a) >--------------------------------------------------------------- c0329679818f873ed65b23f4d7e1f72c8b2dd26a compiler/typecheck/TcDeriv.lhs | 3 ++- testsuite/tests/deriving/should_compile/T8758.hs | 9 +++++++++ testsuite/tests/deriving/should_compile/T8758a.hs | 8 ++++++++ testsuite/tests/deriving/should_compile/all.T | 1 + 4 files changed, 20 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index f9f7c0a..8a4c19c 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -1969,7 +1969,8 @@ genInst standalone_deriv oflag comauxs , iBinds = InstBindings { ib_binds = gen_Newtype_binds loc clas tvs tys rhs_ty , ib_pragmas = [] - , ib_extensions = [Opt_ImpredicativeTypes] + , ib_extensions = [ Opt_ImpredicativeTypes + , Opt_RankNTypes ] , ib_standalone_deriving = standalone_deriv } } , emptyBag , Just $ getName $ head $ tyConDataCons rep_tycon ) } diff --git a/testsuite/tests/deriving/should_compile/T8758.hs b/testsuite/tests/deriving/should_compile/T8758.hs new file mode 100644 index 0000000..86c54c4 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T8758.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE RankNTypes #-} + +module T8758 where + +class C m where + foo :: (forall b. b -> m b) -> c -> m c + +instance C [] where + foo f c = f c \ No newline at end of file diff --git a/testsuite/tests/deriving/should_compile/T8758a.hs b/testsuite/tests/deriving/should_compile/T8758a.hs new file mode 100644 index 0000000..4b7fe44 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T8758a.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module T8758a where + +import T8758 + +newtype MyList a = Mk [a] + deriving C \ No newline at end of file diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index 02b067e..a7cc3df 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -43,3 +43,4 @@ test('AutoDeriveTypeable', normal, compile, ['']) test('T8138', reqlib('primitive'), compile, ['-O2']) test('T8631', normal, compile, ['']) +test('T8758', extra_clean(['T8758a.o', 'T8758a.hi']), multimod_compile, ['T8758a', '-v0']) \ No newline at end of file From git at git.haskell.org Mon Feb 17 09:15:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:15:18 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Test #6147, which was fixed with the roles commit. (d99fcc1) Message-ID: <20140217091518.60A502406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/d99fcc16581a752711eabdb07ef1d39a1798dff6/ghc >--------------------------------------------------------------- commit d99fcc16581a752711eabdb07ef1d39a1798dff6 Author: Richard Eisenberg Date: Sun Feb 9 11:25:42 2014 -0500 Test #6147, which was fixed with the roles commit. (cherry picked from commit 9e0c1ae57526bacaca044a7ce5a6491fb6a7cb42) >--------------------------------------------------------------- d99fcc16581a752711eabdb07ef1d39a1798dff6 testsuite/tests/deriving/should_fail/T6147.hs | 13 +++++++++++++ testsuite/tests/deriving/should_fail/T6147.stderr | 11 +++++++++++ testsuite/tests/deriving/should_fail/all.T | 1 + 3 files changed, 25 insertions(+) diff --git a/testsuite/tests/deriving/should_fail/T6147.hs b/testsuite/tests/deriving/should_fail/T6147.hs new file mode 100644 index 0000000..f57f5af --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T6147.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-} +module T6147 where + +data family T a +data instance T Int = T_Int Int + +class C a where + foo :: a -> T a + +instance C Int where + foo = T_Int + +newtype Foo = Foo Int deriving(C) diff --git a/testsuite/tests/deriving/should_fail/T6147.stderr b/testsuite/tests/deriving/should_fail/T6147.stderr new file mode 100644 index 0000000..ffe584c --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T6147.stderr @@ -0,0 +1,11 @@ + +T6147.hs:13:32: + Could not coerce from ?T Int? to ?T Foo? + because the first type argument of ?T? has role Nominal, + but the arguments ?Int? and ?Foo? differ + arising from the coercion of the method ?foo? from type + ?Int -> T Int? to type ?Foo -> T Foo? + Possible fix: + use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (C Foo) diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T index b2b99ff..1ffa5fc 100644 --- a/testsuite/tests/deriving/should_fail/all.T +++ b/testsuite/tests/deriving/should_fail/all.T @@ -48,3 +48,4 @@ test('T7148', normal, compile_fail, ['']) test('T7148a', normal, compile_fail, ['']) test('T7800', normal, multimod_compile_fail, ['T7800','']) test('T5498', normal, compile_fail, ['']) +test('T6147', normal, compile_fail, ['']) \ No newline at end of file From git at git.haskell.org Mon Feb 17 09:15:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:15:21 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Test #7481, which had already been fixed. (c6c3fb6) Message-ID: <20140217091521.727932406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/c6c3fb6cb9683644c5e780304f9290d86e7db9b5/ghc >--------------------------------------------------------------- commit c6c3fb6cb9683644c5e780304f9290d86e7db9b5 Author: Richard Eisenberg Date: Sun Feb 9 11:34:19 2014 -0500 Test #7481, which had already been fixed. (cherry picked from commit d1dff94c9a82ffeff0bf92d0f90231a639ade59c) >--------------------------------------------------------------- c6c3fb6cb9683644c5e780304f9290d86e7db9b5 testsuite/tests/polykinds/T7481.hs | 12 ++++++++++++ testsuite/tests/polykinds/T7481.stderr | 4 ++++ testsuite/tests/polykinds/all.T | 1 + 3 files changed, 17 insertions(+) diff --git a/testsuite/tests/polykinds/T7481.hs b/testsuite/tests/polykinds/T7481.hs new file mode 100644 index 0000000..cb64d39 --- /dev/null +++ b/testsuite/tests/polykinds/T7481.hs @@ -0,0 +1,12 @@ + {-# LANGUAGE DataKinds, PolyKinds, RankNTypes, GADTs #-} + +module T7481 where + +import Data.Proxy + +data D a where + D1 :: a -> D a + D2 :: (a~Int) => D a + D3 :: forall (a::k) b. Proxy a -> D b + +data Foo :: D * -> * \ No newline at end of file diff --git a/testsuite/tests/polykinds/T7481.stderr b/testsuite/tests/polykinds/T7481.stderr new file mode 100644 index 0000000..bd2d679 --- /dev/null +++ b/testsuite/tests/polykinds/T7481.stderr @@ -0,0 +1,4 @@ + +T7481.hs:12:13: + ?D? of kind ?* -> *? is not promotable + In the kind ?D * -> *? diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 34253fd..005c47a 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -97,3 +97,4 @@ test('T8534', normal, compile, ['']) test('T8566', normal, compile_fail,['']) test('T8616', normal, compile_fail,['']) test('T8566a', expect_broken(8566), compile,['']) +test('T7481', normal, compile_fail,['']) \ No newline at end of file From git at git.haskell.org Mon Feb 17 09:15:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:15:24 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix #8759 by not panicking with TH and patsyns. (aa91cc2) Message-ID: <20140217091524.81E112406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/aa91cc2ae5151f7e25dbc35f32ef966bc59c2e12/ghc >--------------------------------------------------------------- commit aa91cc2ae5151f7e25dbc35f32ef966bc59c2e12 Author: Richard Eisenberg Date: Sun Feb 9 12:31:01 2014 -0500 Fix #8759 by not panicking with TH and patsyns. We should still have pattern synonyms in TH, though. (cherry picked from commit 6122efcabe6e08375f69ee19148ba3838c332559) >--------------------------------------------------------------- aa91cc2ae5151f7e25dbc35f32ef966bc59c2e12 compiler/deSugar/DsMeta.hs | 2 +- compiler/typecheck/TcSplice.lhs | 3 +++ testsuite/tests/th/T8759.hs | 11 +++++++++++ testsuite/tests/th/T8759.stderr | 3 +++ testsuite/tests/th/T8759a.hs | 5 +++++ testsuite/tests/th/T8759a.stderr | 4 ++++ testsuite/tests/th/all.T | 2 ++ 7 files changed, 29 insertions(+), 1 deletion(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 56fba14..9ee5bc1 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -1238,7 +1238,7 @@ rep_bind (L _ (VarBind { var_id = v, var_rhs = e})) ; return (srcLocSpan (getSrcLoc v), ans) } rep_bind (L _ (AbsBinds {})) = panic "rep_bind: AbsBinds" -rep_bind (L _ (PatSynBind {})) = panic "rep_bind: PatSynBind" +rep_bind (L _ dec@(PatSynBind {})) = notHandled "pattern synonyms" (ppr dec) ----------------------------------------------------------------------------- -- Since everything in a Bind is mutually recursive we need rename all -- all the variables simultaneously. For example: diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index b7e2699..0a47da1 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -70,6 +70,7 @@ import Class import Inst import TyCon import CoAxiom +import PatSyn ( patSynId ) import ConLike import DataCon import TcEvidence( TcEvBinds(..) ) @@ -1173,6 +1174,8 @@ reifyThing (AGlobal (AConLike (RealDataCon dc))) ; return (TH.DataConI (reifyName name) ty (reifyName (dataConOrigTyCon dc)) fix) } +reifyThing (AGlobal (AConLike (PatSynCon ps))) + = noTH (sLit "pattern synonyms") (ppr $ patSynId ps) reifyThing (ATcId {tct_id = id}) = do { ty1 <- zonkTcType (idType id) -- Make use of all the info we have, even diff --git a/testsuite/tests/th/T8759.hs b/testsuite/tests/th/T8759.hs new file mode 100644 index 0000000..298761a --- /dev/null +++ b/testsuite/tests/th/T8759.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell, PatternSynonyms #-} + +module T8759 where + +import Language.Haskell.TH + +pattern P = () + +$( do info <- reify 'P + reportWarning (show info) + return [] ) diff --git a/testsuite/tests/th/T8759.stderr b/testsuite/tests/th/T8759.stderr new file mode 100644 index 0000000..3b5474b --- /dev/null +++ b/testsuite/tests/th/T8759.stderr @@ -0,0 +1,3 @@ + +T8759.hs:9:4: + Can't represent pattern synonyms in Template Haskell: P diff --git a/testsuite/tests/th/T8759a.hs b/testsuite/tests/th/T8759a.hs new file mode 100644 index 0000000..3d8089c --- /dev/null +++ b/testsuite/tests/th/T8759a.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TemplateHaskell, PatternSynonyms #-} + +module T8759a where + +foo = [d| pattern Q = False |] diff --git a/testsuite/tests/th/T8759a.stderr b/testsuite/tests/th/T8759a.stderr new file mode 100644 index 0000000..ff0fd49 --- /dev/null +++ b/testsuite/tests/th/T8759a.stderr @@ -0,0 +1,4 @@ + +T8759a.hs:5:7: + pattern synonyms not (yet) handled by Template Haskell + pattern Q = False diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 5b064ba..3e88970 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -317,3 +317,5 @@ test('T8577', ['T8577', '-v0 ' + config.ghc_th_way_flags]) test('T8633', normal, compile_and_run, ['']) test('T8625', normal, ghci_script, ['T8625.script']) +test('T8759', normal, compile_fail, ['-v0']) +test('T8759a', normal, compile_fail, ['-v0']) \ No newline at end of file From git at git.haskell.org Mon Feb 17 09:28:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 09:28:53 +0000 (UTC) Subject: [commit: packages/base] master: Expand comment for enumDeltaToInteger1 (d13662d) Message-ID: <20140217092854.125012406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d13662db345129ac7a13543fafdf678c0cc896e4/base >--------------------------------------------------------------- commit d13662db345129ac7a13543fafdf678c0cc896e4 Author: Joachim Breitner Date: Mon Feb 17 09:30:07 2014 +0000 Expand comment for enumDeltaToInteger1 >--------------------------------------------------------------- d13662db345129ac7a13543fafdf678c0cc896e4 GHC/Enum.lhs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GHC/Enum.lhs b/GHC/Enum.lhs index 2934c72..c8208fa 100644 --- a/GHC/Enum.lhs +++ b/GHC/Enum.lhs @@ -707,6 +707,8 @@ enumDeltaToIntegerFB c n x delta lim -- This rule ensures that in the common case (delta = 1), we do not do the check here, -- and also that we have the chance to inline up_fb, which would allow the constuctor to be -- inlined and good things to happen. +-- We do not do it for Int this way because hand-tuned code already exists, and +-- the sepcial case varies more from the general case, due to the issue of overflows. {-# NOINLINE [1] enumDeltaToInteger #-} enumDeltaToInteger :: Integer -> Integer -> Integer -> [Integer] From git at git.haskell.org Mon Feb 17 10:26:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 10:26:11 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix #5682. Now, '(:) parses. (92b4219) Message-ID: <20140217102611.A5D9F2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/92b4219f254be97d33d4e1768ba17c966cbd3a8d/ghc >--------------------------------------------------------------- commit 92b4219f254be97d33d4e1768ba17c966cbd3a8d Author: Richard Eisenberg Date: Thu Feb 13 13:35:40 2014 -0500 Fix #5682. Now, '(:) parses. (cherry picked from commit 473f12a3be27a00b035f1fdc7050a0ff31bf12ff) >--------------------------------------------------------------- 92b4219f254be97d33d4e1768ba17c966cbd3a8d compiler/parser/Parser.y.pp | 2 ++ testsuite/tests/parser/should_compile/T5682.hs | 12 ++++++++++++ testsuite/tests/parser/should_compile/all.T | 1 + 3 files changed, 15 insertions(+) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 1715f6c..d2bc463 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -1155,6 +1155,8 @@ atype :: { LHsType RdrName } | SIMPLEQUOTE '(' ')' { LL $ HsTyVar $ getRdrName unitDataCon } | SIMPLEQUOTE '(' ctype ',' comma_types1 ')' { LL $ HsExplicitTupleTy [] ($3 : $5) } | SIMPLEQUOTE '[' comma_types0 ']' { LL $ HsExplicitListTy placeHolderKind $3 } + | SIMPLEQUOTE '(' qconop ')' { LL $ HsTyVar (unLoc $3) } + | SIMPLEQUOTE '(' varop ')' { LL $ HsTyVar (unLoc $3) } | '[' ctype ',' comma_types1 ']' { LL $ HsExplicitListTy placeHolderKind ($2 : $4) } | INTEGER {% mkTyLit $ LL $ HsNumTy $ getINTEGER $1 } | STRING {% mkTyLit $ LL $ HsStrTy $ getSTRING $1 } diff --git a/testsuite/tests/parser/should_compile/T5682.hs b/testsuite/tests/parser/should_compile/T5682.hs new file mode 100644 index 0000000..bfd6752 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T5682.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds, DeriveDataTypeable, StandaloneDeriving, TypeOperators #-} + +module T5682 where + +import Data.Typeable + +data a :+: b = Mk a b +data Foo = Bool :+: Bool + +type X = True ':+: False + +deriving instance Typeable '(:+:) \ No newline at end of file diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T index 1129856..e9cc99e 100644 --- a/testsuite/tests/parser/should_compile/all.T +++ b/testsuite/tests/parser/should_compile/all.T @@ -96,3 +96,4 @@ test('T5243', extra_clean(['T5243A.hi', 'T5243A.o']), multimod_compile, ['T5243','']) test('T7118', normal, compile, ['']) test('T7776', normal, compile, ['']) +test('T5682', normal, compile, ['']) \ No newline at end of file From git at git.haskell.org Mon Feb 17 10:26:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 10:26:15 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix #8773. (00df318) Message-ID: <20140217102615.9376D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/00df3185f2d8b8ba6320ef1621c29e7ddfada911/ghc >--------------------------------------------------------------- commit 00df3185f2d8b8ba6320ef1621c29e7ddfada911 Author: Richard Eisenberg Date: Thu Feb 13 14:22:20 2014 -0500 Fix #8773. To make a role annotation on a class asserting a role other than nominal, you now need -XIncoherentInstances. See the ticket for more information as to why this is a good idea. (cherry picked from commit 138297585f88351352e0ed878b25f26e1d6edfef) >--------------------------------------------------------------- 00df3185f2d8b8ba6320ef1621c29e7ddfada911 compiler/typecheck/TcTyClsDecls.lhs | 14 ++++++++++++++ testsuite/tests/roles/should_compile/Roles14.hs | 7 +++++++ testsuite/tests/roles/should_compile/Roles14.stderr | 14 ++++++++++++++ testsuite/tests/roles/should_compile/Roles4.hs | 4 ---- testsuite/tests/roles/should_compile/Roles4.stderr | 6 ------ testsuite/tests/roles/should_compile/all.T | 1 + testsuite/tests/roles/should_fail/T8773.hs | 7 +++++++ testsuite/tests/roles/should_fail/T8773.stderr | 5 +++++ testsuite/tests/roles/should_fail/all.T | 1 + 9 files changed, 49 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 1fbdbb2..0c5ceea 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1694,6 +1694,15 @@ checkValidRoleAnnots role_annots thing ; checkTc (type_vars `equalLength` the_role_annots) (wrongNumberOfRoles type_vars decl) ; _ <- zipWith3M checkRoleAnnot type_vars the_role_annots type_roles + -- Representational or phantom roles for class parameters + -- quickly lead to incoherence. So, we require + -- IncoherentInstances to have them. See #8773. + ; incoherent_roles_ok <- xoptM Opt_IncoherentInstances + ; checkTc ( incoherent_roles_ok + || (not $ isClassTyCon tc) + || (all (== Nominal) type_roles)) + incoherentRoles + ; lint <- goptM Opt_DoCoreLinting ; when lint $ checkValidRoles tc } @@ -2180,6 +2189,11 @@ needXRoleAnnotations tc = ptext (sLit "Illegal role annotation for") <+> ppr tc <> char ';' $$ ptext (sLit "did you intend to use RoleAnnotations?") +incoherentRoles :: SDoc +incoherentRoles = (text "Roles other than" <+> quotes (text "nominal") <+> + text "for class parameters can lead to incoherence.") $$ + (text "Use IncoherentInstances to allow this; bad role found") + addTyThingCtxt :: TyThing -> TcM a -> TcM a addTyThingCtxt thing = addErrCtxt ctxt diff --git a/testsuite/tests/roles/should_compile/Roles14.hs b/testsuite/tests/roles/should_compile/Roles14.hs new file mode 100644 index 0000000..121aad7 --- /dev/null +++ b/testsuite/tests/roles/should_compile/Roles14.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RoleAnnotations, IncoherentInstances #-} + +module Roles12 where + +type role C2 representational +class C2 a where + meth2 :: a -> a diff --git a/testsuite/tests/roles/should_compile/Roles14.stderr b/testsuite/tests/roles/should_compile/Roles14.stderr new file mode 100644 index 0000000..1323193 --- /dev/null +++ b/testsuite/tests/roles/should_compile/Roles14.stderr @@ -0,0 +1,14 @@ +TYPE SIGNATURES +TYPE CONSTRUCTORS + C2 :: * -> Constraint + class C2 a + Roles: [representational] + RecFlag NonRecursive + meth2 :: a -> a +COERCION AXIOMS + axiom Roles12.NTCo:C2 :: C2 a = a -> a +Dependent modules: [] +Dependent packages: [base, ghc-prim, integer-gmp] + +==================== Typechecker ==================== + diff --git a/testsuite/tests/roles/should_compile/Roles4.hs b/testsuite/tests/roles/should_compile/Roles4.hs index b5c404a..d7aa78f 100644 --- a/testsuite/tests/roles/should_compile/Roles4.hs +++ b/testsuite/tests/roles/should_compile/Roles4.hs @@ -6,10 +6,6 @@ type role C1 nominal class C1 a where meth1 :: a -> a -type role C2 representational -class C2 a where - meth2 :: a -> a - type Syn1 a = [a] class C3 a where diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr index e69b852..32862ea 100644 --- a/testsuite/tests/roles/should_compile/Roles4.stderr +++ b/testsuite/tests/roles/should_compile/Roles4.stderr @@ -5,11 +5,6 @@ TYPE CONSTRUCTORS Roles: [nominal] RecFlag NonRecursive meth1 :: a -> a - C2 :: * -> Constraint - class C2 a - Roles: [representational] - RecFlag NonRecursive - meth2 :: a -> a C3 :: * -> Constraint class C3 a Roles: [nominal] @@ -19,7 +14,6 @@ TYPE CONSTRUCTORS type Syn1 a = [a] COERCION AXIOMS axiom Roles4.NTCo:C1 :: C1 a = a -> a - axiom Roles4.NTCo:C2 :: C2 a = a -> a axiom Roles4.NTCo:C3 :: C3 a = a -> Syn1 a Dependent modules: [] Dependent packages: [base, ghc-prim, integer-gmp] diff --git a/testsuite/tests/roles/should_compile/all.T b/testsuite/tests/roles/should_compile/all.T index 266a260..a016de3 100644 --- a/testsuite/tests/roles/should_compile/all.T +++ b/testsuite/tests/roles/should_compile/all.T @@ -3,4 +3,5 @@ test('Roles2', only_ways('normal'), compile, ['-ddump-tc']) test('Roles3', only_ways('normal'), compile, ['-ddump-tc']) 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, ['']) \ No newline at end of file diff --git a/testsuite/tests/roles/should_fail/T8773.hs b/testsuite/tests/roles/should_fail/T8773.hs new file mode 100644 index 0000000..d0984b4 --- /dev/null +++ b/testsuite/tests/roles/should_fail/T8773.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RoleAnnotations #-} + +module T8773 where + +type role C2 representational +class C2 a where + meth2 :: a -> a diff --git a/testsuite/tests/roles/should_fail/T8773.stderr b/testsuite/tests/roles/should_fail/T8773.stderr new file mode 100644 index 0000000..838d587 --- /dev/null +++ b/testsuite/tests/roles/should_fail/T8773.stderr @@ -0,0 +1,5 @@ + +T8773.hs:5:1: + Roles other than ?nominal? for class parameters can lead to incoherence. + Use IncoherentInstances to allow this; bad role found + while checking a role annotation for ?C2? diff --git a/testsuite/tests/roles/should_fail/all.T b/testsuite/tests/roles/should_fail/all.T index 0e30472..d0d5c4d 100644 --- a/testsuite/tests/roles/should_fail/all.T +++ b/testsuite/tests/roles/should_fail/all.T @@ -7,3 +7,4 @@ test('Roles11', normal, compile_fail, ['']) test('Roles12', extra_clean(['Roles12.o-boot', 'Roles12.hi-boot']), run_command, ['$MAKE --no-print-directory -s Roles12']) +test('T8773', normal, compile_fail, ['']) \ No newline at end of file From git at git.haskell.org Mon Feb 17 10:26:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 10:26:18 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix --enable-unregistered by passing NOSMP to .hc compiler (#8748) (2243e00) Message-ID: <20140217102618.2DA3B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/2243e007a3c3e0b12aaf47541571a351da855022/ghc >--------------------------------------------------------------- commit 2243e007a3c3e0b12aaf47541571a351da855022 Author: Sergei Trofimovich Date: Thu Feb 13 07:23:02 2014 -0600 Fix --enable-unregistered by passing NOSMP to .hc compiler (#8748) Signed-off-by: Austin Seipp (cherry picked from commit 68f0a6a6cd5bf3374fbc4a4fb09df4cbda97b61c) >--------------------------------------------------------------- 2243e007a3c3e0b12aaf47541571a351da855022 compiler/ghc.mk | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/ghc.mk b/compiler/ghc.mk index 0a18713..4977e28 100644 --- a/compiler/ghc.mk +++ b/compiler/ghc.mk @@ -353,6 +353,11 @@ else compiler_CONFIGURE_OPTS += --ghc-option=-DNO_REGS endif +ifneq "$(GhcWithSMP)" "YES" +compiler_CONFIGURE_OPTS += --ghc-option=-DNOSMP +compiler_CONFIGURE_OPTS += --ghc-option=-optc-DNOSMP +endif + # Careful optimisation of the parser: we don't want to throw everything # at it, because that takes too long and doesn't buy much, but we do want # to inline certain key external functions, so we instruct GHC not to From git at git.haskell.org Mon Feb 17 10:26:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 10:26:20 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix --enable-unregistered by declaring missing RTS functions (#8748) (ce3cb70) Message-ID: <20140217102622.B76D12406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/ce3cb705eabd73981ed33d7b39d30399dd216ec0/ghc >--------------------------------------------------------------- commit ce3cb705eabd73981ed33d7b39d30399dd216ec0 Author: Sergei Trofimovich Date: Thu Feb 13 07:23:48 2014 -0600 Fix --enable-unregistered by declaring missing RTS functions (#8748) Signed-off-by: Austin Seipp (cherry picked from commit 4bb50ed0c6246e2d45e22e79f5658db1fa8a58b3) >--------------------------------------------------------------- ce3cb705eabd73981ed33d7b39d30399dd216ec0 includes/stg/MiscClosures.h | 2 ++ 1 file changed, 2 insertions(+) diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index f8c8f0d..ff781dd 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -465,6 +465,8 @@ extern StgWord RTS_VAR(CCS_LIST); /* registered CCS list */ extern StgWord CCS_SYSTEM[]; extern unsigned int RTS_VAR(CC_ID); /* global ids */ extern unsigned int RTS_VAR(CCS_ID); +RTS_FUN_DECL(enterFunCCS); +RTS_FUN_DECL(pushCostCentre); // Capability.c extern unsigned int n_capabilities; From git at git.haskell.org Mon Feb 17 10:26:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 10:26:23 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: rts/Capability.c: fix crash in -threaded mode on UNREG build (645d1ec) Message-ID: <20140217102623.690E52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/645d1ec0a67a05aae75cc4d53e1fbc9664481589/ghc >--------------------------------------------------------------- commit 645d1ec0a67a05aae75cc4d53e1fbc9664481589 Author: Sergei Trofimovich Date: Thu Feb 13 07:26:05 2014 -0600 rts/Capability.c: fix crash in -threaded mode on UNREG build UNREG mode has quite nasty invariant to maintain: capabilities[0] == &MainCapability and it's a non-heap memory, while other capabilities are dynamically allocated. Issue #8748 Signed-off-by: Sergei Trofimovich Signed-off-by: Austin Seipp (cherry picked from commit ebace6969f0ec85b1caa0fea265a5f9990a23b2e) >--------------------------------------------------------------- 645d1ec0a67a05aae75cc4d53e1fbc9664481589 rts/Capability.c | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/rts/Capability.c b/rts/Capability.c index 5988d42..16b71b7 100644 --- a/rts/Capability.c +++ b/rts/Capability.c @@ -357,15 +357,18 @@ moreCapabilities (nat from USED_IF_THREADS, nat to USED_IF_THREADS) // BaseReg (eg. unregisterised), so in this case // capabilities[0] must coincide with &MainCapability. capabilities[0] = &MainCapability; + initCapability(&MainCapability, 0); } - - for (i = 0; i < to; i++) { - if (i < from) { - capabilities[i] = old_capabilities[i]; - } else { - capabilities[i] = stgMallocBytes(sizeof(Capability), - "moreCapabilities"); - initCapability(capabilities[i], i); + else + { + for (i = 0; i < to; i++) { + if (i < from) { + capabilities[i] = old_capabilities[i]; + } else { + capabilities[i] = stgMallocBytes(sizeof(Capability), + "moreCapabilities"); + initCapability(capabilities[i], i); + } } } @@ -983,7 +986,8 @@ freeCapabilities (void) nat i; for (i=0; i < n_capabilities; i++) { freeCapability(capabilities[i]); - stgFree(capabilities[i]); + if (capabilities[i] != &MainCapability) + stgFree(capabilities[i]); } #else freeCapability(&MainCapability); From git at git.haskell.org Mon Feb 17 10:26:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 10:26:25 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: includes/Stg.h: add declarations for hs_popcnt and frinds (2a81c08) Message-ID: <20140217102625.E29762406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/2a81c08b2d867157be6f7f98948c893de594f384/ghc >--------------------------------------------------------------- commit 2a81c08b2d867157be6f7f98948c893de594f384 Author: Sergei Trofimovich Date: Thu Feb 13 07:27:46 2014 -0600 includes/Stg.h: add declarations for hs_popcnt and frinds This fixes most of implicit function declarations emitted C codegen in UNREG mode. Found by adding the following to mk/build.mk: SRC_CC_OPTS += -Werror=implicit-function-declaration SRC_HC_OPTS += -optc-Werror=implicit-function-declaration Issue #8748 Signed-off-by: Sergei Trofimovich Signed-off-by: Austin Seipp (cherry picked from commit 858a807d5522145e8ede9148a15bb65a0d851c00) >--------------------------------------------------------------- 2a81c08b2d867157be6f7f98948c893de594f384 includes/Stg.h | 1 + includes/stg/Prim.h | 39 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+) diff --git a/includes/Stg.h b/includes/Stg.h index 09de8d4..be966aa 100644 --- a/includes/Stg.h +++ b/includes/Stg.h @@ -240,6 +240,7 @@ typedef StgFunPtr F_; #include "stg/MiscClosures.h" #endif +#include "stg/Prim.h" /* ghc-prim fallbacks */ #include "stg/SMP.h" // write_barrier() inline is required /* ----------------------------------------------------------------------------- diff --git a/includes/stg/Prim.h b/includes/stg/Prim.h new file mode 100644 index 0000000..2b23c3d --- /dev/null +++ b/includes/stg/Prim.h @@ -0,0 +1,39 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 2014-2014 + * + * Declarations for C fallback primitives implemented by 'ghc-prim' package. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes + * + * -------------------------------------------------------------------------- */ + +#ifndef PRIM_H +#define PRIM_H + +/* libraries/ghc-prim/cbits/bswap.c */ +StgWord16 hs_bswap16(StgWord16 x); +StgWord32 hs_bswap32(StgWord32 x); +StgWord64 hs_bswap64(StgWord64 x); + +/* TODO: longlong.c */ + +/* libraries/ghc-prim/cbits/popcnt.c */ +StgWord hs_popcnt8(StgWord8 x); +StgWord hs_popcnt16(StgWord16 x); +StgWord hs_popcnt32(StgWord32 x); +StgWord hs_popcnt64(StgWord64 x); +#ifdef i386_HOST_ARCH +StgWord hs_popcnt(StgWord32 x); +#else +StgWord hs_popcnt(StgWord64 x); +#endif + +/* libraries/ghc-prim/cbits/word2float.c */ +StgFloat hs_word2float32(StgWord x); +StgDouble hs_word2float64(StgWord x); + +#endif /* PRIM_H */ From git at git.haskell.org Mon Feb 17 10:26:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 10:26:28 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: rts/package.conf.in: fix UNREG on --with-system-libffi when include-dir is passed explicitely (0c7ede8) Message-ID: <20140217102628.B9E352406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/0c7ede86c5bf66de2223c647cec3c5ee15bcb715/ghc >--------------------------------------------------------------- commit 0c7ede86c5bf66de2223c647cec3c5ee15bcb715 Author: Sergei Trofimovich Date: Thu Feb 13 07:29:14 2014 -0600 rts/package.conf.in: fix UNREG on --with-system-libffi when include-dir is passed explicitely Issue #8748 Signed-off-by: Sergei Trofimovich Signed-off-by: Austin Seipp (cherry picked from commit 2d0fa9aee78e5bfffb9a4580954825025a651be5) >--------------------------------------------------------------- 0c7ede86c5bf66de2223c647cec3c5ee15bcb715 rts/package.conf.in | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/package.conf.in b/rts/package.conf.in index 010305f..4c8686f 100644 --- a/rts/package.conf.in +++ b/rts/package.conf.in @@ -57,9 +57,9 @@ extra-libraries: #endif #ifdef INSTALLING -include-dirs: INCLUDE_DIR PAPI_INCLUDE_DIR +include-dirs: INCLUDE_DIR PAPI_INCLUDE_DIR FFI_INCLUDE_DIR #else /* !INSTALLING */ -include-dirs: TOP"/rts/dist/build" TOP"/includes" TOP"/includes/dist-derivedconstants/header" +include-dirs: TOP"/rts/dist/build" TOP"/includes" TOP"/includes/dist-derivedconstants/header" FFI_INCLUDE_DIR #endif includes: Stg.h From git at git.haskell.org Mon Feb 17 10:26:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 10:26:31 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: mk/config.mk.in: lower -O2 optimization down to -O1 on UNREG (dfe466a) Message-ID: <20140217102634.083A32406D@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/dfe466a256f065987e0e4b7d3693369fe6ad0e3f/ghc >--------------------------------------------------------------- commit dfe466a256f065987e0e4b7d3693369fe6ad0e3f Author: Sergei Trofimovich Date: Thu Feb 13 07:29:50 2014 -0600 mk/config.mk.in: lower -O2 optimization down to -O1 on UNREG Disable -O2 optimization. Otherwise amount of generated C code makes things very slow to compile (~5 minutes on core-i7 for 'compiler/hsSyn/HsExpr.lhs') And sometimes not compile at all (powerpc64 overflows something on 'compiler/hsSyn/HsExpr.lhs'). Issue #8748 Signed-off-by: Sergei Trofimovich Signed-off-by: Austin Seipp (cherry picked from commit 2d5372cfdc2236a77ec49df249f3379b93224e06) >--------------------------------------------------------------- dfe466a256f065987e0e4b7d3693369fe6ad0e3f mk/config.mk.in | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/mk/config.mk.in b/mk/config.mk.in index b3d6995..6207cce 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -422,6 +422,16 @@ BIN_DIST_TAR_BZ2 = $(BIN_DIST_NAME)-$(TARGETPLATFORM).tar.bz2 # SRC_HC_OPTS += -H32m -O +# Disable -O2 optimization. Otherwise amount of generated C code +# makes things very slow to compile (~5 minutes on core-i7 for 'compiler/hsSyn/HsExpr.lhs') +# and sometimes not compile at all (powerpc64 overflows something +# on 'compiler/hsSyn/HsExpr.lhs'). +ifeq "$(GhcUnregisterised)" "YES" +GhcStage1HcOpts= +GhcStage2HcOpts= +GhcStage3HcOpts= +endif + # ----------------------------------------------------------------------------- # Names of programs in the GHC tree From git at git.haskell.org Mon Feb 17 10:26:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 10:26:33 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix installation of hpc (#8735) (a3e3afc) Message-ID: <20140217102634.10F6C24069@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/a3e3afc73dfef7bfc038b88904f04b0fb4fec729/ghc >--------------------------------------------------------------- commit a3e3afc73dfef7bfc038b88904f04b0fb4fec729 Author: Austin Seipp Date: Thu Feb 13 07:19:39 2014 -0600 Fix installation of hpc (#8735) Signed-off-by: Austin Seipp (cherry picked from commit a365eabd465a1700f479f78ad99fc1a31915e639) >--------------------------------------------------------------- a3e3afc73dfef7bfc038b88904f04b0fb4fec729 utils/hpc/ghc.mk | 3 +++ utils/hpc/hpc.wrapper | 2 ++ 2 files changed, 5 insertions(+) diff --git a/utils/hpc/ghc.mk b/utils/hpc/ghc.mk index 7280729..f70be94 100644 --- a/utils/hpc/ghc.mk +++ b/utils/hpc/ghc.mk @@ -15,4 +15,7 @@ utils/hpc_PACKAGE = hpc-bin utils/hpc_dist-install_INSTALL = YES utils/hpc_dist-install_INSTALL_INPLACE = YES utils/hpc_dist-install_PROGNAME = hpc +utils/hpc_dist-install_SHELL_WRAPPER = YES +utils/hpc_dist-install_INSTALL_SHELL_WRAPPER_NAME = hpc + $(eval $(call build-prog,utils/hpc,dist-install,1)) diff --git a/utils/hpc/hpc.wrapper b/utils/hpc/hpc.wrapper new file mode 100644 index 0000000..22982ef --- /dev/null +++ b/utils/hpc/hpc.wrapper @@ -0,0 +1,2 @@ +#!/bin/sh +exec "$executablename" ${1+"$@"} From git at git.haskell.org Mon Feb 17 10:26:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 10:26:36 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix check for TLS support in Storage.c (f321edd) Message-ID: <20140217102636.5EE3A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/f321edd759841d5328a9d4fee7f291e21446acc1/ghc >--------------------------------------------------------------- commit f321edd759841d5328a9d4fee7f291e21446acc1 Author: Austin Seipp Date: Sun Feb 16 18:49:43 2014 -0600 Fix check for TLS support in Storage.c This should have manifested earlier, but for some reason it only seemed to trigger on Mavericks. Signed-off-by: Austin Seipp (cherry picked from commit c83eabf37b884398d911609e46707df771c3fde9) >--------------------------------------------------------------- f321edd759841d5328a9d4fee7f291e21446acc1 rts/sm/Storage.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index c7126fe..df5f4b3 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -237,7 +237,7 @@ void storageAddCapabilities (nat from, nat to) } } -#if defined(THREADED_RTS) && defined(llvm_CC_FLAVOR) +#if defined(THREADED_RTS) && defined(llvm_CC_FLAVOR) && (CC_SUPPORTS_TLS == 0) newThreadLocalKey(&gctKey); #endif @@ -261,7 +261,7 @@ freeStorage (rtsBool free_heap) closeMutex(&sm_mutex); #endif stgFree(nurseries); -#if defined(THREADED_RTS) && defined(llvm_CC_FLAVOR) +#if defined(THREADED_RTS) && defined(llvm_CC_FLAVOR) && (CC_SUPPORTS_TLS == 0) freeThreadLocalKey(&gctKey); #endif freeGcThreads(); From git at git.haskell.org Mon Feb 17 10:26:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 10:26:38 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix #8745 - GND is now -XSafe compatible. (b8e2b64) Message-ID: <20140217102638.D01B92406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/b8e2b649e18984028ba82f99786b640578f9709f/ghc >--------------------------------------------------------------- commit b8e2b649e18984028ba82f99786b640578f9709f Author: Austin Seipp Date: Sun Feb 16 19:14:36 2014 -0600 Fix #8745 - GND is now -XSafe compatible. As discussed in the ticket, after the landing of #8773, GND is now -XSafe compatible. This fixes the test fallout as well. In particular SafeLang07 was removed following in the steps of SafeLang06, since it no longer failed from GND, but failed due to roles and was thus invalid. The other tests were tweaked to use TemplateHaskell instead of GND in order to trigger safety warnings. Signed-off-by: Austin Seipp (cherry picked from commit a8a01e742434df11b830ab99af12d9045dfcbc4b) >--------------------------------------------------------------- b8e2b649e18984028ba82f99786b640578f9709f compiler/main/DynFlags.hs | 5 +-- testsuite/tests/safeHaskell/ghci/p1.stderr | 3 -- testsuite/tests/safeHaskell/ghci/p16.stderr | 15 ------- testsuite/tests/safeHaskell/ghci/p16.stdout | 1 + .../safeHaskell/safeInfered/UnsafeInfered03_A.hs | 2 +- .../tests/safeHaskell/safeLanguage/SafeLang02.hs | 2 +- .../safeHaskell/safeLanguage/SafeLang02.stderr | 2 +- .../tests/safeHaskell/safeLanguage/SafeLang07.hs | 41 -------------------- .../safeHaskell/safeLanguage/SafeLang07.stderr | 7 ---- .../tests/safeHaskell/safeLanguage/SafeLang07_A.hs | 24 ------------ testsuite/tests/safeHaskell/safeLanguage/all.T | 7 ++-- 11 files changed, 8 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 b8e2b649e18984028ba82f99786b640578f9709f From git at git.haskell.org Mon Feb 17 10:26:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 10:26:41 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix #8770 (c9c0b15) Message-ID: <20140217102641.4FDD52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/c9c0b1514b566425b16e2d88dd50f994c9a87709/ghc >--------------------------------------------------------------- commit c9c0b1514b566425b16e2d88dd50f994c9a87709 Author: Austin Seipp Date: Thu Feb 13 07:17:30 2014 -0600 Fix #8770 As usual, Mac OS X is extremely annoying (or the software is, anyway), because not only does it load dynamic libraries with the .dylib extension, but also the .so extension. For whatever reason. At least it's easy to fix. Signed-off-by: Austin Seipp (cherry picked from commit dc080915597065087b3821b3ded0a621a7e2fae7) >--------------------------------------------------------------- c9c0b1514b566425b16e2d88dd50f994c9a87709 compiler/ghci/Linker.lhs | 11 ++++++++++- compiler/main/DriverPhases.hs | 10 +++++----- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index eb3e226..274f2fb 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -378,7 +378,16 @@ preloadLib dflags lib_paths framework_paths lib_spec -> do maybe_errstr <- loadDLL (mkSOName platform dll_unadorned) case maybe_errstr of Nothing -> maybePutStrLn dflags "done" - Just mm -> preloadFailed mm lib_paths lib_spec + Just mm | platformOS platform /= OSDarwin -> + preloadFailed mm lib_paths lib_spec + Just mm | otherwise -> do + -- As a backup, on Darwin, try to also load a .so file + -- since (apparently) some things install that way - see + -- ticket #8770. + err2 <- loadDLL $ ("lib" ++ dll_unadorned) <.> "so" + case err2 of + Nothing -> maybePutStrLn dflags "done" + Just _ -> preloadFailed mm lib_paths lib_spec DLLPath dll_path -> do maybe_errstr <- loadDLL dll_path diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs index 2de19b9..c406f6a 100644 --- a/compiler/main/DriverPhases.hs +++ b/compiler/main/DriverPhases.hs @@ -240,14 +240,14 @@ objish_suffixes :: Platform -> [String] -- Use the appropriate suffix for the system on which -- the GHC-compiled code will run objish_suffixes platform = case platformOS platform of - OSMinGW32 -> [ "o", "O", "obj", "OBJ" ] - _ -> [ "o" ] + OSMinGW32 -> [ "o", "O", "obj", "OBJ" ] + _ -> [ "o" ] dynlib_suffixes :: Platform -> [String] dynlib_suffixes platform = case platformOS platform of - OSMinGW32 -> ["dll", "DLL"] - OSDarwin -> ["dylib"] - _ -> ["so"] + OSMinGW32 -> ["dll", "DLL"] + OSDarwin -> ["dylib", "so"] + _ -> ["so"] isHaskellishSuffix, isHaskellSrcSuffix, isCishSuffix, isExtCoreSuffix, isHaskellUserSrcSuffix From git at git.haskell.org Mon Feb 17 12:48:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 12:48:40 +0000 (UTC) Subject: [commit: ghc] master: Add comments explaining #8754 (b626c3d) Message-ID: <20140217124840.AE0652406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b626c3d4ce0e66216705ba8355c914dc809e3fe7/ghc >--------------------------------------------------------------- commit b626c3d4ce0e66216705ba8355c914dc809e3fe7 Author: Austin Seipp Date: Mon Feb 17 06:48:04 2014 -0600 Add comments explaining #8754 Signed-off-by: Austin Seipp >--------------------------------------------------------------- b626c3d4ce0e66216705ba8355c914dc809e3fe7 ghc/Main.hs | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index 1aa6553..0011aa9 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -77,7 +77,7 @@ import Data.Maybe main :: IO () main = do - defaultsHook + defaultsHook -- See Note [-Bsymbolic and hooks] hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do @@ -821,4 +821,23 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs [] -> "" suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) +{- Note [-Bsymbolic and hooks] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-Bsymbolic is a flag that prevents the binding of references to global +symbols to symbols outside the shared library being compiled (see `man +ld`). When dynamically linking, we don't use -Bsymbolic on the RTS +package: that is because we want hooks to be overridden by the user, +we don't want to constrain them to the RTS package. + +Unfortunately this seems to have broken somehow on OS X: as a result, +defaultHooks (in hschooks.c) is not called, which does not initialize +the GC stats. As a result, this breaks things like `:set +s` in GHCi +(#8754). As a hacky workaround, we instead call 'defaultHooks' +directly to initalize the flags in the RTS. + +A biproduct of this, I believe, is that hooks are likely broken on OS +X when dynamically linking. But this probably doesn't affect most +people since we're linking GHC dynamically, but most things themselves +link statically. +-} foreign import ccall safe "defaultsHook" defaultsHook :: IO () From git at git.haskell.org Mon Feb 17 14:08:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:08:50 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix #8754 in a round-about way. (e3dd172) Message-ID: <20140217140850.216EF2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/e3dd1727db9b054527a9fbc0b84b78d44e79ec53/ghc >--------------------------------------------------------------- commit e3dd1727db9b054527a9fbc0b84b78d44e79ec53 Author: Austin Seipp Date: Sun Feb 16 19:10:16 2014 -0600 Fix #8754 in a round-about way. For some reason on OS X, it seems like -Bsymbolic (which we use for hooks into the RTS) isn't working, which results in #8754, where stats don't work because defaultHooks doesn't initialize the stats flag. This seems to work on Linux static/dynamically, but only on OS X statically. After talking with Simon, really, the entire hooks thing is a bit fragile. For now, we just work around it (since GHCi is dynamically linked) by calling into the defaultHooks ourselves when GHC starts. Signed-off-by: Austin Seipp (cherry picked from commit 5023c91780e90947680fe0640f7564a4f6448bea) >--------------------------------------------------------------- e3dd1727db9b054527a9fbc0b84b78d44e79ec53 ghc/Main.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ghc/Main.hs b/ghc/Main.hs index 868042b..1aa6553 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -1,4 +1,5 @@ {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} +{-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- @@ -76,6 +77,7 @@ import Data.Maybe main :: IO () main = do + defaultsHook hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do @@ -818,3 +820,5 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs (case fuzzyMatch f (nub allFlags) of [] -> "" suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) + +foreign import ccall safe "defaultsHook" defaultsHook :: IO () From git at git.haskell.org Mon Feb 17 14:08:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:08:53 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Add comments explaining #8754 (81fda82) Message-ID: <20140217140853.150682406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/81fda827b2293ede526fe1f3eb04c133c14ee9fc/ghc >--------------------------------------------------------------- commit 81fda827b2293ede526fe1f3eb04c133c14ee9fc Author: Austin Seipp Date: Mon Feb 17 06:48:04 2014 -0600 Add comments explaining #8754 Signed-off-by: Austin Seipp (cherry picked from commit b626c3d4ce0e66216705ba8355c914dc809e3fe7) >--------------------------------------------------------------- 81fda827b2293ede526fe1f3eb04c133c14ee9fc ghc/Main.hs | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index 1aa6553..0011aa9 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -77,7 +77,7 @@ import Data.Maybe main :: IO () main = do - defaultsHook + defaultsHook -- See Note [-Bsymbolic and hooks] hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do @@ -821,4 +821,23 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs [] -> "" suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) +{- Note [-Bsymbolic and hooks] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-Bsymbolic is a flag that prevents the binding of references to global +symbols to symbols outside the shared library being compiled (see `man +ld`). When dynamically linking, we don't use -Bsymbolic on the RTS +package: that is because we want hooks to be overridden by the user, +we don't want to constrain them to the RTS package. + +Unfortunately this seems to have broken somehow on OS X: as a result, +defaultHooks (in hschooks.c) is not called, which does not initialize +the GC stats. As a result, this breaks things like `:set +s` in GHCi +(#8754). As a hacky workaround, we instead call 'defaultHooks' +directly to initalize the flags in the RTS. + +A biproduct of this, I believe, is that hooks are likely broken on OS +X when dynamically linking. But this probably doesn't affect most +people since we're linking GHC dynamically, but most things themselves +link statically. +-} foreign import ccall safe "defaultsHook" defaultsHook :: IO () From git at git.haskell.org Mon Feb 17 14:09:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:09:07 +0000 (UTC) Subject: [commit: packages/base] ghc-7.8: Test case for #8374 (ba7f9ee) Message-ID: <20140217140907.16CD32406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/ba7f9ee6c17916aae0809af82928ab45794a8038/base >--------------------------------------------------------------- commit ba7f9ee6c17916aae0809af82928ab45794a8038 Author: Joachim Breitner Date: Fri Feb 14 10:17:52 2014 +0000 Test case for #8374 (cherry picked from commit d455e2dfb6d1a7b4b22784f0c49178bd346e15e0) >--------------------------------------------------------------- ba7f9ee6c17916aae0809af82928ab45794a8038 tests/T8374.hs | 4 ++++ tests/T8374.stdout | 1 + tests/all.T | 9 +++++++++ 3 files changed, 14 insertions(+) diff --git a/tests/T8374.hs b/tests/T8374.hs new file mode 100644 index 0000000..48f2b23 --- /dev/null +++ b/tests/T8374.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO() +main = print $ length [1..(2^(20::Int)::Integer)] diff --git a/tests/T8374.stdout b/tests/T8374.stdout new file mode 100644 index 0000000..6820bf1 --- /dev/null +++ b/tests/T8374.stdout @@ -0,0 +1 @@ +1048576 diff --git a/tests/all.T b/tests/all.T index f722538..0d62dfd 100644 --- a/tests/all.T +++ b/tests/all.T @@ -154,3 +154,12 @@ test('topHandler03', exit_code(143) # actually signal 15 SIGTERM ], compile_and_run, ['']) + +test('T8374', + [ stats_num_field('bytes allocated', (16828144, 5)), + # with GHC-7.6.3: 83937384 (but faster execution than the next line) + # before: 58771216 (without call-arity-analysis) + # expected value: 16828144 (2014-01-14) + only_ways(['normal'])], + compile_and_run, + ['-O']) From git at git.haskell.org Mon Feb 17 14:09:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:09:09 +0000 (UTC) Subject: [commit: packages/base] ghc-7.8: Wrong bug number (c8c9ce6) Message-ID: <20140217140909.401BE2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/c8c9ce665c42e4b68af6bc79d73ad0c9bd8afed9/base >--------------------------------------------------------------- commit c8c9ce665c42e4b68af6bc79d73ad0c9bd8afed9 Author: Joachim Breitner Date: Fri Feb 14 10:19:35 2014 +0000 Wrong bug number the previous commit added a testcase for #8766, not #8374 -- too many tabs open. (cherry picked from commit f28ee96d7c246f78d5e8cb9c853f417e54ff3d91) >--------------------------------------------------------------- c8c9ce665c42e4b68af6bc79d73ad0c9bd8afed9 tests/{T8374.hs => T8766.hs} | 0 tests/{T8374.stdout => T8766.stdout} | 0 tests/all.T | 2 +- 3 files changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/T8374.hs b/tests/T8766.hs similarity index 100% rename from tests/T8374.hs rename to tests/T8766.hs diff --git a/tests/T8374.stdout b/tests/T8766.stdout similarity index 100% rename from tests/T8374.stdout rename to tests/T8766.stdout diff --git a/tests/all.T b/tests/all.T index 0d62dfd..d4a6c05 100644 --- a/tests/all.T +++ b/tests/all.T @@ -155,7 +155,7 @@ test('topHandler03', ], compile_and_run, ['']) -test('T8374', +test('T8766', [ stats_num_field('bytes allocated', (16828144, 5)), # with GHC-7.6.3: 83937384 (but faster execution than the next line) # before: 58771216 (without call-arity-analysis) From git at git.haskell.org Mon Feb 17 14:09:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:09:11 +0000 (UTC) Subject: [commit: packages/base] ghc-7.8: Improve list fusion for [n::Integer..m] (45dccb9) Message-ID: <20140217140911.4DACA2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/45dccb9c862dac16e27813e189da5944647e38b7/base >--------------------------------------------------------------- commit 45dccb9c862dac16e27813e189da5944647e38b7 Author: Joachim Breitner Date: Fri Feb 14 09:17:22 2014 +0000 Improve list fusion for [n::Integer..m] enumFromTo for Integers goes via enumDeltaToInteger, which is less efficient, as the "delta > = 0" check prevents more inlining which is required for good fusion code. This rule avoids tihs check for the common case of "delta = 1", makes up_fb visible and hence inlineable, which greatly improves "length [n:Integer..m]"; even more so with CallArity enabled. (#8766) (cherry picked from commit a60eeccf06c28bee3b87c561450320d17c7399e3) >--------------------------------------------------------------- 45dccb9c862dac16e27813e189da5944647e38b7 GHC/Enum.lhs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/GHC/Enum.lhs b/GHC/Enum.lhs index 332d205..2934c72 100644 --- a/GHC/Enum.lhs +++ b/GHC/Enum.lhs @@ -701,6 +701,13 @@ enumDeltaToIntegerFB c n x delta lim | delta >= 0 = up_fb c n x delta lim | otherwise = dn_fb c n x delta lim +{-# RULES +"enumDeltaToInteger1" [0] forall c n x . enumDeltaToIntegerFB c n x 1 = up_fb c n x 1 + #-} +-- This rule ensures that in the common case (delta = 1), we do not do the check here, +-- and also that we have the chance to inline up_fb, which would allow the constuctor to be +-- inlined and good things to happen. + {-# NOINLINE [1] enumDeltaToInteger #-} enumDeltaToInteger :: Integer -> Integer -> Integer -> [Integer] enumDeltaToInteger x delta lim From git at git.haskell.org Mon Feb 17 14:09:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:09:13 +0000 (UTC) Subject: [commit: packages/base] ghc-7.8: Fix T8766 numbers. (0f2e0b9) Message-ID: <20140217140913.3596A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/0f2e0b9e9c890865efc4f1ac8a917eaad777ae40/base >--------------------------------------------------------------- commit 0f2e0b9e9c890865efc4f1ac8a917eaad777ae40 Author: Austin Seipp Date: Mon Feb 17 08:08:04 2014 -0600 Fix T8766 numbers. As Joachim mentioned, the 7.8 branch doesn't have call-arity analysis, so the numbers here get a bit worse. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 0f2e0b9e9c890865efc4f1ac8a917eaad777ae40 tests/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/all.T b/tests/all.T index d4a6c05..bec843f 100644 --- a/tests/all.T +++ b/tests/all.T @@ -156,7 +156,7 @@ test('topHandler03', test('T8766', - [ stats_num_field('bytes allocated', (16828144, 5)), + [ stats_num_field('bytes allocated', (58771216, 5)), # with GHC-7.6.3: 83937384 (but faster execution than the next line) # before: 58771216 (without call-arity-analysis) # expected value: 16828144 (2014-01-14) From git at git.haskell.org Mon Feb 17 14:09:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:09:29 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Document module header. (88cfe69) Message-ID: <20140217140930.D9C7E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/88cfe69e8aa26e86f58196024facdd0187965864 >--------------------------------------------------------------- commit 88cfe69e8aa26e86f58196024facdd0187965864 Author: Mateusz Kowalczyk Date: Sun Feb 9 17:51:22 2014 +0000 Document module header. Fixes Haddock Trac #270. (cherry picked from commit 1e21c673a42d3337e05607ed4f47024c65d0cc9d) >--------------------------------------------------------------- 88cfe69e8aa26e86f58196024facdd0187965864 doc/haddock.xml | 70 ++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 62 insertions(+), 8 deletions(-) diff --git a/doc/haddock.xml b/doc/haddock.xml index b5331c2..7c1ca91 100644 --- a/doc/haddock.xml +++ b/doc/haddock.xml @@ -100,7 +100,7 @@ We might want documentation in multiple formats - online and printed, for example. Haddock comes with HTML, LaTeX, and Hoogle backends, and it is structured in such a way that adding new - back-ends is straightforward. + backends is straightforward. @@ -1229,17 +1229,71 @@ f :: Int -- ^ The 'Int' argument
The module description - A module may contain a documentation comment before the - module header, in which case this comment is interpreted by - Haddock as an overall description of the module itself, and - placed in a section entitled Description in the - documentation for the module. For example: + A module itself may be documented with multiple fields + that can then be displayed by the backend. In particular, the + HTML backend displays all the fields it currently knows + about. We first show the most complete module documentation + example and then talk about the fields. --- | This is the description for module "Foo" -module Foo where +{-| +Module : W +Description : Short description +Copyright : (c) Some Guy, 2013 + Someone Else, 2014 +License : GPL-3 +Maintainer : sample at email.com +Stability : experimental +Portability : POSIX + +Here is a longer description of this module, containing some +commentary with @some markup at . +-} +module W where ... + + The Module field should be clear. It + currently doesn't affect the output of any of the backends but + you might want to include it for human information or for any + other tools that might be parsing these comments without the + help of GHC. + + The Description field accepts some short text + which outlines the general purpose of the module. If you're + generating HTML, it will show up next to the module link in + the module index. + + The Copyright, License, + Maintainer and Stability fields + should be obvious. An alternative spelling for the + License field is accepted as + Licence but the output will always prefer + License. + + The Portability field has seen varied use + by different library authors. Some people put down things like + operating system constraints there while others put down which + GHC extensions used. Note that you might want to consider using + the show-extensions module flag for the + latter. + + Finally, a module may contain a documentation comment + before the module header, in which case this comment is + interpreted by Haddock as an overall description of the module + itself, and placed in a section entitled + Description in the documentation for the module. + All usual Haddock markup is valid in this comment. + + All fields are optional but they must be in order if they + do appear. Multi-line fields are accepted but the consecutive + lines have to start indented more than their label. If your + label is indented one space as is often the case with + -- syntax, the consecutive lines have to start at + two spaces at the very least. Please note that we do not enforce + the format for any of the fields and the established formats are + just a convention. +
From git at git.haskell.org Mon Feb 17 14:09:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:09:31 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Insert a space between module link and description (a9192ee) Message-ID: <20140217140931.8893B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/a9192eef8e67555187c557fc02e2f0f1c0ad49ea >--------------------------------------------------------------- commit a9192eef8e67555187c557fc02e2f0f1c0ad49ea Author: Mateusz Kowalczyk Date: Sun Feb 9 18:27:36 2014 +0000 Insert a space between module link and description Fixes Haddock Trac #277. (cherry picked from commit 01de3a355ee0db773eba5f4368ac8ef4d75425b5) >--------------------------------------------------------------- a9192eef8e67555187c557fc02e2f0f1c0ad49ea src/Haddock/Backends/Xhtml.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index ac4282f..3168c7b 100644 --- a/src/Haddock/Backends/Xhtml.hs +++ b/src/Haddock/Backends/Xhtml.hs @@ -291,7 +291,7 @@ mkNodeList qual ss p ts = case ts of mkNode :: Qualification -> [String] -> String -> ModuleTree -> Html mkNode qual ss p (Node s leaf pkg short ts) = - htmlModule +++ shortDescr +++ htmlPkg +++ subtree + htmlModule <+> shortDescr +++ htmlPkg +++ subtree where modAttrs = case (ts, leaf) of (_:_, False) -> collapseControl p True "module" From git at git.haskell.org Mon Feb 17 14:09:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:09:33 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Ensure a space between type signature and ‘Source’ (be68d8f) Message-ID: <20140217140933.823472406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/be68d8fc8daedd0a0968d453b446c02797ddbce7 >--------------------------------------------------------------- commit be68d8fc8daedd0a0968d453b446c02797ddbce7 Author: Mateusz Kowalczyk Date: Mon Feb 10 23:27:21 2014 +0000 Ensure a space between type signature and ?Source? This is briefly related to Haddock Trac #249 and employs effectively the suggested fix _but_ it doesn't actually fix the reported issue. This commit simply makes copying the full line a bit less of a pain. (cherry picked from commit 860d6504530a163e7483960ca8837eb596e05634) >--------------------------------------------------------------- be68d8fc8daedd0a0968d453b446c02797ddbce7 src/Haddock/Backends/Xhtml/Layout.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs index 3ddbd28..4584fd8 100644 --- a/src/Haddock/Backends/Xhtml/Layout.hs +++ b/src/Haddock/Backends/Xhtml/Layout.hs @@ -187,7 +187,7 @@ declElem = paragraph ! [theclass "src"] -- it adds a source and wiki link at the right hand side of the box topDeclElem :: LinksInfo -> SrcSpan -> [DocName] -> Html -> Html topDeclElem ((_,_,sourceMap), (_,_,maybe_wiki_url)) loc names html = - declElem << (html +++ srcLink +++ wikiLink) + declElem << (html <+> srcLink <+> wikiLink) where srcLink = case Map.lookup origPkg sourceMap of Nothing -> noHtml @@ -216,4 +216,3 @@ topDeclElem ((_,_,sourceMap), (_,_,maybe_wiki_url)) loc names html = fname = case loc of RealSrcSpan l -> unpackFS (srcSpanFile l) UnhelpfulSpan _ -> error "topDeclElem UnhelpfulSpan" - From git at git.haskell.org Mon Feb 17 14:09:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:09:35 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Add support for type/data families (85afe79) Message-ID: <20140217140935.96BA92406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/85afe79f66947620e27885e8f7ffac79c961e855 >--------------------------------------------------------------- commit 85afe79f66947620e27885e8f7ffac79c961e855 Author: nand Date: Tue Feb 4 22:13:27 2014 +0100 Add support for type/data families This adds support for type/data families with their respective instances, as well as closed type families and associated type/data families. Signed-off-by: Mateusz Kowalczyk (cherry picked from commit e0718f203f2448ba2029e70d14aed075860b7fac) >--------------------------------------------------------------- 85afe79f66947620e27885e8f7ffac79c961e855 CHANGES | 2 + doc/haddock.xml | 12 +- html-test/ref/TypeFamilies.html | 674 +++++++++++++++++--- .../{HiddenInstancesB.html => TypeFamilies2.html} | 94 +-- html-test/ref/ocean.css | 19 + html-test/src/TypeFamilies.hs | 76 ++- html-test/src/TypeFamilies2.hs | 12 + resources/html/Ocean.std-theme/ocean.css | 13 + src/Haddock/Backends/LaTeX.hs | 16 +- src/Haddock/Backends/Xhtml.hs | 1 + src/Haddock/Backends/Xhtml/Decl.hs | 42 +- src/Haddock/Backends/Xhtml/Layout.hs | 5 + src/Haddock/Convert.hs | 34 +- src/Haddock/GhcUtils.hs | 11 + src/Haddock/Interface/AttachInstances.hs | 57 +- src/Haddock/Interface/Create.hs | 122 ++-- src/Haddock/Interface/Rename.hs | 9 +- src/Haddock/Types.hs | 22 +- 18 files changed, 924 insertions(+), 297 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 85afe79f66947620e27885e8f7ffac79c961e855 From git at git.haskell.org Mon Feb 17 14:09:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:09:37 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Improve display of poly-kinded type operators (962d239) Message-ID: <20140217140937.9ED162406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/962d239c6c1f368a784624cc6e8259f910c6f8e9 >--------------------------------------------------------------- commit 962d239c6c1f368a784624cc6e8259f910c6f8e9 Author: nand Date: Tue Feb 11 11:52:48 2014 +0100 Improve display of poly-kinded type operators This now displays them as (==) k a b c ... to mirror GHC's behavior, instead of the old (k == a) b c ... which was just wrong. Signed-off-by: Mateusz Kowalczyk (cherry picked from commit bc5756d062bbc5cad5d4fa60798435ed020c518e) >--------------------------------------------------------------- 962d239c6c1f368a784624cc6e8259f910c6f8e9 CHANGES | 2 + html-test/ref/TypeFamilies.html | 292 ++++++++++++++++++++++++++++-------- html-test/src/TypeFamilies.hs | 14 +- src/Haddock/Backends/LaTeX.hs | 22 +-- src/Haddock/Backends/Xhtml.hs | 2 +- src/Haddock/Backends/Xhtml/Decl.hs | 30 ++-- src/Haddock/Convert.hs | 10 +- src/Haddock/Interface/Rename.hs | 5 +- src/Haddock/Types.hs | 6 +- 9 files changed, 280 insertions(+), 103 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 962d239c6c1f368a784624cc6e8259f910c6f8e9 From git at git.haskell.org Mon Feb 17 14:09:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:09:39 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Add test case for PatternSynonyms (67de012) Message-ID: <20140217140940.472442406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/67de012e25743cd07b116aa41b5a04f8e64fec10 >--------------------------------------------------------------- commit 67de012e25743cd07b116aa41b5a04f8e64fec10 Author: nand Date: Tue Feb 11 16:51:27 2014 +0100 Add test case for PatternSynonyms This just tests various stuff including poly-kinded patterns and operator patterns to make sure the rendering isn't broken. Signed-off-by: Mateusz Kowalczyk (cherry picked from commit 7e53f628440169f90cfb6aeeaf74ffbe2b1cfa6d) >--------------------------------------------------------------- 67de012e25743cd07b116aa41b5a04f8e64fec10 html-test/ref/PatternSyns.html | 241 ++++++++++++++++++++++++++++++++++++++++ html-test/src/PatternSyns.hs | 22 ++++ 2 files changed, 263 insertions(+) diff --git a/html-test/ref/PatternSyns.html b/html-test/ref/PatternSyns.html new file mode 100644 index 0000000..36b3c3b --- /dev/null +++ b/html-test/ref/PatternSyns.html @@ -0,0 +1,241 @@ + +PatternSyns
Safe HaskellSafe-Inferred

PatternSyns

Description

Testing some pattern synonyms

Synopsis

Documentation

data FooType x

FooType doc

Constructors

FooCtor x 

pattern Foo t :: FooType t

Pattern synonym for Foo x

pattern Bar t :: FooType (FooType t)

Pattern synonym for Bar x

pattern t :<-> t :: (FooType t, FooType (FooType t))

Pattern synonym for (:<->)

data a >< b

Doc for (><)

Constructors

Empty 

pattern E :: (><) k t t

Pattern for Empty

diff --git a/html-test/src/PatternSyns.hs b/html-test/src/PatternSyns.hs new file mode 100644 index 0000000..8af5eb2 --- /dev/null +++ b/html-test/src/PatternSyns.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE PatternSynonyms, PolyKinds, TypeOperators #-} + +-- | Testing some pattern synonyms +module PatternSyns where + +-- | FooType doc +data FooType x = FooCtor x + +-- | Pattern synonym for 'Foo' x +pattern Foo x = FooCtor x + +-- | Pattern synonym for 'Bar' x +pattern Bar x = FooCtor (Foo x) + +-- | Pattern synonym for (':<->') +pattern x :<-> y = (Foo x, Bar y) + +-- | Doc for ('><') +data (a :: *) >< b = Empty + +-- | Pattern for 'Empty' +pattern E = Empty From git at git.haskell.org Mon Feb 17 14:09:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:09:41 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Get rid of re-implementation of sortBy (f6280ae) Message-ID: <20140217140941.B73F52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/f6280aec5d28bc49d5d6badc162d83745faf3f7e >--------------------------------------------------------------- commit f6280aec5d28bc49d5d6badc162d83745faf3f7e Author: Niklas Haas Date: Thu Feb 13 22:21:36 2014 +0100 Get rid of re-implementation of sortBy I have no idea what this was doing lying around here, and due to the usage of tuples it's actually slower, too. Signed-off-by: Mateusz Kowalczyk (cherry picked from commit d86f68860c40d45d2cec94edd15d4bf4fc4292d8) >--------------------------------------------------------------- f6280aec5d28bc49d5d6badc162d83745faf3f7e src/Haddock/Interface/AttachInstances.hs | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs index a56759a..8c9d45c 100644 --- a/src/Haddock/Interface/AttachInstances.hs +++ b/src/Haddock/Interface/AttachInstances.hs @@ -19,6 +19,7 @@ import Haddock.Convert import Control.Arrow import Data.List +import Data.Ord (comparing) import qualified Data.Map as Map import qualified Data.Set as Set @@ -67,12 +68,12 @@ attachToExportItem expInfo iface ifaceMap instIfaceMap export = case mb_info of Just (_, _, cls_instances, fam_instances) -> let fam_insts = [ (synifyFamInst i, n) - | i <- sortImage instFam fam_instances + | i <- sortBy (comparing instFam) fam_instances , let n = lookupInstDoc (getName i) iface ifaceMap instIfaceMap ] cls_insts = [ (synifyInstHead i, lookupInstDoc n iface ifaceMap instIfaceMap) | let is = [ (instanceHead' i, getName i) | i <- cls_instances ] - , (i@(_,_,cls,tys), n) <- sortImage (first instHead) is + , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is , not $ isInstanceHidden expInfo cls tys ] in cls_insts ++ fam_insts @@ -163,11 +164,6 @@ instFam :: FamInst -> ([Int], Name, [SimpleType], Int, SimpleType) instFam FamInst { fi_fam = n, fi_tys = ts, fi_rhs = t } = (map argCount ts, n, map simplify ts, argCount t, simplify t) --- sortImage f = sortBy (\x y -> compare (f x) (f y)) -sortImage :: Ord b => (a -> b) -> [a] -> [a] -sortImage f xs = map snd $ sortBy cmp_fst [(f x, x) | x <- xs] - where cmp_fst (x,_) (y,_) = compare x y - funTyConName :: Name funTyConName = mkWiredInName gHC_PRIM From git at git.haskell.org Mon Feb 17 14:09:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:09:43 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Only warn about missing docs when docs are missing (e1d934d) Message-ID: <20140217140943.BD31E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/e1d934d8c66a0a361bd811c1d7734a6432cc8007 >--------------------------------------------------------------- commit e1d934d8c66a0a361bd811c1d7734a6432cc8007 Author: Mateusz Kowalczyk Date: Thu Feb 13 23:57:16 2014 +0000 Only warn about missing docs when docs are missing This fixes the ?Missing documentation for?? message for modules with 100% coverage. (cherry picked from commit 50d1d18cc70cf6c8ffcf247743cd8af0ff9aae16) >--------------------------------------------------------------- e1d934d8c66a0a361bd811c1d7734a6432cc8007 src/Haddock/Interface.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Haddock/Interface.hs b/src/Haddock/Interface.hs index 24d4791..60a20fe 100644 --- a/src/Haddock/Interface.hs +++ b/src/Haddock/Interface.hs @@ -195,7 +195,8 @@ processModule verbosity modsum flags modMap instIfaceMap = do else n out verbosity normal coverageMsg - when (Flag_PrintMissingDocs `elem` flags && (header || not (null undocumentedExports))) $ do + when (Flag_PrintMissingDocs `elem` flags + && not (null undocumentedExports && header)) $ do out verbosity normal " Missing documentation for:" unless header $ out verbosity normal " Module header" mapM_ (out verbosity normal . (" " ++)) undocumentedExports From git at git.haskell.org Mon Feb 17 14:09:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 14:09:45 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Add test case for inter-module type/data family instances (46d4c21) Message-ID: <20140217140945.D2D362406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/46d4c218d10d0ef9dd4c3ddcd550e4ea7ba5013f >--------------------------------------------------------------- commit 46d4c218d10d0ef9dd4c3ddcd550e4ea7ba5013f Author: Niklas Haas Date: Sat Feb 15 08:41:40 2014 +0100 Add test case for inter-module type/data family instances These should show up in every place where the class is visible, and indeed they do right now. Signed-off-by: Mateusz Kowalczyk (cherry picked from commit 6b35adfb811d9e41e5bfa1c11963e441740c2836) >--------------------------------------------------------------- 46d4c218d10d0ef9dd4c3ddcd550e4ea7ba5013f html-test/ref/TypeFamilies.html | 28 +++++++++++++++ html-test/ref/TypeFamilies2.html | 72 ++++++++++++++++++++++++++++++++++++++ html-test/src/TypeFamilies.hs | 8 +++++ html-test/src/TypeFamilies2.hs | 5 ++- 4 files changed, 112 insertions(+), 1 deletion(-) diff --git a/html-test/ref/TypeFamilies.html b/html-test/ref/TypeFamilies.html index 6584510..53a8b9d 100644 --- a/html-test/ref/TypeFamilies.html +++ b/html-test/ref/TypeFamilies.html @@ -235,6 +235,22 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");}; >type Foo X = Y

External instance

data Batdata Bar Y data Bat data Bar X = BarX Y type Foo type Foo X = Y

External instance

data family Bar a

Instances

data Bar X = BarX Y 
data Bar Y 
XX = 'X class (><) (a :: k) (b :: k) instance XX >< XXX + +-- | External instance + +type instance TF.Foo X = Y + +data instance TF.Bar Y diff --git a/html-test/src/TypeFamilies2.hs b/html-test/src/TypeFamilies2.hs index 718e11d..093f77c 100644 --- a/html-test/src/TypeFamilies2.hs +++ b/html-test/src/TypeFamilies2.hs @@ -3,10 +3,13 @@ -- in type instances. The expected behaviour is -- that we get the instance, Y is not linked and -- Haddock shows a linking warning. -module TypeFamilies2 (X, Foo) where +module TypeFamilies2 (X, Foo, Bar) where data X data Y type family Foo a type instance Foo X = Y + +data family Bar a +data instance Bar X = BarX Y From git at git.haskell.org Mon Feb 17 15:18:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Feb 2014 15:18:33 +0000 (UTC) Subject: [commit: ghc] master: More liberally eta-expand a case-expression (2931d19) Message-ID: <20140217151833.5170F2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2931d19e90d2366f2ce308d65a36333336ca6059/ghc >--------------------------------------------------------------- commit 2931d19e90d2366f2ce308d65a36333336ca6059 Author: Joachim Breitner Date: Mon Feb 17 11:47:22 2014 +0000 More liberally eta-expand a case-expression at least with -fno-pedantic-bottoms. This fixes #2915, and undoes some of a522c3b, on the grounds that with a flag `-fpedantic-bottoms` around, we can be a bit more liberal when the flag is off.. >--------------------------------------------------------------- 2931d19e90d2366f2ce308d65a36333336ca6059 compiler/coreSyn/CoreArity.lhs | 37 +++++++++---------------------------- 1 file changed, 9 insertions(+), 28 deletions(-) diff --git a/compiler/coreSyn/CoreArity.lhs b/compiler/coreSyn/CoreArity.lhs index fd74e59..2c7cd83 100644 --- a/compiler/coreSyn/CoreArity.lhs +++ b/compiler/coreSyn/CoreArity.lhs @@ -143,7 +143,7 @@ exprBotStrictness_maybe e Nothing -> Nothing Just ar -> Just (ar, sig ar) where - env = AE { ae_bndrs = [], ae_ped_bot = True, ae_cheap_fn = \ _ _ -> False } + env = AE { ae_ped_bot = True, ae_cheap_fn = \ _ _ -> False } sig ar = mkClosedStrictSig (replicate ar topDmd) botRes -- For this purpose we can be very simple \end{code} @@ -325,12 +325,8 @@ this transformation. So we try to limit it as much as possible: (3) Do NOT move a lambda outside a case unless (a) The scrutinee is ok-for-speculation, or - (b) There is an enclosing value \x, and the scrutinee is x - E.g. let x = case y of ( DEFAULT -> \v -> blah } - We don't move the \y out. This is pretty arbitrary; but it - catches the common case of doing `seq` on y. - This is the reason for the under_lam argument to arityType. - See Trac #5625 + (b) more liberally: the scrunitee is cheap and -fpedantic-bottoms is not + enforced Of course both (1) and (2) are readily defeated by disguising the bottoms. @@ -492,8 +488,7 @@ exprEtaExpandArity dflags e ATop oss -> length oss ABot n -> n where - env = AE { ae_bndrs = [] - , ae_cheap_fn = mk_cheap_fn dflags isCheapApp + env = AE { ae_cheap_fn = mk_cheap_fn dflags isCheapApp , ae_ped_bot = gopt Opt_PedanticBottoms dflags } getBotArity :: ArityType -> Maybe Arity @@ -562,8 +557,7 @@ rhsEtaExpandArity dflags cheap_app e ATop [] -> 0 ABot n -> n where - env = AE { ae_bndrs = [] - , ae_cheap_fn = mk_cheap_fn dflags cheap_app + env = AE { ae_cheap_fn = mk_cheap_fn dflags cheap_app , ae_ped_bot = gopt Opt_PedanticBottoms dflags } has_lam (Tick _ e) = has_lam e @@ -698,9 +692,7 @@ type CheapFun = CoreExpr -> Maybe Type -> Bool -- of the expression; Nothing means "don't know" data ArityEnv - = AE { ae_bndrs :: [Id] -- Enclosing value-lambda Ids - -- See Note [Dealing with bottom (3)] - , ae_cheap_fn :: CheapFun + = AE { ae_cheap_fn :: CheapFun , ae_ped_bot :: Bool -- True <=> be pedantic about bottoms } @@ -734,19 +726,14 @@ arityType _ (Var v) -- Lambdas; increase arity arityType env (Lam x e) - | isId x = arityLam x (arityType env' e) + | isId x = arityLam x (arityType env e) | otherwise = arityType env e - where - env' = env { ae_bndrs = x : ae_bndrs env } -- Applications; decrease arity, except for types arityType env (App fun (Type _)) = arityType env fun arityType env (App fun arg ) - = arityApp (arityType env' fun) (ae_cheap_fn env arg Nothing) - where - env' = env { ae_bndrs = case ae_bndrs env of - { [] -> []; (_:xs) -> xs } } + = arityApp (arityType env fun) (ae_cheap_fn env arg Nothing) -- Case/Let; keep arity if either the expression is cheap -- or it's a 1-shot lambda @@ -767,16 +754,10 @@ arityType env (Case scrut _ _ alts) -- See Note [Dealing with bottom (2)] ATop as | not (ae_ped_bot env) -- Check -fpedantic-bottoms - , is_under scrut -> ATop as + , ae_cheap_fn env scrut Nothing -> ATop as | exprOkForSpeculation scrut -> ATop as | otherwise -> ATop (takeWhile isOneShotInfo as) where - -- is_under implements Note [Dealing with bottom (3)] - is_under (Var f) = f `elem` ae_bndrs env - is_under (App f (Type {})) = is_under f - is_under (Cast f _) = is_under f - is_under _ = False - alts_type = foldr1 andArityType [arityType env rhs | (_,_,rhs) <- alts] arityType env (Let b e) From git at git.haskell.org Tue Feb 18 08:46:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 08:46:36 +0000 (UTC) Subject: [commit: ghc] master: Use NoGen plan for unboxed-tuple bindings (47f473b) Message-ID: <20140218084636.F2D0E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/47f473b0f7ddf21b2cde825166d092cb6e72329d/ghc >--------------------------------------------------------------- commit 47f473b0f7ddf21b2cde825166d092cb6e72329d Author: Simon Peyton Jones Date: Tue Feb 18 08:37:21 2014 +0000 Use NoGen plan for unboxed-tuple bindings There was a small mixup here, exposed by Trac #8762. Now clarified with better function names and comments. >--------------------------------------------------------------- 47f473b0f7ddf21b2cde825166d092cb6e72329d compiler/deSugar/DsExpr.lhs | 6 +-- compiler/hsSyn/HsPat.lhs | 58 ++++++++++----------- compiler/typecheck/TcBinds.lhs | 55 +++++++++---------- testsuite/tests/typecheck/should_compile/T8762.hs | 10 ++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 69 insertions(+), 61 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 47f473b0f7ddf21b2cde825166d092cb6e72329d From git at git.haskell.org Tue Feb 18 08:46:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 08:46:39 +0000 (UTC) Subject: [commit: ghc] master: Allow ($) to return an unlifted type (Trac #8739) (5dd1cbb) Message-ID: <20140218084639.B1AC72406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5dd1cbbfc0a19e92d7eeff6f328abc7558992fd6/ghc >--------------------------------------------------------------- commit 5dd1cbbfc0a19e92d7eeff6f328abc7558992fd6 Author: Simon Peyton Jones Date: Tue Feb 18 08:46:14 2014 +0000 Allow ($) to return an unlifted type (Trac #8739) Since ($) simply returns its result, via a tail call, it can perfectly well have an unlifted result type; e.g. foo $ True where foo :: Bool -> Int# should be perfectly fine. This used to work in GHC 7.2, but caused a Lint failure. This patch makes it work again (which involved removing code in TcExpr), but fixing the Lint failure meant I had to make ($) into a wired-in Id. Which is not hard to do (in MkId). >--------------------------------------------------------------- 5dd1cbbfc0a19e92d7eeff6f328abc7558992fd6 compiler/basicTypes/MkId.lhs | 50 +++++++++++++++----- compiler/prelude/PrelNames.lhs | 5 +- compiler/typecheck/TcExpr.lhs | 17 +++---- testsuite/tests/typecheck/should_compile/T8739.hs | 10 ++++ testsuite/tests/typecheck/should_fail/T7857.stderr | 2 +- testsuite/tests/typecheck/should_run/T8739.hs | 10 ++++ .../should_run/T8739.stdout} | 0 testsuite/tests/typecheck/should_run/all.T | 1 + 8 files changed, 70 insertions(+), 25 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5dd1cbbfc0a19e92d7eeff6f328abc7558992fd6 From git at git.haskell.org Tue Feb 18 11:09:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 11:09:39 +0000 (UTC) Subject: [commit: ghc] master: Add some more traceTcS calls (cd3a3a2) Message-ID: <20140218110939.CF9962406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cd3a3a2da22116a8abcb5133b5c59959bf44cb42/ghc >--------------------------------------------------------------- commit cd3a3a2da22116a8abcb5133b5c59959bf44cb42 Author: Simon Peyton Jones Date: Tue Feb 18 11:06:12 2014 +0000 Add some more traceTcS calls >--------------------------------------------------------------- cd3a3a2da22116a8abcb5133b5c59959bf44cb42 compiler/typecheck/TcCanonical.lhs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs index 823b37f..77e48c2 100644 --- a/compiler/typecheck/TcCanonical.lhs +++ b/compiler/typecheck/TcCanonical.lhs @@ -732,7 +732,8 @@ canEvVarsCreated (ev : evs) emitWorkNC :: [CtEvidence] -> TcS () emitWorkNC evs | null evs = return () - | otherwise = updWorkListTcS (extendWorkListCts (map mk_nc evs)) + | otherwise = do { traceTcS "Emitting fresh work" (vcat (map ppr evs)) + ; updWorkListTcS (extendWorkListCts (map mk_nc evs)) } where mk_nc ev = mkNonCanonical ev @@ -889,7 +890,8 @@ canDecomposableTyConApp ev tc1 tys1 tc2 tys2 -- Fail straight away for better error messages = canEqFailure ev (mkTyConApp tc1 tys1) (mkTyConApp tc2 tys2) | otherwise - = canDecomposableTyConAppOK ev tc1 tys1 tys2 + = do { traceTcS "canDecomposableTyConApp" (ppr ev $$ ppr tc1 $$ ppr tys1 $$ ppr tys2) + ; canDecomposableTyConAppOK ev tc1 tys1 tys2 } canDecomposableTyConAppOK :: CtEvidence -> TyCon -> [TcType] -> [TcType] @@ -1143,7 +1145,7 @@ canEqTyVar2 :: DynFlags -> TcS StopOrContinue -- LHS is an inert type variable, -- and RHS is fully rewritten, but with type synonyms --- preserved as must as possible +-- preserved as much as possible canEqTyVar2 dflags ev swapped tv1 xi2 co2 | Just tv2 <- getTyVar_maybe xi2 @@ -1241,6 +1243,8 @@ checkKind :: CtEvidence -- t1~t2 -- for the type equality; and continue with the kind equality constraint. -- When the latter is solved, it'll kick out the irreducible equality for -- a second attempt at solving +-- +-- See Note [Equalities with incompatible kinds] checkKind new_ev s1 k1 s2 k2 -- See Note [Equalities with incompatible kinds] = ASSERT( isKind k1 && isKind k2 ) From git at git.haskell.org Tue Feb 18 11:09:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 11:09:43 +0000 (UTC) Subject: [commit: ghc] master: Keep kind-inconsistent Given type equalities (fixes Trac #8705) (89d2c04) Message-ID: <20140218110943.3CB9D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/89d2c048c81020a701ac94d949b4d6f1ced37cfa/ghc >--------------------------------------------------------------- commit 89d2c048c81020a701ac94d949b4d6f1ced37cfa Author: Simon Peyton Jones Date: Tue Feb 18 11:07:36 2014 +0000 Keep kind-inconsistent Given type equalities (fixes Trac #8705) I was too eager when fixing Trac #8566, and dropped too many equalities on the floor, thereby causing Trac #8705. The fix is easy: delete code. Lots of new comments! >--------------------------------------------------------------- 89d2c048c81020a701ac94d949b4d6f1ced37cfa compiler/typecheck/TcSMonad.lhs | 34 ++++++++++++++++++++-------------- testsuite/tests/polykinds/T8705.hs | 23 +++++++++++++++++++++++ testsuite/tests/polykinds/all.T | 1 + 3 files changed, 44 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index 2785215..a92bc95 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1638,14 +1638,10 @@ See Note [Coercion evidence terms] in TcEvidence. Note [Do not create Given kind equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We do not want to create a Given like +We do not want to create a Given kind equality like - kv ~ k -- kv is a skolem kind variable - -- Reason we don't yet support non-Refl kind equalities - -or t1::k1 ~ t2::k2 -- k1 and k2 are un-equal kinds - -- Reason: (~) is kind-uniform at the moment, and - -- k1/k2 may be distinct kind skolems + [G] kv ~ k -- kv is a skolem kind variable + -- Reason we don't yet support non-Refl kind equalities This showed up in Trac #8566, where we had a data type data I (u :: U *) (r :: [*]) :: * where @@ -1656,14 +1652,24 @@ so A has type (u ~ AA * k t as) => I u r There is no direct kind equality, but in a pattern match where 'u' is -instantiated to, say, (AA * kk t1 as1), we'd decompose to get +instantiated to, say, (AA * kk (t1:kk) as1), we'd decompose to get k ~ kk, t ~ t1, as ~ as1 -This is bad. We "fix" this by simply ignoring - * the Given kind equality - * AND the Given type equality (t:k1) ~ (t1:kk) - +This is bad. We "fix" this by simply ignoring the Given kind equality But the Right Thing is to add kind equalities! +But note (Trac #8705) that we *do* create Given (non-canonical) equalities +with un-equal kinds, e.g. + [G] t1::k1 ~ t2::k2 -- k1 and k2 are un-equal kinds +Reason: k1 or k2 might be unification variables that have already been +unified (at this point we have not canonicalised the types), so we want +to emit this t1~t2 as a (non-canonical) Given in the work-list. If k1/k2 +have been unified, we'll find that when we canonicalise it, and the +t1~t2 information may be crucial (Trac #8705 is an example). + +If it turns out that k1 and k2 are really un-equal, then it'll end up +as an Irreducible (see Note [Equalities with incompatible kinds] in +TcCanonical), and will do no harm. + \begin{code} xCtEvidence :: CtEvidence -- Original flavor -> XEvTerm -- Instructions about how to manipulate evidence @@ -1677,8 +1683,8 @@ xCtEvidence (CtGiven { ctev_evtm = tm, ctev_loc = loc }) where -- See Note [Do not create Given kind equalities] bad_given_pred (pred_ty, _) - | EqPred t1 t2 <- classifyPredType pred_ty - = isKind t1 || not (typeKind t1 `tcEqKind` typeKind t2) + | EqPred t1 _ <- classifyPredType pred_ty + = isKind t1 | otherwise = False diff --git a/testsuite/tests/polykinds/T8705.hs b/testsuite/tests/polykinds/T8705.hs new file mode 100644 index 0000000..d066f21 --- /dev/null +++ b/testsuite/tests/polykinds/T8705.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, + MultiParamTypeClasses, GADTs, ConstraintKinds, TypeFamilies #-} +module T8705 where + +data family Sing (a :: k) +data Proxy a = Proxy + +data instance Sing (a :: Maybe k) where + SJust :: Sing h -> Sing (Just h) + +data Dict c where + Dict :: c => Dict c + +-- A less-than-or-equal relation among naturals +class a :<=: b + +sLeq :: Sing n -> Sing n2 -> Dict (n :<=: n2) +sLeq = undefined + +insert_ascending :: (lst ~ Just n1) => Proxy n1 -> Sing n -> Sing lst -> Dict (n :<=: n1) +insert_ascending _ n (SJust h) + = case sLeq n h of + Dict -> Dict diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 005c47a..8dc1181 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -98,3 +98,4 @@ test('T8566', normal, compile_fail,['']) test('T8616', normal, compile_fail,['']) test('T8566a', expect_broken(8566), compile,['']) test('T7481', normal, compile_fail,['']) +test('T8705', normal, compile, ['']) From git at git.haskell.org Tue Feb 18 12:16:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 12:16:52 +0000 (UTC) Subject: [commit: ghc] master: Revert "Add comments explaining #8754" (642bba3) Message-ID: <20140218121652.47FE82406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/642bba349fda1508aa136f7169c0ba63fb00a6f9/ghc >--------------------------------------------------------------- commit 642bba349fda1508aa136f7169c0ba63fb00a6f9 Author: Austin Seipp Date: Tue Feb 18 05:20:15 2014 -0600 Revert "Add comments explaining #8754" This reverts commit b626c3d4ce0e66216705ba8355c914dc809e3fe7. >--------------------------------------------------------------- 642bba349fda1508aa136f7169c0ba63fb00a6f9 ghc/Main.hs | 21 +-------------------- 1 file changed, 1 insertion(+), 20 deletions(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index 0011aa9..1aa6553 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -77,7 +77,7 @@ import Data.Maybe main :: IO () main = do - defaultsHook -- See Note [-Bsymbolic and hooks] + defaultsHook hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do @@ -821,23 +821,4 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs [] -> "" suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) -{- Note [-Bsymbolic and hooks] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --Bsymbolic is a flag that prevents the binding of references to global -symbols to symbols outside the shared library being compiled (see `man -ld`). When dynamically linking, we don't use -Bsymbolic on the RTS -package: that is because we want hooks to be overridden by the user, -we don't want to constrain them to the RTS package. - -Unfortunately this seems to have broken somehow on OS X: as a result, -defaultHooks (in hschooks.c) is not called, which does not initialize -the GC stats. As a result, this breaks things like `:set +s` in GHCi -(#8754). As a hacky workaround, we instead call 'defaultHooks' -directly to initalize the flags in the RTS. - -A biproduct of this, I believe, is that hooks are likely broken on OS -X when dynamically linking. But this probably doesn't affect most -people since we're linking GHC dynamically, but most things themselves -link statically. --} foreign import ccall safe "defaultsHook" defaultsHook :: IO () From git at git.haskell.org Tue Feb 18 12:16:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 12:16:54 +0000 (UTC) Subject: [commit: ghc] master: Revert "Fix #8754 in a round-about way." (e789a4f) Message-ID: <20140218121654.9B4172406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e789a4f51b6205160a696e3e6e13ecefb5ae16f7/ghc >--------------------------------------------------------------- commit e789a4f51b6205160a696e3e6e13ecefb5ae16f7 Author: Austin Seipp Date: Tue Feb 18 05:20:25 2014 -0600 Revert "Fix #8754 in a round-about way." This reverts commit 5023c91780e90947680fe0640f7564a4f6448bea. >--------------------------------------------------------------- e789a4f51b6205160a696e3e6e13ecefb5ae16f7 ghc/Main.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index 1aa6553..868042b 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -1,5 +1,4 @@ {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} -{-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- @@ -77,7 +76,6 @@ import Data.Maybe main :: IO () main = do - defaultsHook hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do @@ -820,5 +818,3 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs (case fuzzyMatch f (nub allFlags) of [] -> "" suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) - -foreign import ccall safe "defaultsHook" defaultsHook :: IO () From git at git.haskell.org Tue Feb 18 18:57:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 18:57:49 +0000 (UTC) Subject: [commit: ghc] master: Make CallArity make more use of many-calls (4c93a40) Message-ID: <20140218185749.9C59D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4c93a40db5cf4b81c28173f7a1b22978c7d5a58b/ghc >--------------------------------------------------------------- commit 4c93a40db5cf4b81c28173f7a1b22978c7d5a58b Author: Joachim Breitner Date: Mon Feb 17 17:30:07 2014 +0000 Make CallArity make more use of many-calls by elaborating the domain a bit. >--------------------------------------------------------------- 4c93a40db5cf4b81c28173f7a1b22978c7d5a58b compiler/simplCore/CallArity.hs | 222 +++++++++++++++------------ testsuite/tests/callarity/CallArity1.hs | 34 +++- testsuite/tests/callarity/CallArity1.stderr | 30 +++- 3 files changed, 184 insertions(+), 102 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4c93a40db5cf4b81c28173f7a1b22978c7d5a58b From git at git.haskell.org Tue Feb 18 18:57:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 18:57:52 +0000 (UTC) Subject: [commit: ghc] master: Call Arity refactoring: Use a product domain (fa353f2) Message-ID: <20140218185752.2F35C2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fa353f274df77e6f25a9d311784c9aeabdd6d0ec/ghc >--------------------------------------------------------------- commit fa353f274df77e6f25a9d311784c9aeabdd6d0ec Author: Joachim Breitner Date: Tue Feb 18 09:10:55 2014 +0000 Call Arity refactoring: Use a product domain >--------------------------------------------------------------- fa353f274df77e6f25a9d311784c9aeabdd6d0ec compiler/simplCore/CallArity.hs | 97 ++++++++++++++++++--------------------- 1 file changed, 45 insertions(+), 52 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc fa353f274df77e6f25a9d311784c9aeabdd6d0ec From git at git.haskell.org Tue Feb 18 18:57:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 18:57:54 +0000 (UTC) Subject: [commit: ghc] master: Call Arity: Now also done on Top-Level binds (2ab00bf) Message-ID: <20140218185754.990122406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2ab00bf748635328d586a68be98a1fd78ce3106a/ghc >--------------------------------------------------------------- commit 2ab00bf748635328d586a68be98a1fd78ce3106a Author: Joachim Breitner Date: Tue Feb 18 10:53:22 2014 +0000 Call Arity: Now also done on Top-Level binds >--------------------------------------------------------------- 2ab00bf748635328d586a68be98a1fd78ce3106a compiler/simplCore/CallArity.hs | 141 ++++++++++++++++++++++----------------- 1 file changed, 80 insertions(+), 61 deletions(-) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index b1ad34e..975c703 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -257,14 +257,37 @@ information from the alternatives (resp. the argument). It might be smarter to look for ?more important? variables first, i.e. the innermost recursive variable. +Note [Analysing top-level binds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +We can eta-expand top-level-binds if they are not exported, as we see all calls +to them. The plan is as follows: Treat the top-level binds as nested lets around +a body representing ?all external calls?, which returns a CallArityEnv that calls +every exported function with the top of the lattice. + +This means that the incoming arity on all top-level binds will have a Many +attached, and we will never eta-expand CAFs. Which is good. + -} callArityAnalProgram :: DynFlags -> CoreProgram -> CoreProgram -callArityAnalProgram _dflags = map callArityBind +callArityAnalProgram _dflags binds = binds' + where + (_, binds') = callArityTopLvl [] emptyVarSet binds + +-- See Note [Analysing top-level-binds] +callArityTopLvl :: [Var] -> VarSet -> [CoreBind] -> (CallArityEnv, [CoreBind]) +callArityTopLvl exported _ [] + = (mkVarEnv $ zip exported (repeat topCallCount), []) +callArityTopLvl exported int1 (b:bs) + = (ae2, b':bs') + where + int2 = interestingBinds b + exported' = filter isExportedId int2 ++ exported + int' = int1 `extendVarSetList` int2 + (ae1, bs') = callArityTopLvl exported' int' bs + (ae2, b') = callArityBind ae1 int1 b -callArityBind :: CoreBind -> CoreBind -callArityBind (NonRec id rhs) = NonRec id (callArityRHS rhs) -callArityBind (Rec binds) = Rec $ map (\(id,rhs) -> (id, callArityRHS rhs)) binds callArityRHS :: CoreExpr -> CoreExpr callArityRHS = snd . callArityAnal 0 emptyVarSet @@ -319,67 +342,16 @@ callArityAnal arity int (Lam v e) where (ae, e') = callArityAnal (arity - 1) int e --- Boring non-recursive let, i.e. no eta expansion possible. do not be smart about this --- See Note [Which variables are interesting] -callArityAnal arity int (Let (NonRec v rhs) e) - | exprArity rhs >= length (typeArity (idType v)) - = (ae_final, Let (NonRec v rhs') e') - where - (ae_rhs, rhs') = callArityAnal 0 int rhs - (ae_body, e') = callArityAnal arity int e - ae_body' = ae_body `delVarEnv` v - ae_final = forgetOnceCalls ae_rhs `lubEnv` ae_body' - --- Non-recursive let. Find out how the body calls the rhs, analise that, --- and combine the results, convervatively using both -callArityAnal arity int (Let (NonRec v rhs) e) - = -- pprTrace "callArityAnal:LetNonRec" +-- For lets, use callArityBind +callArityAnal arity int (Let bind e) + = -- pprTrace "callArityAnal:Let" -- (vcat [ppr v, ppr arity, ppr n, ppr final_ae ]) - (final_ae, Let (NonRec v' rhs') e') + (final_ae, Let bind' e') where - int_body = int `extendVarSet` v + int_body = int `extendVarSetList` interestingBinds bind (ae_body, e') = callArityAnal arity int_body e - callcount = lookupWithDefaultVarEnv ae_body topCallCount v + (final_ae, bind') = callArityBind ae_body int bind - (ae_rhs, safe_arity, rhs') = callArityBound callcount int rhs - final_ae = ae_rhs `lubEnv` (ae_body `delVarEnv` v) - v' = v `setIdCallArity` safe_arity - --- Boring recursive let, i.e. no eta expansion possible. do not be smart about this -callArityAnal arity int (Let (Rec [(v,rhs)]) e) - | exprArity rhs >= length (typeArity (idType v)) - = (ae_final, Let (Rec [(v,rhs')]) e') - where - (ae_rhs, rhs') = callArityAnal 0 int rhs - (ae_body, e') = callArityAnal arity int e - ae_final = (forgetOnceCalls ae_rhs `lubEnv` ae_body) `delVarEnv` v - --- Recursive let. --- See Note [Recursion and fixpointing] -callArityAnal arity int (Let (Rec [(v,rhs)]) e) - = -- pprTrace "callArityAnal:LetRec" - -- (vcat [ppr v, ppr arity, ppr safe_arity, ppr rhs_arity', ppr final_ae ]) - (final_ae, Let (Rec [(v',rhs')]) e') - where - int_body = int `extendVarSet` v - (ae_body, e') = callArityAnal arity int_body e - callcount = lookupWithDefaultVarEnv ae_body topCallCount v - - (ae_rhs, new_arity, rhs') = callArityFix callcount int_body v rhs - final_ae = (ae_rhs `lubEnv` ae_body) `delVarEnv` v - v' = v `setIdCallArity` new_arity - - - --- Mutual recursion. Do nothing serious here, for now -callArityAnal arity int (Let (Rec binds) e) - = (final_ae, Let (Rec binds') e') - where - (aes, binds') = unzip $ map go binds - go (i,e) = let (ae,e') = callArityAnal 0 int e - in (forgetOnceCalls ae, (i,e')) - (ae, e') = callArityAnal arity int e - final_ae = foldl lubEnv ae aes `delVarEnvList` map fst binds -- Application. Increase arity for the called expresion, nothing to know about -- the second @@ -409,6 +381,53 @@ callArityAnal arity int (Case scrut bndr ty alts) -- See Note [Case and App: Which side to take?] final_ae = scrut_ae `useBetterOf` alt_ae +-- Which bindings should we look at? +-- See Note [Which variables are interesting] +interestingBinds :: CoreBind -> [Var] +interestingBinds bind = + map fst $ filter go $ case bind of (NonRec v e) -> [(v,e)] + (Rec ves) -> ves + where + go (v,e) = exprArity e < length (typeArity (idType v)) + +-- Used for both local and top-level binds +-- First argument is the demand from the body +callArityBind :: CallArityEnv -> VarSet -> CoreBind -> (CallArityEnv, CoreBind) + +-- Non-recursive let +callArityBind ae_body int (NonRec v rhs) + = -- pprTrace "callArityBind:NonRec" + -- (vcat [ppr v, ppr ae_body, ppr int, ppr ae_rhs, ppr safe_arity]) + (final_ae, NonRec v' rhs') + where + callcount = lookupWithDefaultVarEnv ae_body topCallCount v + (ae_rhs, safe_arity, rhs') = callArityBound callcount int rhs + final_ae = ae_rhs `lubEnv` (ae_body `delVarEnv` v) + v' = v `setIdCallArity` safe_arity + +-- Recursive let. See Note [Recursion and fixpointing] +callArityBind ae_body int b@(Rec [(v,rhs)]) + = -- pprTrace "callArityBind:Rec" + -- (vcat [ppr v, ppr ae_body, ppr int, ppr ae_rhs, ppr new_arity]) + (final_ae, Rec [(v',rhs')]) + where + int_body = int `extendVarSetList` interestingBinds b + callcount = lookupWithDefaultVarEnv ae_body topCallCount v + (ae_rhs, new_arity, rhs') = callArityFix callcount int_body v rhs + final_ae = (ae_rhs `lubEnv` ae_body) `delVarEnv` v + v' = v `setIdCallArity` new_arity + + +-- Mutual recursion. Do nothing serious here, for now +callArityBind ae_body int (Rec binds) + = (final_ae, Rec binds') + where + (aes, binds') = unzip $ map go binds + go (i,e) = let (ae, _, e') = callArityBound topCallCount int e + in (ae, (i,e')) + final_ae = foldl lubEnv ae_body aes `delVarEnvList` map fst binds + + callArityFix :: CallCount -> VarSet -> Id -> CoreExpr -> (CallArityEnv, Arity, CoreExpr) callArityFix arity int v e From git at git.haskell.org Tue Feb 18 18:57:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 18:57:57 +0000 (UTC) Subject: [commit: ghc] master: Call Arity refactoring: instance Outputable Count (7c603ab) Message-ID: <20140218185757.86B3C2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7c603aba2f2ec608d30bb4fdd4b657c5bf684122/ghc >--------------------------------------------------------------- commit 7c603aba2f2ec608d30bb4fdd4b657c5bf684122 Author: Joachim Breitner Date: Tue Feb 18 10:53:15 2014 +0000 Call Arity refactoring: instance Outputable Count >--------------------------------------------------------------- 7c603aba2f2ec608d30bb4fdd4b657c5bf684122 compiler/simplCore/CallArity.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index f7da6c9..b1ad34e 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -16,6 +16,7 @@ import CoreSyn import Id import CoreArity ( exprArity, typeArity ) import CoreUtils ( exprIsHNF ) +import Outputable import Control.Arrow ( first, second ) @@ -482,3 +483,6 @@ ltCallCount c1 c2 = c1 `lteCallCount` c2 && c1 /= c2 lubEnv :: CallArityEnv -> CallArityEnv -> CallArityEnv lubEnv = plusVarEnv_C lubCallCount +instance Outputable Count where + ppr Many = text "Many" + ppr OnceAndOnly = text "OnceAndOnly" From git at git.haskell.org Tue Feb 18 18:57:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 18:57:59 +0000 (UTC) Subject: [commit: ghc] master: Call Arity refactoring: Factor out callArityBound (983fbbe) Message-ID: <20140218185800.1ABFF2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/983fbbe71783c0cf5466d824923db49ada1e51d4/ghc >--------------------------------------------------------------- commit 983fbbe71783c0cf5466d824923db49ada1e51d4 Author: Joachim Breitner Date: Tue Feb 18 09:29:05 2014 +0000 Call Arity refactoring: Factor out callArityBound >--------------------------------------------------------------- 983fbbe71783c0cf5466d824923db49ada1e51d4 compiler/simplCore/CallArity.hs | 71 +++++++++++++++++++++------------------ 1 file changed, 38 insertions(+), 33 deletions(-) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index 682421c..f7da6c9 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -68,7 +68,7 @@ sufficiently. The work-hourse of the analysis is the function `callArityAnal`, with the following type: - data Count = OnceAndOnly | Many + data Count = Many | OnceAndOnly type CallCount = (Count, Arity) type CallArityEnv = VarEnv (CallCount, Arity) callArityAnal :: @@ -269,7 +269,7 @@ callArityRHS :: CoreExpr -> CoreExpr callArityRHS = snd . callArityAnal 0 emptyVarSet -data Count = OnceAndOnly | Many +data Count = Many | OnceAndOnly deriving (Eq, Ord) type CallCount = (Count, Arity) topCallCount :: CallCount @@ -336,19 +336,12 @@ callArityAnal arity int (Let (NonRec v rhs) e) -- (vcat [ppr v, ppr arity, ppr n, ppr final_ae ]) (final_ae, Let (NonRec v' rhs') e') where - is_thunk = not (exprIsHNF rhs) int_body = int `extendVarSet` v (ae_body, e') = callArityAnal arity int_body e - (count, rhs_arity) = lookupWithDefaultVarEnv ae_body topCallCount v + callcount = lookupWithDefaultVarEnv ae_body topCallCount v - safe_arity | OnceAndOnly <- count = rhs_arity - | is_thunk = 0 -- A thunk! Do not eta-expand - | otherwise = rhs_arity - - (ae_rhs, rhs') = callArityAnal safe_arity int rhs - ae_rhs' | OnceAndOnly <- count = ae_rhs - | otherwise = forgetOnceCalls ae_rhs - final_ae = ae_rhs' `lubEnv` (ae_body `delVarEnv` v) + (ae_rhs, safe_arity, rhs') = callArityBound callcount int rhs + final_ae = ae_rhs `lubEnv` (ae_body `delVarEnv` v) v' = v `setIdCallArity` safe_arity -- Boring recursive let, i.e. no eta expansion possible. do not be smart about this @@ -367,19 +360,12 @@ callArityAnal arity int (Let (Rec [(v,rhs)]) e) -- (vcat [ppr v, ppr arity, ppr safe_arity, ppr rhs_arity', ppr final_ae ]) (final_ae, Let (Rec [(v',rhs')]) e') where - is_thunk = not (exprIsHNF rhs) int_body = int `extendVarSet` v (ae_body, e') = callArityAnal arity int_body e - (count, rhs_arity) = lookupWithDefaultVarEnv ae_body topCallCount v + callcount = lookupWithDefaultVarEnv ae_body topCallCount v - safe_arity | OnceAndOnly <- count = rhs_arity - | is_thunk = 0 -- A thunk! Do not eta-expand - | otherwise = rhs_arity - - (ae_rhs, new_arity, rhs') = callArityFix safe_arity int_body v rhs - ae_rhs' | OnceAndOnly <- count = ae_rhs - | otherwise = forgetOnceCalls ae_rhs - final_ae = (ae_rhs' `lubEnv` ae_body) `delVarEnv` v + (ae_rhs, new_arity, rhs') = callArityFix callcount int_body v rhs + final_ae = (ae_rhs `lubEnv` ae_body) `delVarEnv` v v' = v `setIdCallArity` new_arity @@ -422,34 +408,46 @@ callArityAnal arity int (Case scrut bndr ty alts) -- See Note [Case and App: Which side to take?] final_ae = scrut_ae `useBetterOf` alt_ae -callArityFix :: Arity -> VarSet -> Id -> CoreExpr -> (CallArityEnv, Arity, CoreExpr) +callArityFix :: CallCount -> VarSet -> Id -> CoreExpr -> (CallArityEnv, Arity, CoreExpr) callArityFix arity int v e - | arity <= min_arity + | arity `lteCallCount` min_arity -- The incoming arity is already lower than the exprArity, so we can -- ignore the arity coming from the RHS - = (final_ae `delVarEnv` v, 0, e') + = (ae `delVarEnv` v, 0, e') | otherwise - = if safe_arity < arity + = if new_arity `ltCallCount` arity -- RHS puts a lower arity on itself, so try that - then callArityFix safe_arity int v e + then callArityFix new_arity int v e -- RHS calls itself with at least as many arguments as the body of the let: Great! - else (final_ae `delVarEnv` v, safe_arity, e') + else (ae `delVarEnv` v, safe_arity, e') where - (ae, e') = callArityAnal arity int e - (count, new_arity) = lookupWithDefaultVarEnv ae topCallCount v - min_arity = exprArity e + (ae, safe_arity, e') = callArityBound arity int e + new_arity = lookupWithDefaultVarEnv ae topCallCount v + min_arity = (Many, exprArity e) + +-- This is a variant of callArityAnal that takes a CallCount (i.e. an arity with a +-- cardinality) and adjust the resulting environment accordingly. It is to be used +-- on bound expressions that can possibly be shared. +-- It also returns the safe arity used: For a thunk that is called multiple +-- times, this will be 0! +callArityBound :: CallCount -> VarSet -> CoreExpr -> (CallArityEnv, Arity, CoreExpr) +callArityBound (count, arity) int e = (final_ae, safe_arity, e') + where is_thunk = not (exprIsHNF e) - safe_arity | OnceAndOnly <- count = new_arity + safe_arity | OnceAndOnly <- count = arity | is_thunk = 0 -- A thunk! Do not eta-expand - | otherwise = new_arity + | otherwise = arity + + (ae, e') = callArityAnal safe_arity int e final_ae | OnceAndOnly <- count = ae | otherwise = forgetOnceCalls ae + anyGoodCalls :: CallArityEnv -> Bool anyGoodCalls = foldVarEnv ((||) . isOnceCall) False @@ -473,6 +471,13 @@ lubCount :: Count -> Count -> Count lubCount OnceAndOnly OnceAndOnly = OnceAndOnly lubCount _ _ = Many +lteCallCount :: CallCount -> CallCount -> Bool +lteCallCount (count1, arity1) (count2, arity2) + = count1 <= count2 && arity1 <= arity2 + +ltCallCount :: CallCount -> CallCount -> Bool +ltCallCount c1 c2 = c1 `lteCallCount` c2 && c1 /= c2 + -- Used when combining results from alternative cases; take the minimum lubEnv :: CallArityEnv -> CallArityEnv -> CallArityEnv lubEnv = plusVarEnv_C lubCallCount From git at git.haskell.org Tue Feb 18 18:58:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 18:58:02 +0000 (UTC) Subject: [commit: ghc] master: Move unit call arity unittests into subdirectory (7e787e7) Message-ID: <20140218185802.D2FEF2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7e787e7e7e3c21b909e53f0f450a2493e064ac03/ghc >--------------------------------------------------------------- commit 7e787e7e7e3c21b909e53f0f450a2493e064ac03 Author: Joachim Breitner Date: Tue Feb 18 12:01:06 2014 +0000 Move unit call arity unittests into subdirectory >--------------------------------------------------------------- 7e787e7e7e3c21b909e53f0f450a2493e064ac03 testsuite/tests/callarity/{ => unittest}/CallArity1.hs | 0 testsuite/tests/callarity/{ => unittest}/CallArity1.stderr | 0 testsuite/tests/callarity/{ => unittest}/all.T | 0 3 files changed, 0 insertions(+), 0 deletions(-) diff --git a/testsuite/tests/callarity/CallArity1.hs b/testsuite/tests/callarity/unittest/CallArity1.hs similarity index 100% rename from testsuite/tests/callarity/CallArity1.hs rename to testsuite/tests/callarity/unittest/CallArity1.hs diff --git a/testsuite/tests/callarity/CallArity1.stderr b/testsuite/tests/callarity/unittest/CallArity1.stderr similarity index 100% rename from testsuite/tests/callarity/CallArity1.stderr rename to testsuite/tests/callarity/unittest/CallArity1.stderr diff --git a/testsuite/tests/callarity/all.T b/testsuite/tests/callarity/unittest/all.T similarity index 100% rename from testsuite/tests/callarity/all.T rename to testsuite/tests/callarity/unittest/all.T From git at git.haskell.org Tue Feb 18 18:58:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 18:58:05 +0000 (UTC) Subject: [commit: ghc] master: Call arity: Handle type application correctly (d51d7ef) Message-ID: <20140218185805.4B7EB2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d51d7efd67fec4fd55b42c95d5a8cf17759b9023/ghc >--------------------------------------------------------------- commit d51d7efd67fec4fd55b42c95d5a8cf17759b9023 Author: Joachim Breitner Date: Tue Feb 18 14:11:11 2014 +0000 Call arity: Handle type application correctly >--------------------------------------------------------------- d51d7efd67fec4fd55b42c95d5a8cf17759b9023 compiler/simplCore/CallArity.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index 975c703..ccde1ae 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -329,6 +329,10 @@ callArityAnal arity int e@(Var v) | otherwise = (emptyVarEnv, e) +-- Non-value lambdas are ignored +callArityAnal arity int (Lam v e) | not (isId v) + = second (Lam v) $ callArityAnal arity int e + -- We have a lambda that we are not sure to call. Tail calls therein -- are no longer OneAndOnly calls callArityAnal 0 int (Lam v e) @@ -355,6 +359,8 @@ callArityAnal arity int (Let bind e) -- Application. Increase arity for the called expresion, nothing to know about -- the second +callArityAnal arity int (App e (Type t)) + = second (\e -> App e (Type t)) $ callArityAnal arity int e callArityAnal arity int (App e1 e2) = (final_ae, App e1' e2') where From git at git.haskell.org Tue Feb 18 18:58:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 18:58:08 +0000 (UTC) Subject: [commit: ghc] master: Call arity testcase for #3924 (d3c579c) Message-ID: <20140218185808.26D702406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d3c579c75ffec4346a043582d89205998790145e/ghc >--------------------------------------------------------------- commit d3c579c75ffec4346a043582d89205998790145e Author: Joachim Breitner Date: Tue Feb 18 12:02:11 2014 +0000 Call arity testcase for #3924 nice numbers coming from these micro-benchmarks. >--------------------------------------------------------------- d3c579c75ffec4346a043582d89205998790145e .../should_compile => callarity/perf}/Makefile | 0 testsuite/tests/callarity/perf/T3924.hs | 13 +++++++++++++ testsuite/tests/callarity/perf/T3924.stdout | 1 + testsuite/tests/callarity/perf/all.T | 8 ++++++++ 4 files changed, 22 insertions(+) diff --git a/testsuite/tests/annotations/should_compile/Makefile b/testsuite/tests/callarity/perf/Makefile similarity index 100% copy from testsuite/tests/annotations/should_compile/Makefile copy to testsuite/tests/callarity/perf/Makefile diff --git a/testsuite/tests/callarity/perf/T3924.hs b/testsuite/tests/callarity/perf/T3924.hs new file mode 100644 index 0000000..164a3a6 --- /dev/null +++ b/testsuite/tests/callarity/perf/T3924.hs @@ -0,0 +1,13 @@ +f2 :: Int -> Int -> Int +f2 x1 = if x1 == 0 then (\x0 -> x0) else let + y = x1 - 1 + in f3 y y +f3 :: Int -> Int -> Int -> Int +f3 x2 = if x2 == 0 then f2 else let + y = x2 - 1 + in f4 y y +f4 :: Int -> Int -> Int -> Int -> Int +f4 x3 = if x3 == 0 then f3 else let + y = x3 - 1 + in \x2 x1 x0 -> f4 y x2 x1 (y + x0) +main = print (f2 100 0) diff --git a/testsuite/tests/callarity/perf/T3924.stdout b/testsuite/tests/callarity/perf/T3924.stdout new file mode 100644 index 0000000..13c5c81 --- /dev/null +++ b/testsuite/tests/callarity/perf/T3924.stdout @@ -0,0 +1 @@ +3921225 diff --git a/testsuite/tests/callarity/perf/all.T b/testsuite/tests/callarity/perf/all.T new file mode 100644 index 0000000..d5a1108 --- /dev/null +++ b/testsuite/tests/callarity/perf/all.T @@ -0,0 +1,8 @@ +test('T3924', + [stats_num_field('bytes allocated', (51480, 5)), + # previously, without call-arity: 22326544 + # 2014-01-18: 51480 (amd64/Linux) + only_ways(['normal']) + ], + compile_and_run, + ['-O']) From git at git.haskell.org Tue Feb 18 18:58:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 18:58:10 +0000 (UTC) Subject: [commit: ghc] master: Support mutual recursion (f347bfe) Message-ID: <20140218185810.94A722406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f347bfeae0d73d248032e32323a63dae8d5af828/ghc >--------------------------------------------------------------- commit f347bfeae0d73d248032e32323a63dae8d5af828 Author: Joachim Breitner Date: Tue Feb 18 11:50:19 2014 +0000 Support mutual recursion >--------------------------------------------------------------- f347bfeae0d73d248032e32323a63dae8d5af828 compiler/simplCore/CallArity.hs | 118 ++++++++++++-------- testsuite/tests/callarity/unittest/CallArity1.hs | 7 +- .../tests/callarity/unittest/CallArity1.stderr | 10 +- 3 files changed, 82 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 f347bfeae0d73d248032e32323a63dae8d5af828 From git at git.haskell.org Tue Feb 18 18:58:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 18:58:12 +0000 (UTC) Subject: [commit: ghc] master: Call Arity: Update compiler perf number changes (ba4616b) Message-ID: <20140218185813.0C50A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ba4616b68584dddc6bb40cf58dfd43c3b24899e3/ghc >--------------------------------------------------------------- commit ba4616b68584dddc6bb40cf58dfd43c3b24899e3 Author: Joachim Breitner Date: Tue Feb 18 18:18:47 2014 +0000 Call Arity: Update compiler perf number changes Lots of improvements, one regression in max bytes allocated. >--------------------------------------------------------------- ba4616b68584dddc6bb40cf58dfd43c3b24899e3 testsuite/tests/perf/compiler/all.T | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 947c6f0..2299b46 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -133,15 +133,14 @@ test('T3294', # 2012-10-08: 1373514844 (x86/Linux) # 2013-11-13: 1478325844 (x86/Windows, 64bit machine) # 2014-01-12: 1565185140 (x86/Linux) - (wordsize(64), 3083825616, 5)]), + (wordsize(64), 2897630040, 5)]), # old: 1357587088 (amd64/Linux) # 29/08/2012: 2961778696 (amd64/Linux) # (^ increase due to new codegen, see #7198) # 18/09/2012: 2717327208 (amd64/Linux) - # 08/06/2013: 2901451552 (amd64/Linux) - # (^ reason unknown) - # 12/12/2013: 3083825616 (amd64/Linux) - # (^ reason unknown) + # 08/06/2013: 2901451552 (amd64/Linux) (reason unknown) + # 12/12/2013: 3083825616 (amd64/Linux) (reason unknown) + # 18/02/2014: 2897630040 (amd64/Linux) (call arity improvements) conf_3294 ], compile, @@ -185,7 +184,7 @@ test('T4801', # 2013-02-10: 11207828 (x86/OSX) # (some date): 11139444 # 2013-11-13: 11829000 (x86/Windows, 64bit machine) - (wordsize(64), 22646000, 10)]), + (wordsize(64), 25002136, 10)]), # prev: 20486256 (amd64/OS X) # 30/08/2012: 17305600--20391920 (varies a lot) # 19/10/2012: 26882576 (-fPIC turned on) @@ -193,6 +192,7 @@ test('T4801', # 24/12/2012: 21657520 (perhaps gc sampling time wibbles?) # 10/01/2014: 25166280 # 13/01/2014: 22646000 (mostly due to #8647) + # 18/02/2014: 25002136 (call arity analysis changes) only_ways(['normal']), extra_hc_opts('-static') ], @@ -283,9 +283,10 @@ test('T5631', [compiler_stats_num_field('bytes allocated', [(wordsize(32), 392904228, 10), # expected value: 392904228 (x86/Linux) - (wordsize(64), 735486328, 5)]), + (wordsize(64), 690742040, 5)]), # expected value: 774595008 (amd64/Linux): # expected value: 735486328 (amd64/Linux) 2012/12/12: + # expected value: 690742040 (amd64/Linux) Call Arity improvements only_ways(['normal']) ], compile, @@ -391,8 +392,9 @@ test('T6048', [(wordsize(32), 48887164, 10), # prev: 38000000 (x86/Linux) # 2012-10-08: 48887164 (x86/Linux) - (wordsize(64), 108578664, 10)]) + (wordsize(64), 95960720, 10)]) # 18/09/2012 97247032 amd64/Linux - # 16/01/2014 108578664 amd64/Linux (unknown) + # 16/01/2014 108578664 amd64/Linux (unknown, likely foldl-via-foldr) + # 18/01/2014 95960720 amd64/Linux Call Arity improvements ], compile,['']) From git at git.haskell.org Tue Feb 18 19:01:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 19:01:14 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T7994-calledArity' created Message-ID: <20140218190114.E140F2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T7994-calledArity Referencing: af7428e8bfe056cccb5035c21a91c6117a908c1a From git at git.haskell.org Tue Feb 18 19:01:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 19:01:17 +0000 (UTC) Subject: [commit: ghc] wip/T7994-calledArity: Call Arity refactoring: fakeBoringCalls (af7428e) Message-ID: <20140218190117.6F42B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T7994-calledArity Link : http://ghc.haskell.org/trac/ghc/changeset/af7428e8bfe056cccb5035c21a91c6117a908c1a/ghc >--------------------------------------------------------------- commit af7428e8bfe056cccb5035c21a91c6117a908c1a Author: Joachim Breitner Date: Tue Feb 18 19:02:24 2014 +0000 Call Arity refactoring: fakeBoringCalls >--------------------------------------------------------------- af7428e8bfe056cccb5035c21a91c6117a908c1a compiler/simplCore/CallArity.hs | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index 7f62070..f3fedb5 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -396,21 +396,16 @@ interestingBinds bind = where go (v,e) = exprArity e < length (typeArity (idType v)) -boringBinds :: CoreBind -> [Var] -boringBinds bind = - map fst $ filter go $ case bind of (NonRec v e) -> [(v,e)] - (Rec ves) -> ves - where - go (v,e) = exprArity e >= length (typeArity (idType v)) - addInterestingBinds :: VarSet -> CoreBind -> VarSet addInterestingBinds int bind = int `delVarSetList` bindersOf bind -- Possible shadowing `extendVarSetList` interestingBinds bind -addBoringCalls :: CallArityEnv -> CoreBind -> CallArityEnv -addBoringCalls ae bind - = ae `lubEnv` (mkVarEnv $ zip (boringBinds bind) (repeat topCallCount)) +-- This function pretens a (Many 0) call for every variable bound in the binder +-- that is not interesting, as calls to these are not reported by the analysis. +fakeBoringCalls :: VarSet -> CoreBind -> CallArityEnv +fakeBoringCalls int bind + = mkVarEnv [ (v, topCallCount) | v <- bindersOf bind, not (v `elemVarSet` int) ] -- Used for both local and top-level binds -- First argument is the demand from the body @@ -433,7 +428,7 @@ callArityBind ae_body int b@(Rec binds) where int_body = int `addInterestingBinds` b -- We are ignoring calls to boring binds, so we need to pretend them here! - ae_body' = ae_body `addBoringCalls` b + ae_body' = ae_body `lubEnv` (fakeBoringCalls int_body b) (ae_rhs, binds') = callArityFix ae_body' int_body [(i,Nothing,e) | (i,e) <- binds] final_ae = ae_rhs `delVarEnvList` interestingBinds b From git at git.haskell.org Tue Feb 18 19:01:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 19:01:31 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T7994-calledArity' deleted Message-ID: <20140218190131.21B872406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T7994-calledArity From git at git.haskell.org Tue Feb 18 19:01:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Feb 2014 19:01:33 +0000 (UTC) Subject: [commit: ghc] master's head updated: Call Arity refactoring: fakeBoringCalls (af7428e) Message-ID: <20140218190133.DAC832406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'master' now includes: af7428e Call Arity refactoring: fakeBoringCalls From git at git.haskell.org Wed Feb 19 05:12:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 05:12:54 +0000 (UTC) Subject: [commit: haddock] master: Use a bespoke data type to indicate fixity (91e2c21) Message-ID: <20140219051254.4CC492406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/91e2c21cfdaca7913dbfec17bdd7712c0c1ed732 >--------------------------------------------------------------- commit 91e2c21cfdaca7913dbfec17bdd7712c0c1ed732 Author: Mateusz Kowalczyk Date: Wed Feb 19 05:11:34 2014 +0000 Use a bespoke data type to indicate fixity This deals with what I imagine was an ancient TODO and makes it much clearer what the argument actually does rather than having the user chase down the comment. >--------------------------------------------------------------- 91e2c21cfdaca7913dbfec17bdd7712c0c1ed732 src/Haddock/Backends/Xhtml.hs | 12 ++-- src/Haddock/Backends/Xhtml/Decl.hs | 24 ++++---- src/Haddock/Backends/Xhtml/DocMarkup.hs | 4 +- src/Haddock/Backends/Xhtml/Names.hs | 92 +++++++++++++++---------------- 4 files changed, 66 insertions(+), 66 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 91e2c21cfdaca7913dbfec17bdd7712c0c1ed732 From git at git.haskell.org Wed Feb 19 09:11:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 09:11:21 +0000 (UTC) Subject: [commit: ghc] tag 'ghc-7.9-start' created Message-ID: <20140219091121.C57612406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New tag : ghc-7.9-start Referencing: d5bb1b81c9df115968eb9a88997721f1bad07f30 From git at git.haskell.org Wed Feb 19 14:00:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 14:00:39 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Keep kind-inconsistent Given type equalities (fixes Trac #8705) (9182957) Message-ID: <20140219140039.8384E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/91829577019cf66a79dd54c0f6e9b87d1d9edc81/ghc >--------------------------------------------------------------- commit 91829577019cf66a79dd54c0f6e9b87d1d9edc81 Author: Simon Peyton Jones Date: Tue Feb 18 11:07:36 2014 +0000 Keep kind-inconsistent Given type equalities (fixes Trac #8705) I was too eager when fixing Trac #8566, and dropped too many equalities on the floor, thereby causing Trac #8705. The fix is easy: delete code. Lots of new comments! (cherry picked from commit 89d2c048c81020a701ac94d949b4d6f1ced37cfa) >--------------------------------------------------------------- 91829577019cf66a79dd54c0f6e9b87d1d9edc81 compiler/typecheck/TcSMonad.lhs | 34 ++++++++++++++++++++-------------- testsuite/tests/polykinds/T8705.hs | 23 +++++++++++++++++++++++ testsuite/tests/polykinds/all.T | 1 + 3 files changed, 44 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index 634e926..1cc18d1 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1638,14 +1638,10 @@ See Note [Coercion evidence terms] in TcEvidence. Note [Do not create Given kind equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We do not want to create a Given like +We do not want to create a Given kind equality like - kv ~ k -- kv is a skolem kind variable - -- Reason we don't yet support non-Refl kind equalities - -or t1::k1 ~ t2::k2 -- k1 and k2 are un-equal kinds - -- Reason: (~) is kind-uniform at the moment, and - -- k1/k2 may be distinct kind skolems + [G] kv ~ k -- kv is a skolem kind variable + -- Reason we don't yet support non-Refl kind equalities This showed up in Trac #8566, where we had a data type data I (u :: U *) (r :: [*]) :: * where @@ -1656,14 +1652,24 @@ so A has type (u ~ AA * k t as) => I u r There is no direct kind equality, but in a pattern match where 'u' is -instantiated to, say, (AA * kk t1 as1), we'd decompose to get +instantiated to, say, (AA * kk (t1:kk) as1), we'd decompose to get k ~ kk, t ~ t1, as ~ as1 -This is bad. We "fix" this by simply ignoring - * the Given kind equality - * AND the Given type equality (t:k1) ~ (t1:kk) - +This is bad. We "fix" this by simply ignoring the Given kind equality But the Right Thing is to add kind equalities! +But note (Trac #8705) that we *do* create Given (non-canonical) equalities +with un-equal kinds, e.g. + [G] t1::k1 ~ t2::k2 -- k1 and k2 are un-equal kinds +Reason: k1 or k2 might be unification variables that have already been +unified (at this point we have not canonicalised the types), so we want +to emit this t1~t2 as a (non-canonical) Given in the work-list. If k1/k2 +have been unified, we'll find that when we canonicalise it, and the +t1~t2 information may be crucial (Trac #8705 is an example). + +If it turns out that k1 and k2 are really un-equal, then it'll end up +as an Irreducible (see Note [Equalities with incompatible kinds] in +TcCanonical), and will do no harm. + \begin{code} xCtEvidence :: CtEvidence -- Original flavor -> XEvTerm -- Instructions about how to manipulate evidence @@ -1677,8 +1683,8 @@ xCtEvidence (CtGiven { ctev_evtm = tm, ctev_loc = loc }) where -- See Note [Do not create Given kind equalities] bad_given_pred (pred_ty, _) - | EqPred t1 t2 <- classifyPredType pred_ty - = isKind t1 || not (typeKind t1 `tcEqKind` typeKind t2) + | EqPred t1 _ <- classifyPredType pred_ty + = isKind t1 | otherwise = False diff --git a/testsuite/tests/polykinds/T8705.hs b/testsuite/tests/polykinds/T8705.hs new file mode 100644 index 0000000..d066f21 --- /dev/null +++ b/testsuite/tests/polykinds/T8705.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, + MultiParamTypeClasses, GADTs, ConstraintKinds, TypeFamilies #-} +module T8705 where + +data family Sing (a :: k) +data Proxy a = Proxy + +data instance Sing (a :: Maybe k) where + SJust :: Sing h -> Sing (Just h) + +data Dict c where + Dict :: c => Dict c + +-- A less-than-or-equal relation among naturals +class a :<=: b + +sLeq :: Sing n -> Sing n2 -> Dict (n :<=: n2) +sLeq = undefined + +insert_ascending :: (lst ~ Just n1) => Proxy n1 -> Sing n -> Sing lst -> Dict (n :<=: n1) +insert_ascending _ n (SJust h) + = case sLeq n h of + Dict -> Dict diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 005c47a..8dc1181 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -98,3 +98,4 @@ test('T8566', normal, compile_fail,['']) test('T8616', normal, compile_fail,['']) test('T8566a', expect_broken(8566), compile,['']) test('T7481', normal, compile_fail,['']) +test('T8705', normal, compile, ['']) From git at git.haskell.org Wed Feb 19 14:00:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 14:00:41 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Allow ($) to return an unlifted type (Trac #8739) (a455437) Message-ID: <20140219140041.E3D032406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/a455437980c6f6a96190ac97b7757f4399376f63/ghc >--------------------------------------------------------------- commit a455437980c6f6a96190ac97b7757f4399376f63 Author: Simon Peyton Jones Date: Tue Feb 18 08:46:14 2014 +0000 Allow ($) to return an unlifted type (Trac #8739) Since ($) simply returns its result, via a tail call, it can perfectly well have an unlifted result type; e.g. foo $ True where foo :: Bool -> Int# should be perfectly fine. This used to work in GHC 7.2, but caused a Lint failure. This patch makes it work again (which involved removing code in TcExpr), but fixing the Lint failure meant I had to make ($) into a wired-in Id. Which is not hard to do (in MkId). (cherry picked from commit 5dd1cbbfc0a19e92d7eeff6f328abc7558992fd6) >--------------------------------------------------------------- a455437980c6f6a96190ac97b7757f4399376f63 compiler/basicTypes/MkId.lhs | 50 +++++++++++++++----- compiler/prelude/PrelNames.lhs | 5 +- compiler/typecheck/TcExpr.lhs | 17 +++---- testsuite/tests/typecheck/should_compile/T8739.hs | 10 ++++ testsuite/tests/typecheck/should_fail/T7857.stderr | 2 +- testsuite/tests/typecheck/should_run/T8739.hs | 10 ++++ .../should_run/T8739.stdout} | 0 testsuite/tests/typecheck/should_run/all.T | 1 + 8 files changed, 70 insertions(+), 25 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a455437980c6f6a96190ac97b7757f4399376f63 From git at git.haskell.org Wed Feb 19 14:00:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 14:00:45 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Use NoGen plan for unboxed-tuple bindings (298dbfa) Message-ID: <20140219140045.61A012406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/298dbfa59759aa4dbeea274534b6c68a813e3373/ghc >--------------------------------------------------------------- commit 298dbfa59759aa4dbeea274534b6c68a813e3373 Author: Simon Peyton Jones Date: Tue Feb 18 08:37:21 2014 +0000 Use NoGen plan for unboxed-tuple bindings There was a small mixup here, exposed by Trac #8762. Now clarified with better function names and comments. (cherry picked from commit 47f473b0f7ddf21b2cde825166d092cb6e72329d) >--------------------------------------------------------------- 298dbfa59759aa4dbeea274534b6c68a813e3373 compiler/deSugar/DsExpr.lhs | 6 +-- compiler/hsSyn/HsPat.lhs | 58 ++++++++++----------- compiler/typecheck/TcBinds.lhs | 55 +++++++++---------- testsuite/tests/typecheck/should_compile/T8762.hs | 10 ++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 69 insertions(+), 61 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 298dbfa59759aa4dbeea274534b6c68a813e3373 From git at git.haskell.org Wed Feb 19 14:00:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 14:00:48 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Revert "Add comments explaining #8754" (d1699f9) Message-ID: <20140219140048.9A8E82406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/d1699f9a6c1bfc4930f61d27302985196020f909/ghc >--------------------------------------------------------------- commit d1699f9a6c1bfc4930f61d27302985196020f909 Author: Austin Seipp Date: Tue Feb 18 05:20:15 2014 -0600 Revert "Add comments explaining #8754" This reverts commit b626c3d4ce0e66216705ba8355c914dc809e3fe7. (cherry picked from commit 642bba349fda1508aa136f7169c0ba63fb00a6f9) >--------------------------------------------------------------- d1699f9a6c1bfc4930f61d27302985196020f909 ghc/Main.hs | 21 +-------------------- 1 file changed, 1 insertion(+), 20 deletions(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index 0011aa9..1aa6553 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -77,7 +77,7 @@ import Data.Maybe main :: IO () main = do - defaultsHook -- See Note [-Bsymbolic and hooks] + defaultsHook hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do @@ -821,23 +821,4 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs [] -> "" suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) -{- Note [-Bsymbolic and hooks] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --Bsymbolic is a flag that prevents the binding of references to global -symbols to symbols outside the shared library being compiled (see `man -ld`). When dynamically linking, we don't use -Bsymbolic on the RTS -package: that is because we want hooks to be overridden by the user, -we don't want to constrain them to the RTS package. - -Unfortunately this seems to have broken somehow on OS X: as a result, -defaultHooks (in hschooks.c) is not called, which does not initialize -the GC stats. As a result, this breaks things like `:set +s` in GHCi -(#8754). As a hacky workaround, we instead call 'defaultHooks' -directly to initalize the flags in the RTS. - -A biproduct of this, I believe, is that hooks are likely broken on OS -X when dynamically linking. But this probably doesn't affect most -people since we're linking GHC dynamically, but most things themselves -link statically. --} foreign import ccall safe "defaultsHook" defaultsHook :: IO () From git at git.haskell.org Wed Feb 19 14:00:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 14:00:51 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Revert "Fix #8754 in a round-about way." (525db2a) Message-ID: <20140219140051.B968B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/525db2ab17665330c353891cc33a9598296a8ef3/ghc >--------------------------------------------------------------- commit 525db2ab17665330c353891cc33a9598296a8ef3 Author: Austin Seipp Date: Tue Feb 18 05:20:25 2014 -0600 Revert "Fix #8754 in a round-about way." This reverts commit 5023c91780e90947680fe0640f7564a4f6448bea. (cherry picked from commit e789a4f51b6205160a696e3e6e13ecefb5ae16f7) >--------------------------------------------------------------- 525db2ab17665330c353891cc33a9598296a8ef3 ghc/Main.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index 1aa6553..868042b 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -1,5 +1,4 @@ {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} -{-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- @@ -77,7 +76,6 @@ import Data.Maybe main :: IO () main = do - defaultsHook hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do @@ -820,5 +818,3 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs (case fuzzyMatch f (nub allFlags) of [] -> "" suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) - -foreign import ccall safe "defaultsHook" defaultsHook :: IO () From git at git.haskell.org Wed Feb 19 22:00:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 22:00:28 +0000 (UTC) Subject: [commit: packages/base] master: Use new bitwise Int# primops in Data.Bits (re #8791) (0fc4fb5) Message-ID: <20140219220028.209DE2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0fc4fb5477d3ca22a8b6894db5b1112b9badfdc4/base >--------------------------------------------------------------- commit 0fc4fb5477d3ca22a8b6894db5b1112b9badfdc4 Author: Chris Dueck Date: Wed Feb 19 22:18:14 2014 +0100 Use new bitwise Int# primops in Data.Bits (re #8791) The new primops (see also #7689) allow to optimize `instance Bits Int` by allowing to operate directly on Int# instead of having to convert to Word# and back to Int# again. Authored-by: Chris Dueck Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 0fc4fb5477d3ca22a8b6894db5b1112b9badfdc4 Data/Bits.hs | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/Data/Bits.hs b/Data/Bits.hs index 16a5b58..c6bd8da 100644 --- a/Data/Bits.hs +++ b/Data/Bits.hs @@ -347,14 +347,10 @@ instance Bits Int where testBit = testBitDefault - (I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#)) - - (I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#)) - - (I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#)) - - complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#))) - + (I# x#) .&. (I# y#) = I# (x# `andI#` y#) + (I# x#) .|. (I# y#) = I# (x# `orI#` y#) + (I# x#) `xor` (I# y#) = I# (x# `xorI#` y#) + complement (I# x#) = I# (notI# x#) (I# x#) `shift` (I# i#) | isTrue# (i# >=# 0#) = I# (x# `iShiftL#` i#) | otherwise = I# (x# `iShiftRA#` negateInt# i#) @@ -365,11 +361,9 @@ instance Bits Int where {-# INLINE rotate #-} -- See Note [Constant folding for rotate] (I# x#) `rotate` (I# i#) = - I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` - (x'# `uncheckedShiftRL#` (wsib -# i'#)))) + I# ((x# `uncheckedIShiftL#` i'#) `orI#` (x# `uncheckedIShiftRL#` (wsib -# i'#))) where - !x'# = int2Word# x# - !i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#)) + !i'# = i# `andI#` (wsib -# 1#) !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -} bitSizeMaybe i = Just (finiteBitSize i) bitSize i = finiteBitSize i @@ -402,7 +396,7 @@ instance Bits Word where | isTrue# (i'# ==# 0#) = W# x# | otherwise = W# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (wsib -# i'#))) where - !i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#)) + !i'# = i# `andI#` (wsib -# 1#) !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -} bitSizeMaybe i = Just (finiteBitSize i) bitSize i = finiteBitSize i From git at git.haskell.org Wed Feb 19 22:22:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 22:22:37 +0000 (UTC) Subject: [commit: packages/base] master: Minor typo in comment (b5105a7) Message-ID: <20140219222237.D05902406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b5105a796357b9293698c06e036ae697a83d69bd/base >--------------------------------------------------------------- commit b5105a796357b9293698c06e036ae697a83d69bd Author: Gabor Greif Date: Wed Feb 19 23:22:04 2014 +0100 Minor typo in comment >--------------------------------------------------------------- b5105a796357b9293698c06e036ae697a83d69bd GHC/Enum.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GHC/Enum.lhs b/GHC/Enum.lhs index c8208fa..fe2e6b6 100644 --- a/GHC/Enum.lhs +++ b/GHC/Enum.lhs @@ -708,7 +708,7 @@ enumDeltaToIntegerFB c n x delta lim -- and also that we have the chance to inline up_fb, which would allow the constuctor to be -- inlined and good things to happen. -- We do not do it for Int this way because hand-tuned code already exists, and --- the sepcial case varies more from the general case, due to the issue of overflows. +-- the special case varies more from the general case, due to the issue of overflows. {-# NOINLINE [1] enumDeltaToInteger #-} enumDeltaToInteger :: Integer -> Integer -> Integer -> [Integer] From git at git.haskell.org Wed Feb 19 22:24:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 22:24:42 +0000 (UTC) Subject: [commit: packages/primitive] ghc-head: Add a couple more changelog entries (f059c20) Message-ID: <20140219222443.4C9F52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/primitive On branch : ghc-head Link : http://git.haskell.org/packages/primitive.git/commitdiff/f059c20ca42262830d65ffbdb01cc713cf11ad29 >--------------------------------------------------------------- commit f059c20ca42262830d65ffbdb01cc713cf11ad29 Author: Herbert Valerio Riedel Date: Sat Nov 23 12:20:06 2013 +0100 Add a couple more changelog entries >--------------------------------------------------------------- f059c20ca42262830d65ffbdb01cc713cf11ad29 changelog | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/changelog b/changelog index f554d66..5cefd8c 100644 --- a/changelog +++ b/changelog @@ -2,6 +2,10 @@ Changes in version 0.5.2.0 * Add strict variants of 'MutVar' modification functions +Changes in version 0.5.1.0 + + * Add support for GHC 7.7's new primitive 'Bool' representation + Changes in version 0.5.0.1 * Disable array copying primitives for GHC 7.6.* and earlier @@ -11,3 +15,27 @@ Changes in version 0.5 * New in "Data.Primitive.MutVar": 'atomicModifyMutVar' * Efficient block fill operations: 'setByteArray', 'setAddr' + +Changes in version 0.4.1 + + * New module "Data.Primitive.MutVar" + +Changes in version 0.4.0.1 + + * Critical bug fix in 'fillByteArray' + +Changes in version 0.4 + + * Support for GHC 7.2 array copying primitives + + * New in "Data.Primitive.ByteArray": 'copyByteArray', + 'copyMutableByteArray', 'moveByteArray', 'fillByteArray' + + * Deprecated in "Data.Primitive.ByteArray": 'memcpyByteArray', + 'memcpyByteArray'', 'memmoveByteArray', 'memsetByteArray' + + * New in "Data.Primitive.Array": 'copyArray', 'copyMutableByteArray' + + * New in "Data.Primitive.Addr": 'copyAddr', 'moveAddr' + + * Deprecated in "Data.Primitive.Addr": 'memcpyAddr' From git at git.haskell.org Wed Feb 19 22:24:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 22:24:44 +0000 (UTC) Subject: [commit: packages/primitive] ghc-head: fix compilation on Solaris 10 with GNU C 3.4.3 (ad71f28) Message-ID: <20140219222445.10EDD2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/primitive On branch : ghc-head Link : http://git.haskell.org/packages/primitive.git/commitdiff/ad71f2807f10b2920863150d57374771d8ce443a >--------------------------------------------------------------- commit ad71f2807f10b2920863150d57374771d8ce443a Author: Karel Gardas Date: Sun Feb 9 22:11:47 2014 +0100 fix compilation on Solaris 10 with GNU C 3.4.3 This patch fixes compilation on Solaris 10 platform which provides GNU C 3.4.3 by default by removing unsupported -ftree-vectorize option. This may penalize Solaris 11, where GNU C 4.6.2 is provided but current cabal does not support OSes version detection and Solaris 10 is still supported (by Oracle) and will be at least till 2021 so let's support it too. >--------------------------------------------------------------- ad71f2807f10b2920863150d57374771d8ce443a primitive.cabal | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/primitive.cabal b/primitive.cabal index b819e03..666a8f2 100644 --- a/primitive.cabal +++ b/primitive.cabal @@ -44,7 +44,9 @@ Library Install-Includes: primitive-memops.h includes: primitive-memops.h c-sources: cbits/primitive-memops.c - cc-options: -O3 -ftree-vectorize -fomit-frame-pointer -Wall + cc-options: -O3 -fomit-frame-pointer -Wall + if !os(solaris) + cc-options: -ftree-vectorize if arch(i386) || arch(x86_64) cc-options: -msse2 From git at git.haskell.org Wed Feb 19 22:24:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 22:24:46 +0000 (UTC) Subject: [commit: packages/primitive] ghc-head: Bump version to 0.5.2.1 (be63ee1) Message-ID: <20140219222447.08C382406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/primitive On branch : ghc-head Link : http://git.haskell.org/packages/primitive.git/commitdiff/be63ee15d961dc1b08bc8853b9ff97708551ef36 >--------------------------------------------------------------- commit be63ee15d961dc1b08bc8853b9ff97708551ef36 Author: Bryan O'Sullivan Date: Wed Feb 19 11:22:55 2014 -0800 Bump version to 0.5.2.1 >--------------------------------------------------------------- be63ee15d961dc1b08bc8853b9ff97708551ef36 primitive.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/primitive.cabal b/primitive.cabal index 666a8f2..f648d5d 100644 --- a/primitive.cabal +++ b/primitive.cabal @@ -1,5 +1,5 @@ Name: primitive -Version: 0.5.2.0 +Version: 0.5.2.1 License: BSD3 License-File: LICENSE From git at git.haskell.org Wed Feb 19 22:25:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 22:25:26 +0000 (UTC) Subject: [commit: packages/primitive] tag 'primitive-0.5.2.1-release' created Message-ID: <20140219222526.1E7A32406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/primitive New tag : primitive-0.5.2.1-release Referencing: 209778ebea09951966bf79c4830dc67f40c1596c From git at git.haskell.org Wed Feb 19 22:28:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 22:28:08 +0000 (UTC) Subject: [commit: ghc] master: Update to primitive-0.5.2.1 (47d725f) Message-ID: <20140219222809.8F77B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/47d725f29376fa1be726e913cdf3dd69c46327c2/ghc >--------------------------------------------------------------- commit 47d725f29376fa1be726e913cdf3dd69c46327c2 Author: Herbert Valerio Riedel Date: Wed Feb 19 23:26:30 2014 +0100 Update to primitive-0.5.2.1 This contains a compile-fix for Solaris Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 47d725f29376fa1be726e913cdf3dd69c46327c2 libraries/primitive | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/primitive b/libraries/primitive index 5ae8fbb..be63ee1 160000 --- a/libraries/primitive +++ b/libraries/primitive @@ -1 +1 @@ -Subproject commit 5ae8fbb8131ccc934cadd29cc1d17298cfdaef4b +Subproject commit be63ee15d961dc1b08bc8853b9ff97708551ef36 From git at git.haskell.org Wed Feb 19 22:34:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 22:34:31 +0000 (UTC) Subject: [commit: ghc] master: add more information about the nature of support of prefetch primops on none x86/AMD64 -fasm platforms (and -fvia) to the 7.8 release notes (27fe128) Message-ID: <20140219223431.5EAD52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/27fe12856a34488ea94291990238c37e5353d1a3/ghc >--------------------------------------------------------------- commit 27fe12856a34488ea94291990238c37e5353d1a3 Author: Carter Tazio Schonwald Date: Thu Jan 30 12:27:35 2014 -0500 add more information about the nature of support of prefetch primops on none x86/AMD64 -fasm platforms (and -fvia) to the 7.8 release notes Signed-off-by: Austin Seipp >--------------------------------------------------------------- 27fe12856a34488ea94291990238c37e5353d1a3 docs/users_guide/7.8.1-notes.xml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/7.8.1-notes.xml b/docs/users_guide/7.8.1-notes.xml index c60bacf..7568246 100644 --- a/docs/users_guide/7.8.1-notes.xml +++ b/docs/users_guide/7.8.1-notes.xml @@ -554,8 +554,12 @@ guide the processor's caching decisions. - Currently, these are only supported with the LLVM - backend and x86/amd64 backends. + Currently, the primops get translated into + the associated hardware supported prefetch + instructions only with the LLVM backend and + x86/amd64 backends. On all other backends, + the prefetch primops are currently erased + at code generation time. From git at git.haskell.org Wed Feb 19 22:34:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 22:34:33 +0000 (UTC) Subject: [commit: ghc] master: add omitted FP_PROG_AR_SUPPORTS_ATFILE into the distribution configure.ac (fixes #8794) (43c314c) Message-ID: <20140219223433.F3AF92406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/43c314c730d205a3ec8ef5d54e5bf72a7900f01d/ghc >--------------------------------------------------------------- commit 43c314c730d205a3ec8ef5d54e5bf72a7900f01d Author: Karel Gardas Date: Tue Feb 18 09:18:07 2014 +0100 add omitted FP_PROG_AR_SUPPORTS_ATFILE into the distribution configure.ac (fixes #8794) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 43c314c730d205a3ec8ef5d54e5bf72a7900f01d distrib/configure.ac.in | 1 + 1 file changed, 1 insertion(+) diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in index 4a6944f..ed91244 100644 --- a/distrib/configure.ac.in +++ b/distrib/configure.ac.in @@ -114,6 +114,7 @@ AC_SUBST(WordSize) # dnl ** how to invoke `ar' and `ranlib' # +FP_PROG_AR_SUPPORTS_ATFILE FP_PROG_AR_NEEDS_RANLIB FP_SETTINGS From git at git.haskell.org Wed Feb 19 22:34:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 22:34:36 +0000 (UTC) Subject: [commit: ghc] master: fix build failure on Solaris 10 due to RANLIB being set to ':' by configure (#8795) (5c6ced5) Message-ID: <20140219223437.029D62406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5c6ced556a989e7fccfa2d4adc6f6bbe538a8e6c/ghc >--------------------------------------------------------------- commit 5c6ced556a989e7fccfa2d4adc6f6bbe538a8e6c Author: Karel Gardas Date: Mon Feb 17 10:24:05 2014 +0100 fix build failure on Solaris 10 due to RANLIB being set to ':' by configure (#8795) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 5c6ced556a989e7fccfa2d4adc6f6bbe538a8e6c aclocal.m4 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/aclocal.m4 b/aclocal.m4 index a30fa4f..c2a7ba2 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1137,6 +1137,16 @@ AC_DEFUN([FP_PROG_AR_NEEDS_RANLIB],[ esac fi + # workaround for AC_PROG_RANLIB which sets RANLIB to `:' when + # ranlib is missing on the target OS. The problem is that + # ghc-cabal cannot execute `:' which is a shell built-in but can + # execute `true' which is usually simple program supported by the + # OS. + # Fixes #8795 + if test "$RANLIB" = ":" + then + RANLIB="true" + fi REAL_RANLIB_CMD="$RANLIB" if test $fp_cv_prog_ar_needs_ranlib = yes then From git at git.haskell.org Wed Feb 19 22:34:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 22:34:39 +0000 (UTC) Subject: [commit: ghc] master: Switch on -dynamic-too with QuasiQuotes as well. (e75ebc4) Message-ID: <20140219223439.682A22406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e75ebc487b68a07bd632b51df62d9047c559f19f/ghc >--------------------------------------------------------------- commit e75ebc487b68a07bd632b51df62d9047c559f19f Author: Austin Seipp Date: Wed Feb 19 06:31:53 2014 -0600 Switch on -dynamic-too with QuasiQuotes as well. As pointed out by Albert Y. C. Lai on glasgow-haskell-users. Signed-off-by: Austin Seipp >--------------------------------------------------------------- e75ebc487b68a07bd632b51df62d9047c559f19f compiler/main/DriverPipeline.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index b5052f2..f6d9e03 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -139,11 +139,13 @@ compileOne' m_tc_result mHscMessage input_fnpp = ms_hspp_file summary mod_graph = hsc_mod_graph hsc_env0 needsTH = any (xopt Opt_TemplateHaskell . ms_hspp_opts) mod_graph + needsQQ = any (xopt Opt_QuasiQuotes . ms_hspp_opts) mod_graph + needsLinker = needsTH || needsQQ isDynWay = any (== WayDyn) (ways dflags0) isProfWay = any (== WayProf) (ways dflags0) -- #8180 - when using TemplateHaskell, switch on -dynamic-too so -- the linker can correctly load the object files. - let dflags1 = if needsTH && dynamicGhc && not isDynWay && not isProfWay + let dflags1 = if needsLinker && dynamicGhc && not isDynWay && not isProfWay then gopt_set dflags0 Opt_BuildDynamicToo else dflags0 From git at git.haskell.org Wed Feb 19 22:34:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 22:34:42 +0000 (UTC) Subject: [commit: ghc] master: fix sed expression in build dependencies rules to work well with non-GNU sed (fixes #8764) (e638acb) Message-ID: <20140219223442.B97052406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e638acb6a825559fbd93bdaf8ae2704535c157f1/ghc >--------------------------------------------------------------- commit e638acb6a825559fbd93bdaf8ae2704535c157f1 Author: Karel Gardas Date: Tue Feb 18 09:22:59 2014 +0100 fix sed expression in build dependencies rules to work well with non-GNU sed (fixes #8764) The patch is provided by Christian Maeder Signed-off-by: Karel Gardas Signed-off-by: Austin Seipp >--------------------------------------------------------------- e638acb6a825559fbd93bdaf8ae2704535c157f1 rules/build-dependencies.mk | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/rules/build-dependencies.mk b/rules/build-dependencies.mk index 79350c0..cdc1edf 100644 --- a/rules/build-dependencies.mk +++ b/rules/build-dependencies.mk @@ -53,18 +53,15 @@ endif # Foo.dyn_o Foo.o : Foo.hs # lines, and create corresponding hi-rule lines # (eval (call hi-rule,Foo.dyn_hi Foo.hi : %hi: %o Foo.hs)) - sed '/hs$$$$/ p ; \ - /hs$$$$/ s/o /hi /g ; \ - /hs$$$$/ s/:/ : %hi: %o / ; \ - /hs$$$$/ s/^/$$$$(eval $$$$(call hi-rule,/ ; \ - /hs$$$$/ s/$$$$/))/ ; \ - /hs-boot$$$$/ p ; \ - /hs-boot$$$$/ s/o-boot /hi-boot /g ; \ - /hs-boot$$$$/ s/:/ : %hi-boot: %o-boot / ; \ - /hs-boot$$$$/ s/^/$$$$(eval $$$$(call hi-rule,/ ; \ - /hs-boot$$$$/ s/$$$$/))/' \ - $$@.tmp2 > $$@ - + sed -e '/hs$$$$/ p' -e '/hs$$$$/ s/o /hi /g' \ + -e '/hs$$$$/ s/:/ : %hi: %o /' \ + -e '/hs$$$$/ s/^/$$$$(eval $$$$(call hi-rule,/' \ + -e '/hs$$$$/ s/$$$$/))/' \ + -e '/hs-boot$$$$/ p' -e '/hs-boot$$$$/ s/o-boot /hi-boot /g' \ + -e '/hs-boot$$$$/ s/:/ : %hi-boot: %o-boot /' \ + -e '/hs-boot$$$$/ s/^/$$$$(eval $$$$(call hi-rule,/' \ + -e '/hs-boot$$$$/ s/$$$$/))/' \ + $$@.tmp2 > $$@ # Some of the C files (directly or indirectly) include the generated # includes files. $$($1_$2_depfile_c_asm) : $$(includes_H_CONFIG) $$(includes_H_PLATFORM) From git at git.haskell.org Wed Feb 19 22:40:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 19 Feb 2014 22:40:42 +0000 (UTC) Subject: [commit: ghc] master: Clear up docs regarding LLVM backend (#8792) (2b34947) Message-ID: <20140219224042.277F12406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2b34947b60069e51abfcada9c45a6d7b590f5a2b/ghc >--------------------------------------------------------------- commit 2b34947b60069e51abfcada9c45a6d7b590f5a2b Author: Austin Seipp Date: Wed Feb 19 16:39:50 2014 -0600 Clear up docs regarding LLVM backend (#8792) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 2b34947b60069e51abfcada9c45a6d7b590f5a2b docs/users_guide/codegens.xml | 20 +++++++++++--------- libraries/primitive | 2 +- 2 files changed, 12 insertions(+), 10 deletions(-) diff --git a/docs/users_guide/codegens.xml b/docs/users_guide/codegens.xml index f854e11..2eb9408 100644 --- a/docs/users_guide/codegens.xml +++ b/docs/users_guide/codegens.xml @@ -41,22 +41,24 @@ optand llc tools. Secondly, if you are running Mac OS X with LLVM 3.0 or greater then you also need the Clang c - compiler compiler available on your PATH. Clang and LLVM are - both included with OS X by default from 10.6 onwards. + compiler compiler available on your PATH. To install LLVM and Clang: Linux: Use your package management tool. - Mac OS X: LLVM and Clang are included by - default from 10.6 and later. For - 10.5 you should install the - Homebrew package - manager for OS X. Alternatively you can download binaries for LLVM - and Clang from - here. + Mac OS X: Clang is included by + default on recent OS X machines when XCode is installed (from + 10.6 and later). LLVM is not included. In + order to use the LLVM based code generator, you should install + the Homebrew + package manager for OS X. Alternatively you can download + binaries for LLVM and Clang from here. + Windows: You should download binaries for LLVM and clang from here. diff --git a/libraries/primitive b/libraries/primitive index be63ee1..5ae8fbb 160000 --- a/libraries/primitive +++ b/libraries/primitive @@ -1 +1 @@ -Subproject commit be63ee15d961dc1b08bc8853b9ff97708551ef36 +Subproject commit 5ae8fbb8131ccc934cadd29cc1d17298cfdaef4b From git at git.haskell.org Thu Feb 20 07:18:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 07:18:37 +0000 (UTC) Subject: [commit: ghc] master: Fix #8801: exclude extra packages from the sdist. (f99a032) Message-ID: <20140220071837.E1A0F2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f99a0321a8cf0507924a0d30b6b7b586d7855129/ghc >--------------------------------------------------------------- commit f99a0321a8cf0507924a0d30b6b7b586d7855129 Author: Austin Seipp Date: Thu Feb 20 01:17:57 2014 -0600 Fix #8801: exclude extra packages from the sdist. This is special cased a little since it's cleaner, and we don't necessarily want to remove nofib anyway - just the extra packages. Signed-off-by: Austin Seipp >--------------------------------------------------------------- f99a0321a8cf0507924a0d30b6b7b586d7855129 ghc.mk | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ghc.mk b/ghc.mk index cb0dcde..3bca571 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1109,6 +1109,9 @@ define sdist_ghc_file mv $(SRC_DIST_GHC_DIR)/$1/$3/$4/$5.$6 $(SRC_DIST_GHC_DIR)/$1/$3/$4/$5.$6.source endef +# Extra packages which shouldn't be in the source distribution: see #8801 +EXTRA_PACKAGES=parallel stm random primitive vector dph + .PHONY: sdist-ghc-prep sdist-ghc-prep : $(call removeTrees,$(SRC_DIST_GHC_ROOT)) @@ -1123,6 +1126,7 @@ sdist-ghc-prep : $(call removeTrees,$(SRC_DIST_GHC_DIR)/libraries/stamp/) $(call removeTrees,$(SRC_DIST_GHC_DIR)/compiler/stage[123]) $(call removeFiles,$(SRC_DIST_GHC_DIR)/mk/build.mk) + for i in $(EXTRA_PACKAGES); do $(RM) $(RM_OPTS_REC) $(SRC_DIST_GHC_DIR)/libraries/$$i/; done $(call sdist_ghc_file,compiler,stage2,cmm,,CmmLex,x) $(call sdist_ghc_file,compiler,stage2,cmm,,CmmParse,y) $(call sdist_ghc_file,compiler,stage2,parser,,Lexer,x) From git at git.haskell.org Thu Feb 20 09:14:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 09:14:35 +0000 (UTC) Subject: [commit: ghc] master: Really fix #5682 (parsing of promoted datacons) (d3af980) Message-ID: <20140220091436.0A1A52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d3af9807ca8a1db0bc9298ea50895ee9df55edb7/ghc >--------------------------------------------------------------- commit d3af9807ca8a1db0bc9298ea50895ee9df55edb7 Author: Austin Seipp Date: Thu Feb 20 01:28:00 2014 -0600 Really fix #5682 (parsing of promoted datacons) Patch submitted by an anonymous friend on the bug tracker. This also fixes TH_RichKinds2 which had a slight message output wibble (it uses the qualified name of the promoted datacon) Signed-off-by: Austin Seipp >--------------------------------------------------------------- d3af9807ca8a1db0bc9298ea50895ee9df55edb7 compiler/parser/Parser.y.pp | 7 +++---- testsuite/tests/th/TH_RichKinds2.stderr | 2 +- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index d2bc463..27d6c38 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -1151,12 +1151,11 @@ atype :: { LHsType RdrName } | TH_ID_SPLICE { LL $ mkHsSpliceTy $ L1 $ HsVar $ mkUnqual varName (getTH_ID_SPLICE $1) } -- see Note [Promotion] for the followings - | SIMPLEQUOTE qconid { LL $ HsTyVar $ unLoc $2 } - | SIMPLEQUOTE '(' ')' { LL $ HsTyVar $ getRdrName unitDataCon } + | SIMPLEQUOTE qcon { LL $ HsTyVar $ unLoc $2 } | SIMPLEQUOTE '(' ctype ',' comma_types1 ')' { LL $ HsExplicitTupleTy [] ($3 : $5) } | SIMPLEQUOTE '[' comma_types0 ']' { LL $ HsExplicitListTy placeHolderKind $3 } - | SIMPLEQUOTE '(' qconop ')' { LL $ HsTyVar (unLoc $3) } - | SIMPLEQUOTE '(' varop ')' { LL $ HsTyVar (unLoc $3) } + | SIMPLEQUOTE var { LL $ HsTyVar $ unLoc $2 } + | '[' ctype ',' comma_types1 ']' { LL $ HsExplicitListTy placeHolderKind ($2 : $4) } | INTEGER {% mkTyLit $ LL $ HsNumTy $ getINTEGER $1 } | STRING {% mkTyLit $ LL $ HsStrTy $ getSTRING $1 } diff --git a/testsuite/tests/th/TH_RichKinds2.stderr b/testsuite/tests/th/TH_RichKinds2.stderr index 625d03e..8370df3 100644 --- a/testsuite/tests/th/TH_RichKinds2.stderr +++ b/testsuite/tests/th/TH_RichKinds2.stderr @@ -3,7 +3,7 @@ TH_RichKinds2.hs:23:4: Warning: data SMaybe_0 (t_1 :: k_0 -> *) (t_3 :: Data.Maybe.Maybe k_0) = forall . t_3 ~ 'Data.Maybe.Nothing => SNothing_4 | forall a_5 . t_3 ~ 'Data.Maybe.Just a_5 => SJust_6 (t_1 a_5) -type instance TH_RichKinds2.Map f_7 '[] = '[] +type instance TH_RichKinds2.Map f_7 'GHC.Types.[] = 'GHC.Types.[] type instance TH_RichKinds2.Map f_8 ('GHC.Types.: h_9 t_10) = 'GHC.Types.: (f_8 h_9) (TH_RichKinds2.Map f_8 t_10) From git at git.haskell.org Thu Feb 20 09:36:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 09:36:42 +0000 (UTC) Subject: [commit: ghc] master: RetainerProfile.c: include missing header (#8810) (925b0a4) Message-ID: <20140220093642.6EAE32406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/925b0a499dba8a891af06f1bd3f5caf063682b0b/ghc >--------------------------------------------------------------- commit 925b0a499dba8a891af06f1bd3f5caf063682b0b Author: Sergei Trofimovich Date: Thu Feb 20 03:17:27 2014 -0600 RetainerProfile.c: include missing header (#8810) Found by clang: rts_dist_HC rts/dist/build/RetainerProfile.p_o rts/RetainerProfile.c:1779:5: error: implicit declaration of function 'markStableTables' is invalid in C99 [-Werror,-Wimplicit-function-declaration] markStableTables(retainRoot, NULL); Signed-off-by: Sergei Trofimovich Signed-off-by: Austin Seipp >--------------------------------------------------------------- 925b0a499dba8a891af06f1bd3f5caf063682b0b rts/RetainerProfile.c | 1 + 1 file changed, 1 insertion(+) diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index 8cf8848..973e03b 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -30,6 +30,7 @@ #include "Stats.h" #include "ProfHeap.h" #include "Apply.h" +#include "Stable.h" /* markStableTables */ #include "sm/Storage.h" // for END_OF_STATIC_LIST /* From git at git.haskell.org Thu Feb 20 10:00:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 10:00:15 +0000 (UTC) Subject: [commit: ghc] master: Update to primitive-0.5.2.1 (again) (3361e6c) Message-ID: <20140220100015.5184C2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3361e6c793a498318ca72f4fc46959cd621baba2/ghc >--------------------------------------------------------------- commit 3361e6c793a498318ca72f4fc46959cd621baba2 Author: Herbert Valerio Riedel Date: Thu Feb 20 10:59:02 2014 +0100 Update to primitive-0.5.2.1 (again) This was already performed via 47d725f29376fa1be726e913cdf3dd69c46327c2 However, it was accidently reverted as a side-effect of 2b34947b60069e51abfcada9c45a6d7b590f5a2b Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 3361e6c793a498318ca72f4fc46959cd621baba2 libraries/primitive | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/primitive b/libraries/primitive index 5ae8fbb..be63ee1 160000 --- a/libraries/primitive +++ b/libraries/primitive @@ -1 +1 @@ -Subproject commit 5ae8fbb8131ccc934cadd29cc1d17298cfdaef4b +Subproject commit be63ee15d961dc1b08bc8853b9ff97708551ef36 From git at git.haskell.org Thu Feb 20 10:43:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 10:43:22 +0000 (UTC) Subject: [commit: ghc] master: Add test case for #8806. (55cc01a) Message-ID: <20140220104323.0408D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/55cc01a95328667e5e26f1e3062a45059cc3cbec/ghc >--------------------------------------------------------------- commit 55cc01a95328667e5e26f1e3062a45059cc3cbec Author: Erik de Castro Lopo Date: Thu Feb 20 18:13:50 2014 +1100 Add test case for #8806. GHC 7.6.3 and earlier should fail to type check this but don't. This was fixed some time between the 7.6.3 and the 7.8rc1 release, so we're just adding a test to prevent future regressions. >--------------------------------------------------------------- 55cc01a95328667e5e26f1e3062a45059cc3cbec testsuite/tests/typecheck/should_fail/T8806.hs | 9 +++++++++ testsuite/tests/typecheck/should_fail/T8806.stderr | 8 ++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 3 files changed, 18 insertions(+) diff --git a/testsuite/tests/typecheck/should_fail/T8806.hs b/testsuite/tests/typecheck/should_fail/T8806.hs new file mode 100644 index 0000000..6b80f15 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T8806.hs @@ -0,0 +1,9 @@ +-- Trac #8806 + +module T8806 where + +f :: Int => Int +f x = x + 1 + +g :: (Int => Show a) => Int +g = undefined diff --git a/testsuite/tests/typecheck/should_fail/T8806.stderr b/testsuite/tests/typecheck/should_fail/T8806.stderr new file mode 100644 index 0000000..cc1caa8 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T8806.stderr @@ -0,0 +1,8 @@ + +T8806.hs:5:6: + Expected a constraint, but ?Int? has kind ?*? + In the type signature for ?f?: f :: Int => Int + +T8806.hs:8:7: + Expected a constraint, but ?Int? has kind ?*? + In the type signature for ?g?: g :: Int => Show a => Int diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index faef063..9f5af09 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -330,3 +330,4 @@ test('ContextStack2', normal, compile_fail, ['-ftype-function-depth=10']) test('T8570', extra_clean(['T85570a.o', 'T8570a.hi','T85570b.o', 'T8570b.hi']), multimod_compile_fail, ['T8570', '-v0']) test('T8603', normal, compile_fail, ['']) +test('T8806', normal, compile_fail, ['']) From git at git.haskell.org Thu Feb 20 12:01:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 12:01:06 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: add omitted FP_PROG_AR_SUPPORTS_ATFILE into the distribution configure.ac (fixes #8794) (bbac5fe) Message-ID: <20140220120106.384F62406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/bbac5fe576e412a2b5ffb504a30aaa697318e514/ghc >--------------------------------------------------------------- commit bbac5fe576e412a2b5ffb504a30aaa697318e514 Author: Karel Gardas Date: Tue Feb 18 09:18:07 2014 +0100 add omitted FP_PROG_AR_SUPPORTS_ATFILE into the distribution configure.ac (fixes #8794) Signed-off-by: Austin Seipp (cherry picked from commit 43c314c730d205a3ec8ef5d54e5bf72a7900f01d) >--------------------------------------------------------------- bbac5fe576e412a2b5ffb504a30aaa697318e514 distrib/configure.ac.in | 1 + 1 file changed, 1 insertion(+) diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in index 4a6944f..ed91244 100644 --- a/distrib/configure.ac.in +++ b/distrib/configure.ac.in @@ -114,6 +114,7 @@ AC_SUBST(WordSize) # dnl ** how to invoke `ar' and `ranlib' # +FP_PROG_AR_SUPPORTS_ATFILE FP_PROG_AR_NEEDS_RANLIB FP_SETTINGS From git at git.haskell.org Thu Feb 20 12:01:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 12:01:08 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: fix build failure on Solaris 10 due to RANLIB being set to ':' by configure (#8795) (b4eb13d) Message-ID: <20140220120108.A72C12406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/b4eb13d6a42211681774cc859decf9ab5e64ba7f/ghc >--------------------------------------------------------------- commit b4eb13d6a42211681774cc859decf9ab5e64ba7f Author: Karel Gardas Date: Mon Feb 17 10:24:05 2014 +0100 fix build failure on Solaris 10 due to RANLIB being set to ':' by configure (#8795) Signed-off-by: Austin Seipp (cherry picked from commit 5c6ced556a989e7fccfa2d4adc6f6bbe538a8e6c) >--------------------------------------------------------------- b4eb13d6a42211681774cc859decf9ab5e64ba7f aclocal.m4 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/aclocal.m4 b/aclocal.m4 index a30fa4f..c2a7ba2 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1137,6 +1137,16 @@ AC_DEFUN([FP_PROG_AR_NEEDS_RANLIB],[ esac fi + # workaround for AC_PROG_RANLIB which sets RANLIB to `:' when + # ranlib is missing on the target OS. The problem is that + # ghc-cabal cannot execute `:' which is a shell built-in but can + # execute `true' which is usually simple program supported by the + # OS. + # Fixes #8795 + if test "$RANLIB" = ":" + then + RANLIB="true" + fi REAL_RANLIB_CMD="$RANLIB" if test $fp_cv_prog_ar_needs_ranlib = yes then From git at git.haskell.org Thu Feb 20 12:01:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 12:01:11 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: add more information about the nature of support of prefetch primops on none x86/AMD64 -fasm platforms (and -fvia) to the 7.8 release notes (6c8410d) Message-ID: <20140220120111.15AC72406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/6c8410d29f6e78c309a6152a62788b3681a3350b/ghc >--------------------------------------------------------------- commit 6c8410d29f6e78c309a6152a62788b3681a3350b Author: Carter Tazio Schonwald Date: Thu Jan 30 12:27:35 2014 -0500 add more information about the nature of support of prefetch primops on none x86/AMD64 -fasm platforms (and -fvia) to the 7.8 release notes Signed-off-by: Austin Seipp (cherry picked from commit 27fe12856a34488ea94291990238c37e5353d1a3) >--------------------------------------------------------------- 6c8410d29f6e78c309a6152a62788b3681a3350b docs/users_guide/7.8.1-notes.xml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/7.8.1-notes.xml b/docs/users_guide/7.8.1-notes.xml index c60bacf..7568246 100644 --- a/docs/users_guide/7.8.1-notes.xml +++ b/docs/users_guide/7.8.1-notes.xml @@ -554,8 +554,12 @@ guide the processor's caching decisions. - Currently, these are only supported with the LLVM - backend and x86/amd64 backends. + Currently, the primops get translated into + the associated hardware supported prefetch + instructions only with the LLVM backend and + x86/amd64 backends. On all other backends, + the prefetch primops are currently erased + at code generation time. From git at git.haskell.org Thu Feb 20 12:01:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 12:01:13 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: fix sed expression in build dependencies rules to work well with non-GNU sed (fixes #8764) (fd5d727) Message-ID: <20140220120113.753342406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/fd5d7277ec3634989872e2a3f30970633936e1a2/ghc >--------------------------------------------------------------- commit fd5d7277ec3634989872e2a3f30970633936e1a2 Author: Karel Gardas Date: Tue Feb 18 09:22:59 2014 +0100 fix sed expression in build dependencies rules to work well with non-GNU sed (fixes #8764) The patch is provided by Christian Maeder Signed-off-by: Karel Gardas Signed-off-by: Austin Seipp (cherry picked from commit e638acb6a825559fbd93bdaf8ae2704535c157f1) >--------------------------------------------------------------- fd5d7277ec3634989872e2a3f30970633936e1a2 rules/build-dependencies.mk | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/rules/build-dependencies.mk b/rules/build-dependencies.mk index 79350c0..cdc1edf 100644 --- a/rules/build-dependencies.mk +++ b/rules/build-dependencies.mk @@ -53,18 +53,15 @@ endif # Foo.dyn_o Foo.o : Foo.hs # lines, and create corresponding hi-rule lines # (eval (call hi-rule,Foo.dyn_hi Foo.hi : %hi: %o Foo.hs)) - sed '/hs$$$$/ p ; \ - /hs$$$$/ s/o /hi /g ; \ - /hs$$$$/ s/:/ : %hi: %o / ; \ - /hs$$$$/ s/^/$$$$(eval $$$$(call hi-rule,/ ; \ - /hs$$$$/ s/$$$$/))/ ; \ - /hs-boot$$$$/ p ; \ - /hs-boot$$$$/ s/o-boot /hi-boot /g ; \ - /hs-boot$$$$/ s/:/ : %hi-boot: %o-boot / ; \ - /hs-boot$$$$/ s/^/$$$$(eval $$$$(call hi-rule,/ ; \ - /hs-boot$$$$/ s/$$$$/))/' \ - $$@.tmp2 > $$@ - + sed -e '/hs$$$$/ p' -e '/hs$$$$/ s/o /hi /g' \ + -e '/hs$$$$/ s/:/ : %hi: %o /' \ + -e '/hs$$$$/ s/^/$$$$(eval $$$$(call hi-rule,/' \ + -e '/hs$$$$/ s/$$$$/))/' \ + -e '/hs-boot$$$$/ p' -e '/hs-boot$$$$/ s/o-boot /hi-boot /g' \ + -e '/hs-boot$$$$/ s/:/ : %hi-boot: %o-boot /' \ + -e '/hs-boot$$$$/ s/^/$$$$(eval $$$$(call hi-rule,/' \ + -e '/hs-boot$$$$/ s/$$$$/))/' \ + $$@.tmp2 > $$@ # Some of the C files (directly or indirectly) include the generated # includes files. $$($1_$2_depfile_c_asm) : $$(includes_H_CONFIG) $$(includes_H_PLATFORM) From git at git.haskell.org Thu Feb 20 12:01:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 12:01:15 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Switch on -dynamic-too with QuasiQuotes as well. (0eb804b) Message-ID: <20140220120115.E40F22406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/0eb804b5cec38eabc02eed2498c56575d0503977/ghc >--------------------------------------------------------------- commit 0eb804b5cec38eabc02eed2498c56575d0503977 Author: Austin Seipp Date: Wed Feb 19 06:31:53 2014 -0600 Switch on -dynamic-too with QuasiQuotes as well. As pointed out by Albert Y. C. Lai on glasgow-haskell-users. Signed-off-by: Austin Seipp (cherry picked from commit e75ebc487b68a07bd632b51df62d9047c559f19f) >--------------------------------------------------------------- 0eb804b5cec38eabc02eed2498c56575d0503977 compiler/main/DriverPipeline.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index b5052f2..f6d9e03 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -139,11 +139,13 @@ compileOne' m_tc_result mHscMessage input_fnpp = ms_hspp_file summary mod_graph = hsc_mod_graph hsc_env0 needsTH = any (xopt Opt_TemplateHaskell . ms_hspp_opts) mod_graph + needsQQ = any (xopt Opt_QuasiQuotes . ms_hspp_opts) mod_graph + needsLinker = needsTH || needsQQ isDynWay = any (== WayDyn) (ways dflags0) isProfWay = any (== WayProf) (ways dflags0) -- #8180 - when using TemplateHaskell, switch on -dynamic-too so -- the linker can correctly load the object files. - let dflags1 = if needsTH && dynamicGhc && not isDynWay && not isProfWay + let dflags1 = if needsLinker && dynamicGhc && not isDynWay && not isProfWay then gopt_set dflags0 Opt_BuildDynamicToo else dflags0 From git at git.haskell.org Thu Feb 20 12:01:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 12:01:18 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Clear up docs regarding LLVM backend (#8792) (a1e57a0) Message-ID: <20140220120118.518032406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/a1e57a0fb1979aeec191c35d96e9b98c03be6c47/ghc >--------------------------------------------------------------- commit a1e57a0fb1979aeec191c35d96e9b98c03be6c47 Author: Austin Seipp Date: Wed Feb 19 16:39:50 2014 -0600 Clear up docs regarding LLVM backend (#8792) Signed-off-by: Austin Seipp (cherry picked from commit 2b34947b60069e51abfcada9c45a6d7b590f5a2b) >--------------------------------------------------------------- a1e57a0fb1979aeec191c35d96e9b98c03be6c47 docs/users_guide/codegens.xml | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/docs/users_guide/codegens.xml b/docs/users_guide/codegens.xml index f854e11..2eb9408 100644 --- a/docs/users_guide/codegens.xml +++ b/docs/users_guide/codegens.xml @@ -41,22 +41,24 @@ optand llc tools. Secondly, if you are running Mac OS X with LLVM 3.0 or greater then you also need the Clang c - compiler compiler available on your PATH. Clang and LLVM are - both included with OS X by default from 10.6 onwards. + compiler compiler available on your PATH. To install LLVM and Clang: Linux: Use your package management tool. - Mac OS X: LLVM and Clang are included by - default from 10.6 and later. For - 10.5 you should install the - Homebrew package - manager for OS X. Alternatively you can download binaries for LLVM - and Clang from - here. + Mac OS X: Clang is included by + default on recent OS X machines when XCode is installed (from + 10.6 and later). LLVM is not included. In + order to use the LLVM based code generator, you should install + the Homebrew + package manager for OS X. Alternatively you can download + binaries for LLVM and Clang from here. + Windows: You should download binaries for LLVM and clang from here. From git at git.haskell.org Thu Feb 20 12:01:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 12:01:20 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix #8801: exclude extra packages from the sdist. (cd10cd4) Message-ID: <20140220120121.710BD2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/cd10cd4b6509a827fb3278d51d2802dfedd24ddc/ghc >--------------------------------------------------------------- commit cd10cd4b6509a827fb3278d51d2802dfedd24ddc Author: Austin Seipp Date: Thu Feb 20 01:17:57 2014 -0600 Fix #8801: exclude extra packages from the sdist. This is special cased a little since it's cleaner, and we don't necessarily want to remove nofib anyway - just the extra packages. Signed-off-by: Austin Seipp (cherry picked from commit f99a0321a8cf0507924a0d30b6b7b586d7855129) >--------------------------------------------------------------- cd10cd4b6509a827fb3278d51d2802dfedd24ddc ghc.mk | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ghc.mk b/ghc.mk index 4bd47c6..8b7b031 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1109,6 +1109,9 @@ define sdist_ghc_file mv $(SRC_DIST_GHC_DIR)/$1/$3/$4/$5.$6 $(SRC_DIST_GHC_DIR)/$1/$3/$4/$5.$6.source endef +# Extra packages which shouldn't be in the source distribution: see #8801 +EXTRA_PACKAGES=parallel stm random primitive vector dph + .PHONY: sdist-ghc-prep sdist-ghc-prep : $(call removeTrees,$(SRC_DIST_GHC_ROOT)) @@ -1123,6 +1126,7 @@ sdist-ghc-prep : $(call removeTrees,$(SRC_DIST_GHC_DIR)/libraries/stamp/) $(call removeTrees,$(SRC_DIST_GHC_DIR)/compiler/stage[123]) $(call removeFiles,$(SRC_DIST_GHC_DIR)/mk/build.mk) + for i in $(EXTRA_PACKAGES); do $(RM) $(RM_OPTS_REC) $(SRC_DIST_GHC_DIR)/libraries/$$i/; done $(call sdist_ghc_file,compiler,stage2,cmm,,CmmLex,x) $(call sdist_ghc_file,compiler,stage2,cmm,,CmmParse,y) $(call sdist_ghc_file,compiler,stage2,parser,,Lexer,x) From git at git.haskell.org Thu Feb 20 12:01:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 12:01:23 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Really fix #5682 (parsing of promoted datacons) (b27517a) Message-ID: <20140220120123.36F5C2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/b27517a53ef4a8cdc62d52289600f02e28a46a7c/ghc >--------------------------------------------------------------- commit b27517a53ef4a8cdc62d52289600f02e28a46a7c Author: Austin Seipp Date: Thu Feb 20 01:28:00 2014 -0600 Really fix #5682 (parsing of promoted datacons) Patch submitted by an anonymous friend on the bug tracker. This also fixes TH_RichKinds2 which had a slight message output wibble (it uses the qualified name of the promoted datacon) Signed-off-by: Austin Seipp (cherry picked from commit d3af9807ca8a1db0bc9298ea50895ee9df55edb7) >--------------------------------------------------------------- b27517a53ef4a8cdc62d52289600f02e28a46a7c compiler/parser/Parser.y.pp | 7 +++---- testsuite/tests/th/TH_RichKinds2.stderr | 2 +- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index d2bc463..27d6c38 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -1151,12 +1151,11 @@ atype :: { LHsType RdrName } | TH_ID_SPLICE { LL $ mkHsSpliceTy $ L1 $ HsVar $ mkUnqual varName (getTH_ID_SPLICE $1) } -- see Note [Promotion] for the followings - | SIMPLEQUOTE qconid { LL $ HsTyVar $ unLoc $2 } - | SIMPLEQUOTE '(' ')' { LL $ HsTyVar $ getRdrName unitDataCon } + | SIMPLEQUOTE qcon { LL $ HsTyVar $ unLoc $2 } | SIMPLEQUOTE '(' ctype ',' comma_types1 ')' { LL $ HsExplicitTupleTy [] ($3 : $5) } | SIMPLEQUOTE '[' comma_types0 ']' { LL $ HsExplicitListTy placeHolderKind $3 } - | SIMPLEQUOTE '(' qconop ')' { LL $ HsTyVar (unLoc $3) } - | SIMPLEQUOTE '(' varop ')' { LL $ HsTyVar (unLoc $3) } + | SIMPLEQUOTE var { LL $ HsTyVar $ unLoc $2 } + | '[' ctype ',' comma_types1 ']' { LL $ HsExplicitListTy placeHolderKind ($2 : $4) } | INTEGER {% mkTyLit $ LL $ HsNumTy $ getINTEGER $1 } | STRING {% mkTyLit $ LL $ HsStrTy $ getSTRING $1 } diff --git a/testsuite/tests/th/TH_RichKinds2.stderr b/testsuite/tests/th/TH_RichKinds2.stderr index 625d03e..8370df3 100644 --- a/testsuite/tests/th/TH_RichKinds2.stderr +++ b/testsuite/tests/th/TH_RichKinds2.stderr @@ -3,7 +3,7 @@ TH_RichKinds2.hs:23:4: Warning: data SMaybe_0 (t_1 :: k_0 -> *) (t_3 :: Data.Maybe.Maybe k_0) = forall . t_3 ~ 'Data.Maybe.Nothing => SNothing_4 | forall a_5 . t_3 ~ 'Data.Maybe.Just a_5 => SJust_6 (t_1 a_5) -type instance TH_RichKinds2.Map f_7 '[] = '[] +type instance TH_RichKinds2.Map f_7 'GHC.Types.[] = 'GHC.Types.[] type instance TH_RichKinds2.Map f_8 ('GHC.Types.: h_9 t_10) = 'GHC.Types.: (f_8 h_9) (TH_RichKinds2.Map f_8 t_10) From git at git.haskell.org Thu Feb 20 12:01:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 12:01:25 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: RetainerProfile.c: include missing header (#8810) (ff57204) Message-ID: <20140220120125.B93212406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/ff57204d6dd32a87999cf467eb327db2f6245b1c/ghc >--------------------------------------------------------------- commit ff57204d6dd32a87999cf467eb327db2f6245b1c Author: Sergei Trofimovich Date: Thu Feb 20 03:17:27 2014 -0600 RetainerProfile.c: include missing header (#8810) Found by clang: rts_dist_HC rts/dist/build/RetainerProfile.p_o rts/RetainerProfile.c:1779:5: error: implicit declaration of function 'markStableTables' is invalid in C99 [-Werror,-Wimplicit-function-declaration] markStableTables(retainRoot, NULL); Signed-off-by: Sergei Trofimovich Signed-off-by: Austin Seipp (cherry picked from commit 925b0a499dba8a891af06f1bd3f5caf063682b0b) >--------------------------------------------------------------- ff57204d6dd32a87999cf467eb327db2f6245b1c rts/RetainerProfile.c | 1 + 1 file changed, 1 insertion(+) diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index 8cf8848..973e03b 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -30,6 +30,7 @@ #include "Stats.h" #include "ProfHeap.h" #include "Apply.h" +#include "Stable.h" /* markStableTables */ #include "sm/Storage.h" // for END_OF_STATIC_LIST /* From git at git.haskell.org Thu Feb 20 12:13:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 12:13:07 +0000 (UTC) Subject: [commit: ghc] master: Add a test for d3af980 (#5682) (5a57675) Message-ID: <20140220121307.CAE9F2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5a576754d745171422d13cd1dba69dd874714cf1/ghc >--------------------------------------------------------------- commit 5a576754d745171422d13cd1dba69dd874714cf1 Author: Austin Seipp Date: Thu Feb 20 06:12:06 2014 -0600 Add a test for d3af980 (#5682) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 5a576754d745171422d13cd1dba69dd874714cf1 testsuite/tests/parser/should_compile/T5682.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/parser/should_compile/T5682.hs b/testsuite/tests/parser/should_compile/T5682.hs index bfd6752..cdfe46f 100644 --- a/testsuite/tests/parser/should_compile/T5682.hs +++ b/testsuite/tests/parser/should_compile/T5682.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, DeriveDataTypeable, StandaloneDeriving, TypeOperators #-} +{-# LANGUAGE DataKinds, PolyKinds, DeriveDataTypeable, StandaloneDeriving, TypeOperators #-} module T5682 where @@ -10,3 +10,4 @@ data Foo = Bool :+: Bool type X = True ':+: False deriving instance Typeable '(:+:) +deriving instance Typeable '(,,) From git at git.haskell.org Thu Feb 20 12:13:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 12:13:42 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Add a test for d3af980 (#5682) (1b152a6) Message-ID: <20140220121342.D65DE2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/1b152a6237ce67559797379b0e77451f621dbe3e/ghc >--------------------------------------------------------------- commit 1b152a6237ce67559797379b0e77451f621dbe3e Author: Austin Seipp Date: Thu Feb 20 06:12:06 2014 -0600 Add a test for d3af980 (#5682) Signed-off-by: Austin Seipp (cherry picked from commit 5a576754d745171422d13cd1dba69dd874714cf1) >--------------------------------------------------------------- 1b152a6237ce67559797379b0e77451f621dbe3e testsuite/tests/parser/should_compile/T5682.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/parser/should_compile/T5682.hs b/testsuite/tests/parser/should_compile/T5682.hs index bfd6752..cdfe46f 100644 --- a/testsuite/tests/parser/should_compile/T5682.hs +++ b/testsuite/tests/parser/should_compile/T5682.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, DeriveDataTypeable, StandaloneDeriving, TypeOperators #-} +{-# LANGUAGE DataKinds, PolyKinds, DeriveDataTypeable, StandaloneDeriving, TypeOperators #-} module T5682 where @@ -10,3 +10,4 @@ data Foo = Bool :+: Bool type X = True ':+: False deriving instance Typeable '(:+:) +deriving instance Typeable '(,,) From git at git.haskell.org Thu Feb 20 14:46:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 14:46:12 +0000 (UTC) Subject: [commit: ghc] master: Fix #8754 again. (c72e889) Message-ID: <20140220144612.4B00C2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c72e8898447b2a8e55f2d16594b5944c2ae13e24/ghc >--------------------------------------------------------------- commit c72e8898447b2a8e55f2d16594b5944c2ae13e24 Author: Austin Seipp Date: Thu Feb 20 06:41:02 2014 -0600 Fix #8754 again. This time, we carefully initialize the GC stats only if they're not already initialized - this way the user can override them (e.g. `+RTS -t --machine-readable`). Signed-off-by: Austin Seipp >--------------------------------------------------------------- c72e8898447b2a8e55f2d16594b5944c2ae13e24 ghc/Main.hs | 25 +++++++++++++++++++++++++ ghc/hschooks.c | 15 ++++++++++++++- 2 files changed, 39 insertions(+), 1 deletion(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index 868042b..481e7df 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -1,4 +1,5 @@ {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} +{-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- @@ -76,6 +77,7 @@ import Data.Maybe main :: IO () main = do + initGCStatistics -- See Note [-Bsymbolic and hooks] hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do @@ -818,3 +820,26 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs (case fuzzyMatch f (nub allFlags) of [] -> "" suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) + +{- Note [-Bsymbolic and hooks] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-Bsymbolic is a flag that prevents the binding of references to global +symbols to symbols outside the shared library being compiled (see `man +ld`). When dynamically linking, we don't use -Bsymbolic on the RTS +package: that is because we want hooks to be overridden by the user, +we don't want to constrain them to the RTS package. + +Unfortunately this seems to have broken somehow on OS X: as a result, +defaultHooks (in hschooks.c) is not called, which does not initialize +the GC stats. As a result, this breaks things like `:set +s` in GHCi +(#8754). As a hacky workaround, we instead call 'defaultHooks' +directly to initalize the flags in the RTS. + +A biproduct of this, I believe, is that hooks are likely broken on OS +X when dynamically linking. But this probably doesn't affect most +people since we're linking GHC dynamically, but most things themselves +link statically. +-} + +foreign import ccall safe "initGCStatistics" + initGCStatistics :: IO () diff --git a/ghc/hschooks.c b/ghc/hschooks.c index 4e6e66d..4c588d0 100644 --- a/ghc/hschooks.c +++ b/ghc/hschooks.c @@ -16,6 +16,18 @@ in instead of the defaults. #endif void +initGCStatistics(void) +{ + /* Workaround for #8754: if the GC stats aren't enabled because the + compiler couldn't use -Bsymbolic to link the default hooks, then + initialize them sensibly. See Note [-Bsymbolic and hooks] in + Main.hs. */ + if (RtsFlags.GcFlags.giveStats == NO_GC_STATS) { + RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS; + } +} + +void defaultsHook (void) { #if __GLASGOW_HASKELL__ >= 707 @@ -28,7 +40,8 @@ defaultsHook (void) #endif RtsFlags.GcFlags.maxStkSize = 512*1024*1024 / sizeof(W_); - RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS; + + initGCStatistics(); // See #3408: the default idle GC time of 0.3s is too short on // Windows where we receive console events once per second or so. From git at git.haskell.org Thu Feb 20 14:46:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 14:46:15 +0000 (UTC) Subject: [commit: ghc] master: Add VERSION file to gitignore. (5075c19) Message-ID: <20140220144615.511F32406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5075c191a7640745e7f564082d3e27ee2ca8c2b9/ghc >--------------------------------------------------------------- commit 5075c191a7640745e7f564082d3e27ee2ca8c2b9 Author: Austin Seipp Date: Thu Feb 20 07:16:31 2014 -0600 Add VERSION file to gitignore. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 5075c191a7640745e7f564082d3e27ee2ca8c2b9 .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 57774d1..93feea3 100644 --- a/.gitignore +++ b/.gitignore @@ -175,3 +175,4 @@ _darcs/ /extra-gcc-opts .tm_properties +VERSION From git at git.haskell.org Thu Feb 20 14:46:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 14:46:18 +0000 (UTC) Subject: [commit: ghc] master: Fix installation of ghc-split (#8760) (beac525) Message-ID: <20140220144618.6D95F2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/beac5252d444bafb0722bc6d13c6dd2d49a12070/ghc >--------------------------------------------------------------- commit beac5252d444bafb0722bc6d13c6dd2d49a12070 Author: Austin Seipp Date: Thu Feb 20 07:15:32 2014 -0600 Fix installation of ghc-split (#8760) The rules weren't correctly setting INSTALL_TOPDIRS, and on top of that the dependencies were wrong when BINDIST=YES. Authored-by: Evan Hauck Authored-by: Austin Seipp Signed-off-by: Austin Seipp >--------------------------------------------------------------- beac5252d444bafb0722bc6d13c6dd2d49a12070 rules/build-perl.mk | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/rules/build-perl.mk b/rules/build-perl.mk index 994c765..3f7a026 100644 --- a/rules/build-perl.mk +++ b/rules/build-perl.mk @@ -56,7 +56,6 @@ ifeq "$(findstring clean,$(MAKECMDGOALS))" "" ifneq "$$(BINDIST)" "YES" $1/$2/$$($1_$2_PROG).prl: $1/$$($1_PERL_SRC) $$$$(unlit_INPLACE) | $$$$(dir $$$$@)/. "$$(unlit_INPLACE)" $$(UNLIT_OPTS) $$< $$@ -endif $1/$2/$$($1_$2_PROG): $1/$2/$$($1_$2_PROG).prl $$(call removeFiles,$$@) @@ -70,6 +69,15 @@ $$($1_$2_INPLACE): $1/$2/$$($1_$2_PROG) | $$$$(dir $$$$@)/. $$(EXECUTABLE_FILE) $$@ endif +endif + +ifeq "$$($1_$2_INSTALL)" "YES" +ifeq "$$($1_$2_TOPDIR)" "YES" +INSTALL_TOPDIRS += $$($1_$2_INPLACE) +else +INSTALL_BINS += $$($1_$2_INPLACE) +endif +endif $(call profEnd, build-perl($1,$2)) endef From git at git.haskell.org Thu Feb 20 14:47:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 14:47:16 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix #8754 again. (55b332b) Message-ID: <20140220144717.734B32406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/55b332bc4cd5c0d18a106bff0f7979f4bbcdddf5/ghc >--------------------------------------------------------------- commit 55b332bc4cd5c0d18a106bff0f7979f4bbcdddf5 Author: Austin Seipp Date: Thu Feb 20 06:41:02 2014 -0600 Fix #8754 again. This time, we carefully initialize the GC stats only if they're not already initialized - this way the user can override them (e.g. `+RTS -t --machine-readable`). Signed-off-by: Austin Seipp (cherry picked from commit c72e8898447b2a8e55f2d16594b5944c2ae13e24) >--------------------------------------------------------------- 55b332bc4cd5c0d18a106bff0f7979f4bbcdddf5 ghc/Main.hs | 25 +++++++++++++++++++++++++ ghc/hschooks.c | 15 ++++++++++++++- 2 files changed, 39 insertions(+), 1 deletion(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index 868042b..481e7df 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -1,4 +1,5 @@ {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} +{-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- @@ -76,6 +77,7 @@ import Data.Maybe main :: IO () main = do + initGCStatistics -- See Note [-Bsymbolic and hooks] hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do @@ -818,3 +820,26 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs (case fuzzyMatch f (nub allFlags) of [] -> "" suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) + +{- Note [-Bsymbolic and hooks] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-Bsymbolic is a flag that prevents the binding of references to global +symbols to symbols outside the shared library being compiled (see `man +ld`). When dynamically linking, we don't use -Bsymbolic on the RTS +package: that is because we want hooks to be overridden by the user, +we don't want to constrain them to the RTS package. + +Unfortunately this seems to have broken somehow on OS X: as a result, +defaultHooks (in hschooks.c) is not called, which does not initialize +the GC stats. As a result, this breaks things like `:set +s` in GHCi +(#8754). As a hacky workaround, we instead call 'defaultHooks' +directly to initalize the flags in the RTS. + +A biproduct of this, I believe, is that hooks are likely broken on OS +X when dynamically linking. But this probably doesn't affect most +people since we're linking GHC dynamically, but most things themselves +link statically. +-} + +foreign import ccall safe "initGCStatistics" + initGCStatistics :: IO () diff --git a/ghc/hschooks.c b/ghc/hschooks.c index 4e6e66d..4c588d0 100644 --- a/ghc/hschooks.c +++ b/ghc/hschooks.c @@ -16,6 +16,18 @@ in instead of the defaults. #endif void +initGCStatistics(void) +{ + /* Workaround for #8754: if the GC stats aren't enabled because the + compiler couldn't use -Bsymbolic to link the default hooks, then + initialize them sensibly. See Note [-Bsymbolic and hooks] in + Main.hs. */ + if (RtsFlags.GcFlags.giveStats == NO_GC_STATS) { + RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS; + } +} + +void defaultsHook (void) { #if __GLASGOW_HASKELL__ >= 707 @@ -28,7 +40,8 @@ defaultsHook (void) #endif RtsFlags.GcFlags.maxStkSize = 512*1024*1024 / sizeof(W_); - RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS; + + initGCStatistics(); // See #3408: the default idle GC time of 0.3s is too short on // Windows where we receive console events once per second or so. From git at git.haskell.org Thu Feb 20 14:47:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 14:47:19 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Fix installation of ghc-split (#8760) (97d3abe) Message-ID: <20140220144720.11AB02406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/97d3abef9ad929ed1c5921aaf7009b2a86293215/ghc >--------------------------------------------------------------- commit 97d3abef9ad929ed1c5921aaf7009b2a86293215 Author: Austin Seipp Date: Thu Feb 20 07:15:32 2014 -0600 Fix installation of ghc-split (#8760) The rules weren't correctly setting INSTALL_TOPDIRS, and on top of that the dependencies were wrong when BINDIST=YES. Authored-by: Evan Hauck Authored-by: Austin Seipp Signed-off-by: Austin Seipp (cherry picked from commit beac5252d444bafb0722bc6d13c6dd2d49a12070) >--------------------------------------------------------------- 97d3abef9ad929ed1c5921aaf7009b2a86293215 rules/build-perl.mk | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/rules/build-perl.mk b/rules/build-perl.mk index 994c765..3f7a026 100644 --- a/rules/build-perl.mk +++ b/rules/build-perl.mk @@ -56,7 +56,6 @@ ifeq "$(findstring clean,$(MAKECMDGOALS))" "" ifneq "$$(BINDIST)" "YES" $1/$2/$$($1_$2_PROG).prl: $1/$$($1_PERL_SRC) $$$$(unlit_INPLACE) | $$$$(dir $$$$@)/. "$$(unlit_INPLACE)" $$(UNLIT_OPTS) $$< $$@ -endif $1/$2/$$($1_$2_PROG): $1/$2/$$($1_$2_PROG).prl $$(call removeFiles,$$@) @@ -70,6 +69,15 @@ $$($1_$2_INPLACE): $1/$2/$$($1_$2_PROG) | $$$$(dir $$$$@)/. $$(EXECUTABLE_FILE) $$@ endif +endif + +ifeq "$$($1_$2_INSTALL)" "YES" +ifeq "$$($1_$2_TOPDIR)" "YES" +INSTALL_TOPDIRS += $$($1_$2_INPLACE) +else +INSTALL_BINS += $$($1_$2_INPLACE) +endif +endif $(call profEnd, build-perl($1,$2)) endef From git at git.haskell.org Thu Feb 20 14:55:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Feb 2014 14:55:26 +0000 (UTC) Subject: [commit: ghc] ghc-7.8: Update to primitive-0.5.2.1 (8a2989c) Message-ID: <20140220145526.1A2592406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.8 Link : http://ghc.haskell.org/trac/ghc/changeset/8a2989c5df76712d5cd52ff918d4e6c1a741a90b/ghc >--------------------------------------------------------------- commit 8a2989c5df76712d5cd52ff918d4e6c1a741a90b Author: Herbert Valerio Riedel Date: Wed Feb 19 23:26:30 2014 +0100 Update to primitive-0.5.2.1 This contains a compile-fix for Solaris Signed-off-by: Herbert Valerio Riedel (cherry picked from commit 47d725f29376fa1be726e913cdf3dd69c46327c2) >--------------------------------------------------------------- 8a2989c5df76712d5cd52ff918d4e6c1a741a90b libraries/primitive | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/primitive b/libraries/primitive index 5ae8fbb..be63ee1 160000 --- a/libraries/primitive +++ b/libraries/primitive @@ -1 +1 @@ -Subproject commit 5ae8fbb8131ccc934cadd29cc1d17298cfdaef4b +Subproject commit be63ee15d961dc1b08bc8853b9ff97708551ef36 From git at git.haskell.org Fri Feb 21 09:44:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Feb 2014 09:44:34 +0000 (UTC) Subject: [commit: packages/base] master: Fix typo in documentation of Data.Functor.($>) (599130f) Message-ID: <20140221094434.AD4602406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/599130f79009c97974ddde4707365afa7b433805/base >--------------------------------------------------------------- commit 599130f79009c97974ddde4707365afa7b433805 Author: Herbert Valerio Riedel Date: Sun Feb 16 21:57:39 2014 +0100 Fix typo in documentation of Data.Functor.($>) Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 599130f79009c97974ddde4707365afa7b433805 Data/Functor.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Data/Functor.hs b/Data/Functor.hs index fdf7c4b..1869b16 100644 --- a/Data/Functor.hs +++ b/Data/Functor.hs @@ -33,7 +33,7 @@ infixl 4 <$> infixl 4 $> --- | Flipped version of '$>'. +-- | Flipped version of '<$'. -- -- /Since: 4.7.0.0/ ($>) :: Functor f => f a -> b -> f b From git at git.haskell.org Fri Feb 21 09:44:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Feb 2014 09:44:36 +0000 (UTC) Subject: [commit: packages/base] master: Tweak Haddock markup in Control.Applicative (b3307dc) Message-ID: <20140221094436.9E51F2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b3307dc871503ead93771b2096b819273cd129a6/base >--------------------------------------------------------------- commit b3307dc871503ead93771b2096b819273cd129a6 Author: Herbert Valerio Riedel Date: Sun Feb 16 21:59:31 2014 +0100 Tweak Haddock markup in Control.Applicative This (arguably) improves rendering with Haddock 2.14 Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- b3307dc871503ead93771b2096b819273cd129a6 Control/Applicative.hs | 31 ++++++++++++++++++------------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/Control/Applicative.hs b/Control/Applicative.hs index dbfa272..8f72521 100644 --- a/Control/Applicative.hs +++ b/Control/Applicative.hs @@ -27,9 +27,9 @@ -- it admits more sharing than the monadic interface. The names here are -- mostly based on parsing work by Doaitse Swierstra. -- --- For more details, see /Applicative Programming with Effects/, --- by Conor McBride and Ross Paterson, online at --- . +-- For more details, see +-- , +-- by Conor McBride and Ross Paterson. module Control.Applicative ( -- * Applicative functors @@ -73,34 +73,39 @@ infixl 4 <*>, <*, *>, <**> -- functions satisfying the following laws: -- -- [/identity/] +-- -- @'pure' 'id' '<*>' v = v@ -- -- [/composition/] +-- -- @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@ -- -- [/homomorphism/] +-- -- @'pure' f '<*>' 'pure' x = 'pure' (f x)@ -- -- [/interchange/] +-- -- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@ -- -- The other methods have the following default definitions, which may -- be overridden with equivalent specialized implementations: -- --- @ --- u '*>' v = 'pure' ('const' 'id') '<*>' u '<*>' v --- u '<*' v = 'pure' 'const' '<*>' u '<*>' v --- @ +-- * @u '*>' v = 'pure' ('const' 'id') '<*>' u '<*>' v@ +-- +-- * @u '<*' v = 'pure' 'const' '<*>' u '<*>' v@ -- -- As a consequence of these laws, the 'Functor' instance for @f@ will satisfy -- --- @ --- 'fmap' f x = 'pure' f '<*>' x --- @ +-- * @'fmap' f x = 'pure' f '<*>' x@ +-- +-- If @f@ is also a 'Monad', it should satisfy +-- +-- * @'pure' = 'return'@ +-- +-- * @('<*>') = 'ap'@ -- --- If @f@ is also a 'Monad', it should satisfy @'pure' = 'return'@ and --- @('<*>') = 'ap'@ (which implies that 'pure' and '<*>' satisfy the --- applicative functor laws). +-- (which implies that 'pure' and '<*>' satisfy the applicative functor laws). class Functor f => Applicative f where -- | Lift a value. From git at git.haskell.org Fri Feb 21 09:44:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Feb 2014 09:44:38 +0000 (UTC) Subject: [commit: packages/base] master: Minor fixes to Haddock markup (6f6f29b) Message-ID: <20140221094438.93FCD2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f6f29b34574bc9ed49cc44f0e18596f829c75df/base >--------------------------------------------------------------- commit 6f6f29b34574bc9ed49cc44f0e18596f829c75df Author: Herbert Valerio Riedel Date: Sun Feb 16 22:03:17 2014 +0100 Minor fixes to Haddock markup Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 6f6f29b34574bc9ed49cc44f0e18596f829c75df Data/Bits.hs | 2 +- GHC/IO/Exception.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Data/Bits.hs b/Data/Bits.hs index c6bd8da..c06caf9 100644 --- a/Data/Bits.hs +++ b/Data/Bits.hs @@ -72,7 +72,7 @@ The 'Bits' class defines bitwise operations over integral types. Minimal complete definition: '.&.', '.|.', 'xor', 'complement', ('shift' or ('shiftL' and 'shiftR')), ('rotate' or ('rotateL' and 'rotateR')), 'bitSize', 'isSigned', 'testBit', 'bit', and 'popCount'. The latter three can -be implemented using `testBitDefault', 'bitDefault, and 'popCountDefault', if +be implemented using `testBitDefault', 'bitDefault', and 'popCountDefault', if @a@ is also an instance of 'Num'. -} class Eq a => Bits a where diff --git a/GHC/IO/Exception.hs b/GHC/IO/Exception.hs index 8691477..7f5bc4e 100644 --- a/GHC/IO/Exception.hs +++ b/GHC/IO/Exception.hs @@ -145,9 +145,9 @@ data AsyncException -- the program should take action to reduce the amount of -- live data it has. Notes: -- - -- * It is undefined which thread receives this exception. + -- * It is undefined which thread receives this exception. -- - -- * GHC currently does not throw 'HeapOverflow' exceptions. + -- * GHC currently does not throw 'HeapOverflow' exceptions. | ThreadKilled -- ^This exception is raised by another thread -- calling 'Control.Concurrent.killThread', or by the system From git at git.haskell.org Sun Feb 23 06:50:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 23 Feb 2014 06:50:28 +0000 (UTC) Subject: [commit: haddock] master: Strip a single leading space from bird tracks (#201) (fc7fd18) Message-ID: <20140223065029.0C05E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/fc7fd1875d31dbfd37eaa058177e534b4fc6bc25 >--------------------------------------------------------------- commit fc7fd1875d31dbfd37eaa058177e534b4fc6bc25 Author: Niklas Haas Date: Sat Feb 22 21:15:34 2014 +0100 Strip a single leading space from bird tracks (#201) This makes bird tracks in the form > foo > bar > bat parse as if they had been written as >foo >bar >bat ie. without the leading whitespace in front of every line. Ideally we also want to look into how leading whitespace affects code blocks written using the @ @ syntax, which are currently unaffected by this patch. >--------------------------------------------------------------- fc7fd1875d31dbfd37eaa058177e534b4fc6bc25 html-test/ref/Nesting.html | 24 ++++++++++++++-------- html-test/ref/SpuriousSuperclassConstraints.html | 4 ++-- html-test/ref/Test.html | 14 ++++++------- html-test/src/Nesting.hs | 6 ++++++ src/Haddock/Parser.hs | 11 +++++++++- test/Haddock/ParserSpec.hs | 18 ++++++++++++++++ 6 files changed, 58 insertions(+), 19 deletions(-) diff --git a/html-test/ref/Nesting.html b/html-test/ref/Nesting.html index 0d69279..4178767 100644 --- a/html-test/ref/Nesting.html +++ b/html-test/ref/Nesting.html @@ -166,9 +166,9 @@ the presence of this text pushes it out of nesting back to the top.
  • Beginning of list
     nested
- bird
- tracks
    nested +bird +tracks
  • Beginning of list This belongs to the list above!
     nested
- bird
- tracks
    nested +bird +tracks + +another line + with indentation
    nested bird tracks
+  without leading space
    • Next list @@ -221,9 +227,9 @@ More of the indented list.
        Works for definition lists too.
         nested
- bird
- tracks
        nested +bird +tracks
        • Next list diff --git a/html-test/ref/SpuriousSuperclassConstraints.html b/html-test/ref/SpuriousSuperclassConstraints.html index 77e1346..171e3d2 100644 --- a/html-test/ref/SpuriousSuperclassConstraints.html +++ b/html-test/ref/SpuriousSuperclassConstraints.html @@ -63,8 +63,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_SpuriousSuperclassCons >

          It has been fixed in:

           6ccf78e15a525282fef61bc4f58a279aa9c21771
- Fix spurious superclass constraints bug.
          6ccf78e15a525282fef61bc4f58a279aa9c21771 +Fix spurious superclass constraints bug.
           this is another block of code
          this is another block of code

          We can also include URLs in documentation: http://www.haskell.org/

           foo
          foo
           bar
          bar

          This is some inline documentation in the export list

           a code block using bird-tracks
- each line must begin with > (which isn't significant unless it
- is at the beginning of the line).
          a code block using bird-tracks +each line must begin with > (which isn't significant unless it +is at the beginning of the line).

          A hidden module

          A subsection
           a literal line
          a literal line

          $ a non literal nested > bird > tracks + > + > another line + > with indentation + + >nested bird tracks + > without leading space * Next list More of the indented list. diff --git a/src/Haddock/Parser.hs b/src/Haddock/Parser.hs index e9bed2a..a6ad817 100644 --- a/src/Haddock/Parser.hs +++ b/src/Haddock/Parser.hs @@ -302,10 +302,19 @@ takeNonEmptyLine = do (++ "\n") . decodeUtf8 <$> (takeWhile1 (/= '\n') >>= nonSpace) <* "\n" birdtracks :: Parser (Doc a) -birdtracks = DocCodeBlock . DocString . intercalate "\n" <$> many1 line +birdtracks = DocCodeBlock . DocString . intercalate "\n" . stripSpace <$> many1 line where line = skipHorizontalSpace *> ">" *> takeLine +-- | Strip leading spaces, but ignore blank lines. If any of the lines don't +-- start with a ' ', however, we don't touch the block. +stripSpace :: [String] -> [String] +stripSpace = fromMaybe <*> mapM strip + where + strip (' ':xs) = Just xs + strip "" = Just "" + strip _ = Nothing + -- | Parses examples. Examples are a paragraph level entitity (separated by an empty line). -- Consecutive examples are accepted. examples :: Parser (Doc a) diff --git a/test/Haddock/ParserSpec.hs b/test/Haddock/ParserSpec.hs index 455a67f..ac57b64 100644 --- a/test/Haddock/ParserSpec.hs +++ b/test/Haddock/ParserSpec.hs @@ -360,6 +360,24 @@ spec = before initStaticOpts $ do ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" + it "ignores single leading spaces" $ do + unlines [ + "> foo" + , "> bar" + , "> baz" + ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" + + unlines [ + "> foo" + , ">" + , "> bar" + ] `shouldParseTo` DocCodeBlock "foo\n\nbar" + + unlines [ + ">foo" + , "> bar" + ] `shouldParseTo` DocCodeBlock "foo\n bar" + it "ignores nested markup" $ do unlines [ ">/foo/" From git at git.haskell.org Sun Feb 23 06:50:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 23 Feb 2014 06:50:30 +0000 (UTC) Subject: [commit: haddock] master: Turn a source code comment into specs (dfc006a) Message-ID: <20140223065031.1822E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/dfc006ad2b8f5cb27570ac02c77aa63c5c027cd9 >--------------------------------------------------------------- commit dfc006ad2b8f5cb27570ac02c77aa63c5c027cd9 Author: Simon Hengel Date: Sat Feb 22 21:55:35 2014 +0100 Turn a source code comment into specs >--------------------------------------------------------------- dfc006ad2b8f5cb27570ac02c77aa63c5c027cd9 src/Haddock/Parser.hs | 2 -- test/Haddock/ParserSpec.hs | 17 ++++++++++------- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/Haddock/Parser.hs b/src/Haddock/Parser.hs index a6ad817..095f385 100644 --- a/src/Haddock/Parser.hs +++ b/src/Haddock/Parser.hs @@ -306,8 +306,6 @@ birdtracks = DocCodeBlock . DocString . intercalate "\n" . stripSpace <$> many1 where line = skipHorizontalSpace *> ">" *> takeLine --- | Strip leading spaces, but ignore blank lines. If any of the lines don't --- start with a ' ', however, we don't touch the block. stripSpace :: [String] -> [String] stripSpace = fromMaybe <*> mapM strip where diff --git a/test/Haddock/ParserSpec.hs b/test/Haddock/ParserSpec.hs index ac57b64..db843cc 100644 --- a/test/Haddock/ParserSpec.hs +++ b/test/Haddock/ParserSpec.hs @@ -360,23 +360,26 @@ spec = before initStaticOpts $ do ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" - it "ignores single leading spaces" $ do + it "strips one leading space from each line of the block" $ do unlines [ "> foo" - , "> bar" + , "> bar" , "> baz" - ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" + ] `shouldParseTo` DocCodeBlock "foo\n bar\nbaz" + it "ignores empty lines when stripping spaces" $ do unlines [ "> foo" , ">" , "> bar" ] `shouldParseTo` DocCodeBlock "foo\n\nbar" - unlines [ - ">foo" - , "> bar" - ] `shouldParseTo` DocCodeBlock "foo\n bar" + context "when any non-empty line does not start with a space" $ do + it "does not strip any spaces" $ do + unlines [ + ">foo" + , "> bar" + ] `shouldParseTo` DocCodeBlock "foo\n bar" it "ignores nested markup" $ do unlines [ From git at git.haskell.org Sun Feb 23 06:50:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 23 Feb 2014 06:50:33 +0000 (UTC) Subject: [commit: haddock] master: Update test case for lifted GADT type rendering (49b2a05) Message-ID: <20140223065033.1AC7C2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/49b2a05ee0d769568d97a091de93f2ce2512eef6 >--------------------------------------------------------------- commit 49b2a05ee0d769568d97a091de93f2ce2512eef6 Author: Mateusz Kowalczyk Date: Sun Feb 23 04:58:50 2014 +0000 Update test case for lifted GADT type rendering The parsing of these seems to have been fixed by GHC folk and it now renders differently. IMHO it now renders in a better way so I'm updating the test to reflect this. >--------------------------------------------------------------- 49b2a05ee0d769568d97a091de93f2ce2512eef6 html-test/ref/AdvanceTypes.html | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/html-test/ref/AdvanceTypes.html b/html-test/ref/AdvanceTypes.html index f4c4880..2141e59 100644 --- a/html-test/ref/AdvanceTypes.html +++ b/html-test/ref/AdvanceTypes.html @@ -63,7 +63,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_AdvanceTypes.html");}; >Nil :: Pattern `[]` []  Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/1944b94edca881d14e979d564719da6f196f8e63 >--------------------------------------------------------------- commit 1944b94edca881d14e979d564719da6f196f8e63 Author: Mateusz Kowalczyk Date: Sun Feb 23 05:02:47 2014 +0000 Don't shadow ?strip?. -Wall complains >--------------------------------------------------------------- 1944b94edca881d14e979d564719da6f196f8e63 src/Haddock/Parser.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Haddock/Parser.hs b/src/Haddock/Parser.hs index 095f385..cd7bb02 100644 --- a/src/Haddock/Parser.hs +++ b/src/Haddock/Parser.hs @@ -307,11 +307,11 @@ birdtracks = DocCodeBlock . DocString . intercalate "\n" . stripSpace <$> many1 line = skipHorizontalSpace *> ">" *> takeLine stripSpace :: [String] -> [String] -stripSpace = fromMaybe <*> mapM strip +stripSpace = fromMaybe <*> mapM strip' where - strip (' ':xs) = Just xs - strip "" = Just "" - strip _ = Nothing + strip' (' ':xs') = Just xs' + strip' "" = Just "" + strip' _ = Nothing -- | Parses examples. Examples are a paragraph level entitity (separated by an empty line). -- Consecutive examples are accepted. From git at git.haskell.org Sun Feb 23 22:29:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 23 Feb 2014 22:29:40 +0000 (UTC) Subject: [commit: haddock] master: Make ImplicitParams render correctly (#260) (14531f7) Message-ID: <20140223222940.987552406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/14531f7838c5abd0ba2aaf5217a477194d7b1897 >--------------------------------------------------------------- commit 14531f7838c5abd0ba2aaf5217a477194d7b1897 Author: Niklas Haas Date: Sun Feb 23 15:21:52 2014 +0100 Make ImplicitParams render correctly (#260) This introduces a new precedence level for single contexts (because implicit param contexts always need parens around them, but other types of contexts don't necessarily, even when alone) >--------------------------------------------------------------- 14531f7838c5abd0ba2aaf5217a477194d7b1897 html-test/ref/{Bold.html => ImplicitParams.html} | 74 ++++++++++------------ html-test/src/ImplicitParams.hs | 10 +++ src/Haddock/Backends/Xhtml/Decl.hs | 19 ++++-- src/Haddock/Backends/Xhtml/Names.hs | 2 +- 4 files changed, 55 insertions(+), 50 deletions(-) diff --git a/html-test/ref/Bold.html b/html-test/ref/ImplicitParams.html similarity index 59% copy from html-test/ref/Bold.html copy to html-test/ref/ImplicitParams.html index f6bdbd5..0219b32 100644 --- a/html-test/ref/Bold.html +++ b/html-test/ref/ImplicitParams.html @@ -3,13 +3,13 @@ >BoldImplicitParams

          Bold

          Synopsis

          ImplicitParams

          Documentation

          foo :: t

          Some bold text.

          • Bold in a list
          bold in a definition
          list
           bold in a code block
          data X

          c :: (?x :: X) => X

          d :: (?x :: X, ?y :: X) => (X, X)

          X +c = ?x + +d :: (?x :: X, ?y :: X) => (X, X) +d = (?x, ?y) diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 7236906..427d567 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -325,7 +325,7 @@ ppContext cxt unicode qual = ppContextNoLocs (map unLoc cxt) unicode qual ppHsContext :: [HsType DocName] -> Bool -> Qualification-> Html ppHsContext [] _ _ = noHtml -ppHsContext [p] unicode qual = ppType unicode qual p +ppHsContext [p] unicode qual = ppCtxType unicode qual p ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt) @@ -669,14 +669,16 @@ tupleParens _ = parenList -------------------------------------------------------------------------------- -pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int +pREC_TOP, pREC_CTX, pREC_FUN, pREC_OP, pREC_CON :: Int pREC_TOP = 0 :: Int -- type in ParseIface.y in GHC -pREC_FUN = 1 :: Int -- btype in ParseIface.y in GHC +pREC_CTX = 1 :: Int -- Used for single contexts, eg. ctx => type + -- (as opposed to (ctx1, ctx2) => type) +pREC_FUN = 2 :: Int -- btype in ParseIface.y in GHC -- Used for LH arg of (->) -pREC_OP = 2 :: Int -- Used for arg of any infix operator +pREC_OP = 3 :: Int -- Used for arg of any infix operator -- (we don't keep their fixities around) -pREC_CON = 3 :: Int -- Used for arg of type applicn: +pREC_CON = 4 :: Int -- Used for arg of type applicn: -- always parenthesise unless atomic maybeParen :: Int -- Precedence of context @@ -693,8 +695,10 @@ ppLParendType unicode qual y = ppParendType unicode qual (unLoc y) ppLFunLhType unicode qual y = ppFunLhType unicode qual (unLoc y) -ppType, ppParendType, ppFunLhType :: Bool -> Qualification-> HsType DocName -> Html +ppType, ppCtxType, ppParendType, ppFunLhType :: Bool -> Qualification + -> HsType DocName -> Html ppType unicode qual ty = ppr_mono_ty pREC_TOP ty unicode qual +ppCtxType unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual ppParendType unicode qual ty = ppr_mono_ty pREC_CON ty unicode qual ppFunLhType unicode qual ty = ppr_mono_ty pREC_FUN ty unicode qual @@ -735,7 +739,8 @@ ppr_mono_ty _ (HsKindSig ty kind) u q = parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q kind) ppr_mono_ty _ (HsListTy ty) u q = brackets (ppr_mono_lty pREC_TOP ty u q) ppr_mono_ty _ (HsPArrTy ty) u q = pabrackets (ppr_mono_lty pREC_TOP ty u q) -ppr_mono_ty _ (HsIParamTy n ty) u q = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q) +ppr_mono_ty ctxt_prec (HsIParamTy n ty) u q = + maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q ppr_mono_ty _ (HsSpliceTy {}) _ _ = error "ppr_mono_ty HsSpliceTy" ppr_mono_ty _ (HsQuasiQuoteTy {}) _ _ = error "ppr_mono_ty HsQuasiQuoteTy" ppr_mono_ty _ (HsRecTy {}) _ _ = error "ppr_mono_ty HsRecTy" diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs index 24577e2..33cd4f7 100644 --- a/src/Haddock/Backends/Xhtml/Names.hs +++ b/src/Haddock/Backends/Xhtml/Names.hs @@ -46,7 +46,7 @@ ppRdrName :: RdrName -> Html ppRdrName = ppOccName . rdrNameOcc ppIPName :: HsIPName -> Html -ppIPName = toHtml . unpackFS . hsIPNameFS +ppIPName = toHtml . ('?':) . unpackFS . hsIPNameFS ppUncheckedLink :: Qualification -> (ModuleName, OccName) -> Html From git at git.haskell.org Sun Feb 23 22:29:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 23 Feb 2014 22:29:42 +0000 (UTC) Subject: [commit: haddock] master: Lower precedence of equality constraints (64850ca) Message-ID: <20140223222942.934672406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/64850ca4f7dc2ca0fdb21d078d93cd636de5c87a >--------------------------------------------------------------- commit 64850ca4f7dc2ca0fdb21d078d93cd636de5c87a Author: Niklas Haas Date: Sun Feb 23 15:37:13 2014 +0100 Lower precedence of equality constraints This drops them to the new precedence pREC_CTX, which makes single eqaulity constraints show up as (a ~ b) => ty, in line with GHC's rendering. Additional tests added to make sure other type operators render as intended. Current behavior matches GHC >--------------------------------------------------------------- 64850ca4f7dc2ca0fdb21d078d93cd636de5c87a html-test/ref/TypeOperators.html | 110 ++++++++++++++++-------------------- html-test/src/TypeOperators.hs | 25 +++++--- src/Haddock/Backends/Xhtml/Decl.hs | 2 +- 3 files changed, 67 insertions(+), 70 deletions(-) diff --git a/html-test/ref/TypeOperators.html b/html-test/ref/TypeOperators.html index fa02b57..eb9c3e9 100644 --- a/html-test/ref/TypeOperators.html +++ b/html-test/ref/TypeOperators.html @@ -41,63 +41,9 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeOperators.html");} >

          TypeOperators

          Contents

          Synopsis

          • data a :-: b
          • data (a :+: b) c
          • data Op a b
          • newtype O g f a = O {}
          • biO :: (g `O` f) a

          stuff

          Documentation

          class a <=> b

          biO :: (g `O` f) a

          :: (g `O` f) a

          f :: (a ~ b) => a -> b

          g :: (a ~ b, b ~ c) => a -> c

          x :: (a :-: a) <=> (a `Op` a) => a

          y :: (a <=> a, (a `Op` a) <=> a) => a

          b + biO :: (g `O` f) a biO = undefined + +f :: (a ~ b) => a -> b +f = id + +g :: (a ~ b, b ~ c) => a -> c +g = id + +x :: ((a :-: a) <=> (a `Op` a)) => a +x = undefined + +y :: (a <=> a, (a `Op` a) <=> a) => a +y = undefined diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 427d567..2ecde08 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -750,7 +750,7 @@ ppr_mono_ty _ (HsExplicitTupleTy _ tys) u q = quote $ parenList $ map (p ppr_mono_ty _ (HsWrapTy {}) _ _ = error "ppr_mono_ty HsWrapTy" ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual - = maybeParen ctxt_prec pREC_OP $ + = maybeParen ctxt_prec pREC_CTX $ ppr_mono_lty pREC_OP ty1 unicode qual <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual From git at git.haskell.org Sun Feb 23 22:29:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 23 Feb 2014 22:29:44 +0000 (UTC) Subject: [commit: haddock] master: Add RankNTypes test case to ImplicitParams.hs (6ca2767) Message-ID: <20140223222944.97E8A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/6ca276702d04c9183caa98d1848f6aa5b88a8755 >--------------------------------------------------------------- commit 6ca276702d04c9183caa98d1848f6aa5b88a8755 Author: Niklas Haas Date: Sun Feb 23 16:11:22 2014 +0100 Add RankNTypes test case to ImplicitParams.hs This test actually tests what #260 originally reported - I omitted the RankNTypes scenario from the original fix because I realized it's not relevant to the underlying issue and indeed, this renders as intended now. Still good to have more tests. >--------------------------------------------------------------- 6ca276702d04c9183caa98d1848f6aa5b88a8755 html-test/ref/ImplicitParams.html | 22 ++++++++++++++++++++++ html-test/src/ImplicitParams.hs | 7 +++++-- 2 files changed, 27 insertions(+), 2 deletions(-) diff --git a/html-test/ref/ImplicitParams.html b/html-test/ref/ImplicitParams.html index 0219b32..83e8b09 100644 --- a/html-test/ref/ImplicitParams.html +++ b/html-test/ref/ImplicitParams.html @@ -51,6 +51,20 @@ window.onload = function () {pageLoad();setSynopsis("mini_ImplicitParams.html"); > X

          Constructors

          X 

          X)

          f :: ((?x :: X) => a) -> a

          Contents

          Synopsis

          • data a :-: b
          • data (a :+: b) c
          • data Op a b
          • newtype O g f a = O {}
          • biO :: (g `O` f) a

          stuff

          Documentation

          class a <=> b

          biO :: (g `O` f) a

          :: (g `O` f) a

          f :: (a ~ b) => a -> b

          g :: (a ~ b, b ~ c) => a -> c

          x :: (a :-: a) <=> (a `Op` a) => a

          y :: (a <=> a, (a `Op` a) <=> a) => a

          b + biO :: (g `O` f) a biO = undefined + +f :: (a ~ b) => a -> b +f = id + +g :: (a ~ b, b ~ c) => a -> c +g = id + +x :: ((a :-: a) <=> (a `Op` a)) => a +x = undefined + +y :: (a <=> a, (a `Op` a) <=> a) => a +y = undefined diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 427d567..2ecde08 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -750,7 +750,7 @@ ppr_mono_ty _ (HsExplicitTupleTy _ tys) u q = quote $ parenList $ map (p ppr_mono_ty _ (HsWrapTy {}) _ _ = error "ppr_mono_ty HsWrapTy" ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual - = maybeParen ctxt_prec pREC_OP $ + = maybeParen ctxt_prec pREC_CTX $ ppr_mono_lty pREC_OP ty1 unicode qual <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual From git at git.haskell.org Mon Feb 24 21:36:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Feb 2014 21:36:17 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Make ImplicitParams render correctly (#260) (90f216b) Message-ID: <20140224213617.BF14C2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/90f216bd3c1b1d708a5b41c31d2a1a067fce3d32 >--------------------------------------------------------------- commit 90f216bd3c1b1d708a5b41c31d2a1a067fce3d32 Author: Niklas Haas Date: Sun Feb 23 15:21:52 2014 +0100 Make ImplicitParams render correctly (#260) This introduces a new precedence level for single contexts (because implicit param contexts always need parens around them, but other types of contexts don't necessarily, even when alone) (cherry picked from commit 14531f7838c5abd0ba2aaf5217a477194d7b1897) >--------------------------------------------------------------- 90f216bd3c1b1d708a5b41c31d2a1a067fce3d32 html-test/ref/{Bold.html => ImplicitParams.html} | 74 ++++++++++------------ html-test/src/ImplicitParams.hs | 10 +++ src/Haddock/Backends/Xhtml/Decl.hs | 19 ++++-- src/Haddock/Backends/Xhtml/Names.hs | 2 +- 4 files changed, 55 insertions(+), 50 deletions(-) diff --git a/html-test/ref/Bold.html b/html-test/ref/ImplicitParams.html similarity index 59% copy from html-test/ref/Bold.html copy to html-test/ref/ImplicitParams.html index f6bdbd5..0219b32 100644 --- a/html-test/ref/Bold.html +++ b/html-test/ref/ImplicitParams.html @@ -3,13 +3,13 @@ >BoldImplicitParams

          Bold

          Synopsis

          ImplicitParams

          Documentation

          foo :: t

          Some bold text.

          • Bold in a list
          bold in a definition
          list
           bold in a code block
          data X

          c :: (?x :: X) => X

          d :: (?x :: X, ?y :: X) => (X, X)

          X +c = ?x + +d :: (?x :: X, ?y :: X) => (X, X) +d = (?x, ?y) diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 7236906..427d567 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -325,7 +325,7 @@ ppContext cxt unicode qual = ppContextNoLocs (map unLoc cxt) unicode qual ppHsContext :: [HsType DocName] -> Bool -> Qualification-> Html ppHsContext [] _ _ = noHtml -ppHsContext [p] unicode qual = ppType unicode qual p +ppHsContext [p] unicode qual = ppCtxType unicode qual p ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt) @@ -669,14 +669,16 @@ tupleParens _ = parenList -------------------------------------------------------------------------------- -pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int +pREC_TOP, pREC_CTX, pREC_FUN, pREC_OP, pREC_CON :: Int pREC_TOP = 0 :: Int -- type in ParseIface.y in GHC -pREC_FUN = 1 :: Int -- btype in ParseIface.y in GHC +pREC_CTX = 1 :: Int -- Used for single contexts, eg. ctx => type + -- (as opposed to (ctx1, ctx2) => type) +pREC_FUN = 2 :: Int -- btype in ParseIface.y in GHC -- Used for LH arg of (->) -pREC_OP = 2 :: Int -- Used for arg of any infix operator +pREC_OP = 3 :: Int -- Used for arg of any infix operator -- (we don't keep their fixities around) -pREC_CON = 3 :: Int -- Used for arg of type applicn: +pREC_CON = 4 :: Int -- Used for arg of type applicn: -- always parenthesise unless atomic maybeParen :: Int -- Precedence of context @@ -693,8 +695,10 @@ ppLParendType unicode qual y = ppParendType unicode qual (unLoc y) ppLFunLhType unicode qual y = ppFunLhType unicode qual (unLoc y) -ppType, ppParendType, ppFunLhType :: Bool -> Qualification-> HsType DocName -> Html +ppType, ppCtxType, ppParendType, ppFunLhType :: Bool -> Qualification + -> HsType DocName -> Html ppType unicode qual ty = ppr_mono_ty pREC_TOP ty unicode qual +ppCtxType unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual ppParendType unicode qual ty = ppr_mono_ty pREC_CON ty unicode qual ppFunLhType unicode qual ty = ppr_mono_ty pREC_FUN ty unicode qual @@ -735,7 +739,8 @@ ppr_mono_ty _ (HsKindSig ty kind) u q = parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q kind) ppr_mono_ty _ (HsListTy ty) u q = brackets (ppr_mono_lty pREC_TOP ty u q) ppr_mono_ty _ (HsPArrTy ty) u q = pabrackets (ppr_mono_lty pREC_TOP ty u q) -ppr_mono_ty _ (HsIParamTy n ty) u q = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q) +ppr_mono_ty ctxt_prec (HsIParamTy n ty) u q = + maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q ppr_mono_ty _ (HsSpliceTy {}) _ _ = error "ppr_mono_ty HsSpliceTy" ppr_mono_ty _ (HsQuasiQuoteTy {}) _ _ = error "ppr_mono_ty HsQuasiQuoteTy" ppr_mono_ty _ (HsRecTy {}) _ _ = error "ppr_mono_ty HsRecTy" diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs index 24577e2..33cd4f7 100644 --- a/src/Haddock/Backends/Xhtml/Names.hs +++ b/src/Haddock/Backends/Xhtml/Names.hs @@ -46,7 +46,7 @@ ppRdrName :: RdrName -> Html ppRdrName = ppOccName . rdrNameOcc ppIPName :: HsIPName -> Html -ppIPName = toHtml . unpackFS . hsIPNameFS +ppIPName = toHtml . ('?':) . unpackFS . hsIPNameFS ppUncheckedLink :: Qualification -> (ModuleName, OccName) -> Html From git at git.haskell.org Mon Feb 24 21:36:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Feb 2014 21:36:19 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Update test case for lifted GADT type rendering (3205d60) Message-ID: <20140224213619.CFEBB2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/3205d60ab9db17029d920cfcd5255c0b1367ae74 >--------------------------------------------------------------- commit 3205d60ab9db17029d920cfcd5255c0b1367ae74 Author: Mateusz Kowalczyk Date: Sun Feb 23 04:58:50 2014 +0000 Update test case for lifted GADT type rendering The parsing of these seems to have been fixed by GHC folk and it now renders differently. IMHO it now renders in a better way so I'm updating the test to reflect this. (cherry picked from commit 49b2a05ee0d769568d97a091de93f2ce2512eef6) >--------------------------------------------------------------- 3205d60ab9db17029d920cfcd5255c0b1367ae74 html-test/ref/AdvanceTypes.html | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/html-test/ref/AdvanceTypes.html b/html-test/ref/AdvanceTypes.html index f4c4880..2141e59 100644 --- a/html-test/ref/AdvanceTypes.html +++ b/html-test/ref/AdvanceTypes.html @@ -63,7 +63,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_AdvanceTypes.html");}; >Nil :: Pattern `[]` []  Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/e0865f5189f3afd1e2d0b1174233b29bb675de4b >--------------------------------------------------------------- commit e0865f5189f3afd1e2d0b1174233b29bb675de4b Author: Mateusz Kowalczyk Date: Mon Feb 24 06:26:50 2014 +0000 Fix wording in the docs (cherry picked from commit daa0ae5ba1acdee031cd72fc6690fe60a6710c20) >--------------------------------------------------------------- e0865f5189f3afd1e2d0b1174233b29bb675de4b doc/haddock.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/haddock.xml b/doc/haddock.xml index 8eb9ede..bec8067 100644 --- a/doc/haddock.xml +++ b/doc/haddock.xml @@ -1281,9 +1281,9 @@ module W where The Portability field has seen varied use by different library authors. Some people put down things like - operating system constraints there while others put down which - GHC extensions used. Note that you might want to consider using - the show-extensions module flag for the + operating system constraints there while others put down which GHC + extensions are used in the module. Note that you might want to + consider using the show-extensions module flag for the latter. Finally, a module may contain a documentation comment From git at git.haskell.org Mon Feb 24 21:36:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Feb 2014 21:36:23 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Fix rendering of Contents when links are present (b705518) Message-ID: <20140224213623.DE21D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/b705518edd6d038e31b9579fc1c63b02507a3a4e >--------------------------------------------------------------- commit b705518edd6d038e31b9579fc1c63b02507a3a4e Author: Mateusz Kowalczyk Date: Mon Feb 24 06:07:33 2014 +0000 Fix rendering of Contents when links are present Fixes Haddock Trac #267. (cherry picked from commit 1bf686940b28394f5d169f297659cd4c66869ec1) >--------------------------------------------------------------- b705518edd6d038e31b9579fc1c63b02507a3a4e src/Haddock/Backends/Xhtml.hs | 9 +++++---- src/Haddock/Backends/Xhtml/Decl.hs | 6 +++--- src/Haddock/Backends/Xhtml/DocMarkup.hs | 25 ++++++++++++++++++------- src/Haddock/Backends/Xhtml/Names.hs | 19 +++++++++++-------- 4 files changed, 37 insertions(+), 22 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b705518edd6d038e31b9579fc1c63b02507a3a4e From git at git.haskell.org Mon Feb 24 21:36:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Feb 2014 21:36:25 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Turn a source code comment into specs (240fb79) Message-ID: <20140224213625.DA0152406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/240fb794e36104b2c1412e36f63b7378f34d52ba >--------------------------------------------------------------- commit 240fb794e36104b2c1412e36f63b7378f34d52ba Author: Simon Hengel Date: Sat Feb 22 21:55:35 2014 +0100 Turn a source code comment into specs (cherry picked from commit dfc006ad2b8f5cb27570ac02c77aa63c5c027cd9) >--------------------------------------------------------------- 240fb794e36104b2c1412e36f63b7378f34d52ba src/Haddock/Parser.hs | 2 -- test/Haddock/ParserSpec.hs | 17 ++++++++++------- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/Haddock/Parser.hs b/src/Haddock/Parser.hs index a6ad817..095f385 100644 --- a/src/Haddock/Parser.hs +++ b/src/Haddock/Parser.hs @@ -306,8 +306,6 @@ birdtracks = DocCodeBlock . DocString . intercalate "\n" . stripSpace <$> many1 where line = skipHorizontalSpace *> ">" *> takeLine --- | Strip leading spaces, but ignore blank lines. If any of the lines don't --- start with a ' ', however, we don't touch the block. stripSpace :: [String] -> [String] stripSpace = fromMaybe <*> mapM strip where diff --git a/test/Haddock/ParserSpec.hs b/test/Haddock/ParserSpec.hs index ac57b64..db843cc 100644 --- a/test/Haddock/ParserSpec.hs +++ b/test/Haddock/ParserSpec.hs @@ -360,23 +360,26 @@ spec = before initStaticOpts $ do ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" - it "ignores single leading spaces" $ do + it "strips one leading space from each line of the block" $ do unlines [ "> foo" - , "> bar" + , "> bar" , "> baz" - ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" + ] `shouldParseTo` DocCodeBlock "foo\n bar\nbaz" + it "ignores empty lines when stripping spaces" $ do unlines [ "> foo" , ">" , "> bar" ] `shouldParseTo` DocCodeBlock "foo\n\nbar" - unlines [ - ">foo" - , "> bar" - ] `shouldParseTo` DocCodeBlock "foo\n bar" + context "when any non-empty line does not start with a space" $ do + it "does not strip any spaces" $ do + unlines [ + ">foo" + , "> bar" + ] `shouldParseTo` DocCodeBlock "foo\n bar" it "ignores nested markup" $ do unlines [ From git at git.haskell.org Mon Feb 24 21:36:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Feb 2014 21:36:27 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Don't shadow ‘strip’. (5e852cc) Message-ID: <20140224213627.DBFA32406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/5e852cc642e761b3191be5a5ca2b2e792a02d560 >--------------------------------------------------------------- commit 5e852cc642e761b3191be5a5ca2b2e792a02d560 Author: Mateusz Kowalczyk Date: Sun Feb 23 05:02:47 2014 +0000 Don't shadow ?strip?. -Wall complains (cherry picked from commit 1944b94edca881d14e979d564719da6f196f8e63) >--------------------------------------------------------------- 5e852cc642e761b3191be5a5ca2b2e792a02d560 src/Haddock/Parser.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Haddock/Parser.hs b/src/Haddock/Parser.hs index 095f385..cd7bb02 100644 --- a/src/Haddock/Parser.hs +++ b/src/Haddock/Parser.hs @@ -307,11 +307,11 @@ birdtracks = DocCodeBlock . DocString . intercalate "\n" . stripSpace <$> many1 line = skipHorizontalSpace *> ">" *> takeLine stripSpace :: [String] -> [String] -stripSpace = fromMaybe <*> mapM strip +stripSpace = fromMaybe <*> mapM strip' where - strip (' ':xs) = Just xs - strip "" = Just "" - strip _ = Nothing + strip' (' ':xs') = Just xs' + strip' "" = Just "" + strip' _ = Nothing -- | Parses examples. Examples are a paragraph level entitity (separated by an empty line). -- Consecutive examples are accepted. From git at git.haskell.org Mon Feb 24 21:36:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Feb 2014 21:36:29 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Strip a single leading space from bird tracks (#201) (7417f5b) Message-ID: <20140224213629.E589A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/7417f5b3bdcd768e9cc66baa36a501417d7f8bce >--------------------------------------------------------------- commit 7417f5b3bdcd768e9cc66baa36a501417d7f8bce Author: Niklas Haas Date: Sat Feb 22 21:15:34 2014 +0100 Strip a single leading space from bird tracks (#201) This makes bird tracks in the form > foo > bar > bat parse as if they had been written as >foo >bar >bat ie. without the leading whitespace in front of every line. Ideally we also want to look into how leading whitespace affects code blocks written using the @ @ syntax, which are currently unaffected by this patch. (cherry picked from commit fc7fd1875d31dbfd37eaa058177e534b4fc6bc25) >--------------------------------------------------------------- 7417f5b3bdcd768e9cc66baa36a501417d7f8bce html-test/ref/Nesting.html | 24 ++++++++++++++-------- html-test/ref/SpuriousSuperclassConstraints.html | 4 ++-- html-test/ref/Test.html | 14 ++++++------- html-test/src/Nesting.hs | 6 ++++++ src/Haddock/Parser.hs | 11 +++++++++- test/Haddock/ParserSpec.hs | 18 ++++++++++++++++ 6 files changed, 58 insertions(+), 19 deletions(-) diff --git a/html-test/ref/Nesting.html b/html-test/ref/Nesting.html index 0d69279..4178767 100644 --- a/html-test/ref/Nesting.html +++ b/html-test/ref/Nesting.html @@ -166,9 +166,9 @@ the presence of this text pushes it out of nesting back to the top.
          • Beginning of list
             nested
- bird
- tracks
            nested +bird +tracks
        • Beginning of list This belongs to the list above!
           nested
- bird
- tracks
          nested +bird +tracks + +another line + with indentation
          nested bird tracks
+  without leading space
          • Next list @@ -221,9 +227,9 @@ More of the indented list.
              Works for definition lists too.
               nested
- bird
- tracks
              nested +bird +tracks
              • Next list diff --git a/html-test/ref/SpuriousSuperclassConstraints.html b/html-test/ref/SpuriousSuperclassConstraints.html index 77e1346..171e3d2 100644 --- a/html-test/ref/SpuriousSuperclassConstraints.html +++ b/html-test/ref/SpuriousSuperclassConstraints.html @@ -63,8 +63,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_SpuriousSuperclassCons >

                It has been fixed in:

                 6ccf78e15a525282fef61bc4f58a279aa9c21771
- Fix spurious superclass constraints bug.
                6ccf78e15a525282fef61bc4f58a279aa9c21771 +Fix spurious superclass constraints bug.
                 this is another block of code
                this is another block of code

                We can also include URLs in documentation: http://www.haskell.org/

                 foo
                foo
                 bar
                bar

                This is some inline documentation in the export list

                 a code block using bird-tracks
- each line must begin with > (which isn't significant unless it
- is at the beginning of the line).
                a code block using bird-tracks +each line must begin with > (which isn't significant unless it +is at the beginning of the line).

                A hidden module

                A subsection
                 a literal line
                a literal line

                $ a non literal nested > bird > tracks + > + > another line + > with indentation + + >nested bird tracks + > without leading space * Next list More of the indented list. diff --git a/src/Haddock/Parser.hs b/src/Haddock/Parser.hs index e9bed2a..a6ad817 100644 --- a/src/Haddock/Parser.hs +++ b/src/Haddock/Parser.hs @@ -302,10 +302,19 @@ takeNonEmptyLine = do (++ "\n") . decodeUtf8 <$> (takeWhile1 (/= '\n') >>= nonSpace) <* "\n" birdtracks :: Parser (Doc a) -birdtracks = DocCodeBlock . DocString . intercalate "\n" <$> many1 line +birdtracks = DocCodeBlock . DocString . intercalate "\n" . stripSpace <$> many1 line where line = skipHorizontalSpace *> ">" *> takeLine +-- | Strip leading spaces, but ignore blank lines. If any of the lines don't +-- start with a ' ', however, we don't touch the block. +stripSpace :: [String] -> [String] +stripSpace = fromMaybe <*> mapM strip + where + strip (' ':xs) = Just xs + strip "" = Just "" + strip _ = Nothing + -- | Parses examples. Examples are a paragraph level entitity (separated by an empty line). -- Consecutive examples are accepted. examples :: Parser (Doc a) diff --git a/test/Haddock/ParserSpec.hs b/test/Haddock/ParserSpec.hs index 455a67f..ac57b64 100644 --- a/test/Haddock/ParserSpec.hs +++ b/test/Haddock/ParserSpec.hs @@ -360,6 +360,24 @@ spec = before initStaticOpts $ do ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" + it "ignores single leading spaces" $ do + unlines [ + "> foo" + , "> bar" + , "> baz" + ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" + + unlines [ + "> foo" + , ">" + , "> bar" + ] `shouldParseTo` DocCodeBlock "foo\n\nbar" + + unlines [ + ">foo" + , "> bar" + ] `shouldParseTo` DocCodeBlock "foo\n bar" + it "ignores nested markup" $ do unlines [ ">/foo/" From git at git.haskell.org Mon Feb 24 21:36:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Feb 2014 21:36:31 +0000 (UTC) Subject: [commit: haddock] ghc-7.8: Add RankNTypes test case to ImplicitParams.hs (68ce934) Message-ID: <20140224213632.B12E82406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : ghc-7.8 Link : http://git.haskell.org/haddock.git/commitdiff/68ce934d7a4c9db5a0c84d2c792bbdf938d9070c >--------------------------------------------------------------- commit 68ce934d7a4c9db5a0c84d2c792bbdf938d9070c Author: Niklas Haas Date: Sun Feb 23 16:11:22 2014 +0100 Add RankNTypes test case to ImplicitParams.hs This test actually tests what #260 originally reported - I omitted the RankNTypes scenario from the original fix because I realized it's not relevant to the underlying issue and indeed, this renders as intended now. Still good to have more tests. (cherry picked from commit 6ca276702d04c9183caa98d1848f6aa5b88a8755) >--------------------------------------------------------------- 68ce934d7a4c9db5a0c84d2c792bbdf938d9070c html-test/ref/ImplicitParams.html | 22 ++++++++++++++++++++++ html-test/src/ImplicitParams.hs | 7 +++++-- 2 files changed, 27 insertions(+), 2 deletions(-) diff --git a/html-test/ref/ImplicitParams.html b/html-test/ref/ImplicitParams.html index 0219b32..83e8b09 100644 --- a/html-test/ref/ImplicitParams.html +++ b/html-test/ref/ImplicitParams.html @@ -51,6 +51,20 @@ window.onload = function () {pageLoad();setSynopsis("mini_ImplicitParams.html"); > X

                Constructors

                X 

                X)

                f :: ((?x :: X) => a) -> a