From git at git.haskell.org Mon Sep 1 07:57:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Sep 2014 07:57:17 +0000 (UTC) Subject: [commit: ghc] master: Remove incorrect property in docstring (re #9532) (3241ac5) Message-ID: <20140901075717.4C84624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3241ac56d371220ed0b9522a86678678532f48bc/ghc >--------------------------------------------------------------- commit 3241ac56d371220ed0b9522a86678678532f48bc Author: Herbert Valerio Riedel Date: Mon Sep 1 09:50:16 2014 +0200 Remove incorrect property in docstring (re #9532) The property countLeadingZeros . negate = const 0 doesn't generally hold and it's not such a useful property to state, as it simply follows from "sign-bit == most-significant-bit" for FiniteBits types which use twos-complement representation for negative values, and even then it breaks down for 0... TLDR, remove thinko from documentation of `countLeadingZeros` >--------------------------------------------------------------- 3241ac56d371220ed0b9522a86678678532f48bc libraries/base/Data/Bits.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/libraries/base/Data/Bits.hs b/libraries/base/Data/Bits.hs index 532f5d5..cdef2fb 100644 --- a/libraries/base/Data/Bits.hs +++ b/libraries/base/Data/Bits.hs @@ -296,7 +296,6 @@ class Bits b => FiniteBits b where -- -- @ -- 'countLeadingZeros' ('zeroBits' :: a) = finiteBitSize ('zeroBits' :: a) - -- 'countLeadingZeros' . 'negate' = 'const' 0 -- @ -- -- 'countLeadingZeros' can be used to compute log base 2 via From git at git.haskell.org Mon Sep 1 10:06:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Sep 2014 10:06:42 +0000 (UTC) Subject: [commit: ghc] master: Make ghc-api cleaning less aggressive. (a4ec0c9) Message-ID: <20140901100643.2B3DE24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a4ec0c9227b40837eefa9b7c80d6028162b80f35/ghc >--------------------------------------------------------------- commit a4ec0c9227b40837eefa9b7c80d6028162b80f35 Author: Edward Z. Yang Date: Mon Sep 1 11:16:15 2014 +0200 Make ghc-api cleaning less aggressive. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- a4ec0c9227b40837eefa9b7c80d6028162b80f35 testsuite/tests/ghc-api/Makefile | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/ghc-api/Makefile b/testsuite/tests/ghc-api/Makefile index 855b774..0900dee 100644 --- a/testsuite/tests/ghc-api/Makefile +++ b/testsuite/tests/ghc-api/Makefile @@ -5,15 +5,18 @@ include $(TOP)/mk/test.mk clean: rm -f *.o *.hi -T6145: clean +T6145: + rm -f T6145.o T6145.hi '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc T6145 ./T6145 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" -T8639_api: clean +T8639_api: + rm -f T8639_api.o T8639_api.hi '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc T8639_api ./T8639_api "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" -T8628: clean +T8628: + rm -f T8628.o T8628.hi '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc T8628 ./T8628 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" From git at git.haskell.org Mon Sep 1 18:14:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Sep 2014 18:14:43 +0000 (UTC) Subject: [commit: ghc] master: testsuite: update T6056 rule firing order (01a27c9) Message-ID: <20140901181445.0487B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/01a27c9de050ed68f39fa2d870d0930ec3dd207c/ghc >--------------------------------------------------------------- commit 01a27c9de050ed68f39fa2d870d0930ec3dd207c Author: Sergei Trofimovich Date: Mon Sep 1 21:13:45 2014 +0300 testsuite: update T6056 rule firing order Fixes testsuite failure. Summary: Signed-off-by: Sergei Trofimovich Test Plan: validate --slow Reviewers: simonpj, austin Reviewed By: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D184 >--------------------------------------------------------------- 01a27c9de050ed68f39fa2d870d0930ec3dd207c testsuite/tests/simplCore/should_compile/T6056.stderr | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/simplCore/should_compile/T6056.stderr b/testsuite/tests/simplCore/should_compile/T6056.stderr index 10226d8..d1ae187 100644 --- a/testsuite/tests/simplCore/should_compile/T6056.stderr +++ b/testsuite/tests/simplCore/should_compile/T6056.stderr @@ -15,6 +15,6 @@ Rule fired: Rule fired: SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Types.Int Rule fired: - SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Types.Int -Rule fired: SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Integer.Type.Integer +Rule fired: + SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Types.Int From git at git.haskell.org Mon Sep 1 18:15:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Sep 2014 18:15:41 +0000 (UTC) Subject: [commit: ghc] master: includes/Stg.h: remove unused 'wcStore' inline (e81e028) Message-ID: <20140901181541.C2B0D24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e81e02807c7a0e723ed7b0e83418c95f99140449/ghc >--------------------------------------------------------------- commit e81e02807c7a0e723ed7b0e83418c95f99140449 Author: Sergei Trofimovich Date: Mon Sep 1 21:15:21 2014 +0300 includes/Stg.h: remove unused 'wcStore' inline Summary: Commit reverts never used addition in cbd29e0a23bb8e15033edae123d6c8fbe9740c97 I think it might make sense to take advantage of TSO/RMO/PSO models tome day. But it's highly architecture/model-dependent thus it better be implemented in per-arch Native CodeGen. Signed-off-by: Sergei Trofimovich Test Plan: build-tested on UNREG-amd64 Reviewers: simonmar, austin Reviewed By: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D186 >--------------------------------------------------------------- e81e02807c7a0e723ed7b0e83418c95f99140449 includes/Stg.h | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/includes/Stg.h b/includes/Stg.h index 8b3a3fc..4c26e3e 100644 --- a/includes/Stg.h +++ b/includes/Stg.h @@ -477,24 +477,6 @@ INLINE_HEADER StgInt64 PK_Int64(W_ p_src[]) #endif /* ----------------------------------------------------------------------------- - Write-combining store - -------------------------------------------------------------------------- */ - -INLINE_HEADER void -wcStore (StgPtr p, StgWord w) -{ -#ifdef x86_64_HOST_ARCH - __asm__( - "movnti\t%1, %0" - : "=m" (*p) - : "r" (w) - ); -#else - *p = w; -#endif -} - -/* ----------------------------------------------------------------------------- Integer multiply with overflow -------------------------------------------------------------------------- */ From git at git.haskell.org Mon Sep 1 20:15:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Sep 2014 20:15:02 +0000 (UTC) Subject: [commit: ghc] master: StringBuffer should not contain initial byte-order mark (BOM) (9e93940) Message-ID: <20140901201503.0158F24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9e939403241b758a685834c9ff62edcd3172a2cf/ghc >--------------------------------------------------------------- commit 9e939403241b758a685834c9ff62edcd3172a2cf Author: Thomas Miedema Date: Mon Sep 1 15:11:50 2014 -0500 StringBuffer should not contain initial byte-order mark (BOM) Summary: Just skipping over a BOM, but leaving it in the Stringbuffer, is not sufficient. The Lexer calls prevChar when a regular expression starts with '^' (which is a shorthand for '\n^'). It would never match on the first line, since instead of '\n', prevChar would still return '\xfeff'. Test Plan: validate Reviewers: austin, ezyang Reviewed By: austin, ezyang Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D176 GHC Trac Issues: #6016 >--------------------------------------------------------------- 9e939403241b758a685834c9ff62edcd3172a2cf compiler/utils/StringBuffer.lhs | 45 +++++++++++++++++++++++---------- testsuite/.gitignore | 2 ++ testsuite/tests/parser/unicode/T6016.hs | 34 +++++++++++++++++++++++++ testsuite/tests/parser/unicode/all.T | 1 + 4 files changed, 69 insertions(+), 13 deletions(-) diff --git a/compiler/utils/StringBuffer.lhs b/compiler/utils/StringBuffer.lhs index a54f45f..50d8443 100644 --- a/compiler/utils/StringBuffer.lhs +++ b/compiler/utils/StringBuffer.lhs @@ -47,9 +47,12 @@ import Encoding import FastString import FastTypes import FastFunctions +import Outputable +import Util -import System.IO ( hGetBuf, hFileSize,IOMode(ReadMode), hClose - , Handle, hTell, openBinaryFile ) +import Data.Maybe +import Control.Exception +import System.IO import System.IO.Unsafe ( unsafePerformIO ) import GHC.Exts @@ -89,7 +92,8 @@ hGetStringBuffer :: FilePath -> IO StringBuffer hGetStringBuffer fname = do h <- openBinaryFile fname ReadMode size_i <- hFileSize h - let size = fromIntegral size_i + offset_i <- skipBOM h size_i 0 -- offset is 0 initially + let size = fromIntegral $ size_i - offset_i buf <- mallocForeignPtrArray (size+3) withForeignPtr buf $ \ptr -> do r <- if size == 0 then return 0 else hGetBuf h ptr size @@ -101,7 +105,7 @@ hGetStringBuffer fname = do hGetStringBufferBlock :: Handle -> Int -> IO StringBuffer hGetStringBufferBlock handle wanted = do size_i <- hFileSize handle - offset_i <- hTell handle + offset_i <- hTell handle >>= skipBOM handle size_i let size = min wanted (fromIntegral $ size_i-offset_i) buf <- mallocForeignPtrArray (size+3) withForeignPtr buf $ \ptr -> @@ -110,19 +114,34 @@ hGetStringBufferBlock handle wanted then ioError (userError $ "short read of file: "++show(r,size,size_i,handle)) else newUTF8StringBuffer buf ptr size +-- | Skip the byte-order mark if there is one (see #1744 and #6016), +-- and return the new position of the handle in bytes. +-- +-- This is better than treating #FEFF as whitespace, +-- because that would mess up layout. We don't have a concept +-- of zero-width whitespace in Haskell: all whitespace codepoints +-- have a width of one column. +skipBOM :: Handle -> Integer -> Integer -> IO Integer +skipBOM h size offset = + -- Only skip BOM at the beginning of a file. + if size > 0 && offset == 0 + then do + -- Validate assumption that handle is in binary mode. + ASSERTM( hGetEncoding h >>= return . isNothing ) + -- Temporarily select text mode to make `hLookAhead` and + -- `hGetChar` return full Unicode characters. + bracket_ (hSetBinaryMode h False) (hSetBinaryMode h True) $ do + c <- hLookAhead h + if c == '\xfeff' + then hGetChar h >> hTell h + else return offset + else return offset + newUTF8StringBuffer :: ForeignPtr Word8 -> Ptr Word8 -> Int -> IO StringBuffer newUTF8StringBuffer buf ptr size = do pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0] -- sentinels for UTF-8 decoding - let - sb0 = StringBuffer buf size 0 - (first_char, sb1) = nextChar sb0 - -- skip the byte-order mark if there is one (see #1744) - -- This is better than treating #FEFF as whitespace, - -- because that would mess up layout. We don't have a concept - -- of zero-width whitespace in Haskell: all whitespace codepoints - -- have a width of one column. - return (if first_char == '\xfeff' then sb1 else sb0) + return $ StringBuffer buf size 0 appendStringBuffers :: StringBuffer -> StringBuffer -> IO StringBuffer appendStringBuffers sb1 sb2 diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 591545c..4f8ac87 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1074,6 +1074,8 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/parser/should_run/readRun004 /tests/parser/unicode/1744 /tests/parser/unicode/T1744 +/tests/parser/unicode/T6016 +/tests/parser/unicode/T6016-twoBOMs /tests/parser/unicode/utf8_024 /tests/patsyn/should_run/bidir-explicit /tests/patsyn/should_run/bidir-explicit-scope diff --git a/testsuite/tests/parser/unicode/T6016.hs b/testsuite/tests/parser/unicode/T6016.hs new file mode 100644 index 0000000..5783a72 --- /dev/null +++ b/testsuite/tests/parser/unicode/T6016.hs @@ -0,0 +1,34 @@ +module Main where + +import Control.Exception +import Data.Char +import System.IO + +import StringBuffer + +twoBOMs = "T6016-twoBOMs" + +ignoreFirstBOM = do + -- StringBuffer should not contain initial byte-order mark. + -- + -- Just skipping over it, but leaving it in the Stringbuffer, is not + -- sufficient. The Lexer calls prevChar when a regular expression + -- starts with '^' (which is a shorthand for '\n^'). It would never + -- match on the first line, since instead of '\n', prevChar would + -- still return '\xfeff'. + s <- hGetStringBuffer twoBOMs + assert (prevChar s '\n' == '\n') return () + +dontIgnoreSecondBOM = do + -- U+FEFF is considered a BOM only if it appears as the first + -- character of a file. + h <- openBinaryFile twoBOMs ReadMode + hSeek h AbsoluteSeek 3 + s <- hGetStringBufferBlock h 3 + hClose h + assert (currentChar s == '\xfeff') return () + +main = do + writeFile twoBOMs "\xfeff\xfeff" + ignoreFirstBOM + dontIgnoreSecondBOM diff --git a/testsuite/tests/parser/unicode/all.T b/testsuite/tests/parser/unicode/all.T index a8e19eb..2ff7edf 100644 --- a/testsuite/tests/parser/unicode/all.T +++ b/testsuite/tests/parser/unicode/all.T @@ -20,4 +20,5 @@ test('T1744', normal, compile_and_run, ['']) test('T1103', normal, compile, ['']) test('T2302', only_ways(['normal']), compile_fail, ['']) test('T4373', normal, compile, ['']) +test('T6016', extra_clean('T6016-twoBOMs'), compile_and_run, ['-package ghc']) test('T7671', normal, compile, ['']) From git at git.haskell.org Mon Sep 1 20:15:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Sep 2014 20:15:04 +0000 (UTC) Subject: [commit: ghc] master: Cleanup and better documentation of sync-all script (0f31c2e) Message-ID: <20140901201505.03FDA24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0f31c2e5c1cf240a78221bb09578f6eb7084ada5/ghc >--------------------------------------------------------------- commit 0f31c2e5c1cf240a78221bb09578f6eb7084ada5 Author: Thomas Miedema Date: Mon Sep 1 15:12:32 2014 -0500 Cleanup and better documentation of sync-all script Summary: Rumor has it that sync-all is slowly on the way out. Now that all subrepositories have been turned into git submodules, sync-all might not be needed anymore. Nevertheless, here are some changes I had made while trying to understand why it existed in the first place: * update comments + help text * rename some variables for maintainability * s/branch_name/remote_name/ origin is the name of a remote, not a branch * s/repo_base/remote_root/ the word *remote* is key here * s/defaultrepo/default_root/ this was a darcsism, and it doesn't refer to a repository but to the root directory of all repositories * small tweaks * .git can be a file nowadays * don't skip END actions on exceptions #8886 reverts d523f9b3d4ce3463e8816cad2139ea397e00f8d1 Test Plan: Why revert d523f9b3d4ce3463e8816cad2139ea397e00f8d1? I put an old haddock repository from http://darcs.haskell.org/haddock2.git back in my tree. Now, when running `sync-all get`, the following happens: 1. I get a cryptic error saying: fatal: reference is not a tree: 5412c262f403e52be45d607b34eb3a5806ea2a76 Unable to checkout '5412c262f403e52be45d607b34eb3a5806ea2a76' in submodule path 'utils/haddock' git failed: 256 at ./sync-all line 112. 2. sync-all checks if maybe an old haddock repository is present 3. I get a clear warning saying: ============================ ATTENTION! You have an old haddock repository in your GHC tree! Please remove it (e.g. "rm -r utils/haddock"), and then run "./sync-all get" to get the new repository. ============================ Without commit d523f9b3d4ce3463e8816cad2139ea397e00f8d1 reverted, steps 2 and 3 were skipped. The problem that commit tried to solve, is now solved with 7012ed8515100b4947383e93b82dbff7a0aa835c. Reviewers: nomeata, austin, hvr Reviewed By: austin, hvr Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D178 GHC Trac Issues: #8886, #9212 >--------------------------------------------------------------- 0f31c2e5c1cf240a78221bb09578f6eb7084ada5 sync-all | 296 +++++++++++++++++++++++++++++++++------------------------------ 1 file changed, 157 insertions(+), 139 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 0f31c2e5c1cf240a78221bb09578f6eb7084ada5 From git at git.haskell.org Mon Sep 1 20:15:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Sep 2014 20:15:10 +0000 (UTC) Subject: [commit: ghc] master: genprimopcode: GHC.Prim is Unsafe (#9449) (3be704a) Message-ID: <20140901201510.4507624123@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3be704ab373ecd84d97b832c0d4f59dd7cb9e0ea/ghc >--------------------------------------------------------------- commit 3be704ab373ecd84d97b832c0d4f59dd7cb9e0ea Author: Austin Seipp Date: Mon Sep 1 15:13:44 2014 -0500 genprimopcode: GHC.Prim is Unsafe (#9449) Summary: Make sure the documentation for `GHC.Prim` adequately reflects the fact it is unsafe. Also clean up some 80-column violations. Signed-off-by: Austin Seipp Test Plan: Build documentation, check `GHC.Prim`. It's properly marked as `Unsafe`. Reviewers: hvr, goldfire, ezyang Reviewed By: ezyang Subscribers: nomeata, simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D182 GHC Trac Issues: #9449 >--------------------------------------------------------------- 3be704ab373ecd84d97b832c0d4f59dd7cb9e0ea utils/genprimopcode/Main.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index bb40917..67c2131 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -227,7 +227,7 @@ gen_hs_source (Info defaults entries) = ++ "consumed by haddock.\n" ++ "-}\n" ++ "\n" - ++ "-----------------------------------------------------------------------------\n" + ++ (replicate 77 '-' ++ "\n") -- For 80-col cleanliness ++ "-- |\n" ++ "-- Module : GHC.Prim\n" ++ "-- \n" @@ -239,8 +239,12 @@ gen_hs_source (Info defaults entries) = ++ "-- Use GHC.Exts from the base package instead of importing this\n" ++ "-- module directly.\n" ++ "--\n" - ++ "-----------------------------------------------------------------------------\n" - ++ "{-# LANGUAGE MagicHash, MultiParamTypeClasses, NoImplicitPrelude, UnboxedTuples #-}\n" + ++ (replicate 77 '-' ++ "\n") -- For 80-col cleanliness + ++ "{-# LANGUAGE Unsafe #-}\n" + ++ "{-# LANGUAGE MagicHash #-}\n" + ++ "{-# LANGUAGE MultiParamTypeClasses #-}\n" + ++ "{-# LANGUAGE NoImplicitPrelude #-}\n" + ++ "{-# LANGUAGE UnboxedTuples #-}\n" ++ "module GHC.Prim (\n" ++ unlines (map ((" " ++) . hdr) entries') ++ ") where\n" From git at git.haskell.org Mon Sep 1 20:15:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Sep 2014 20:15:12 +0000 (UTC) Subject: [commit: ghc] master: Refactor stack squeezing logic (2f343b0) Message-ID: <20140901201512.BFDFE24123@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f343b0cbf8adf5b9df49c7a21f1914a38811dcf/ghc >--------------------------------------------------------------- commit 2f343b0cbf8adf5b9df49c7a21f1914a38811dcf Author: Arash Rouhani Date: Mon Sep 1 15:13:57 2014 -0500 Refactor stack squeezing logic Summary: This patch is only to make the code easier to read. In addition, this is the first patch I send with the arc/differential workflow. So I start with something very small. Test Plan: I have not even tried to compile it yet. Reviewers: simonmar, austin Reviewed By: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D189 >--------------------------------------------------------------- 2f343b0cbf8adf5b9df49c7a21f1914a38811dcf rts/ThreadPaused.c | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/rts/ThreadPaused.c b/rts/ThreadPaused.c index bf7def4..af37b53 100644 --- a/rts/ThreadPaused.c +++ b/rts/ThreadPaused.c @@ -26,6 +26,7 @@ * * -------------------------------------------------------------------------- */ + struct stack_gap { StgWord gap_size; struct stack_gap *next_gap; }; static struct stack_gap * @@ -131,7 +132,7 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom) adjacent_update_frames, gap); } - // Now we have a stack with gaps in it, and we have to walk down + // Now we have a stack with gap-structs in it, and we have to walk down // shoving the stack up to fill in the gaps. A diagram might // help: // @@ -200,6 +201,7 @@ threadPaused(Capability *cap, StgTSO *tso) nat weight = 0; nat weight_pending = 0; rtsBool prev_was_update_frame = rtsFalse; + StgWord heuristic_says_squeeze; // Check to see whether we have threads waiting to raise // exceptions, and we're not blocking exceptions, or are blocked @@ -358,17 +360,20 @@ threadPaused(Capability *cap, StgTSO *tso) } end: - debugTrace(DEBUG_squeeze, - "words_to_squeeze: %d, weight: %d, squeeze: %s", - words_to_squeeze, weight, - ((weight <= 8 && words_to_squeeze > 0) || weight < words_to_squeeze) ? "YES" : "NO"); - // Should we squeeze or not? Arbitrary heuristic: we squeeze if // the number of words we have to shift down is less than the // number of stack words we squeeze away by doing so. + // The threshold was bumped from 5 to 8 as a result of #2797 + heuristic_says_squeeze = ((weight <= 8 && words_to_squeeze > 0) + || weight < words_to_squeeze); + + debugTrace(DEBUG_squeeze, + "words_to_squeeze: %d, weight: %d, squeeze: %s", + words_to_squeeze, weight, + heuristic_says_squeeze ? "YES" : "NO"); + if (RtsFlags.GcFlags.squeezeUpdFrames == rtsTrue && - ((weight <= 8 && words_to_squeeze > 0) || weight < words_to_squeeze)) { - // threshold above bumped from 5 to 8 as a result of #2797 + heuristic_says_squeeze) { stackSqueeze(cap, tso, (StgPtr)frame); tso->flags |= TSO_SQUEEZED; // This flag tells threadStackOverflow() that the stack was From git at git.haskell.org Mon Sep 1 20:15:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Sep 2014 20:15:07 +0000 (UTC) Subject: [commit: ghc] master: Make Lexer.x more like the 2010 report (64c9898) Message-ID: <20140901201507.E5B2824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/64c9898f7b5239435f131f5444d62bda23dfc9ef/ghc >--------------------------------------------------------------- commit 64c9898f7b5239435f131f5444d62bda23dfc9ef Author: Thomas Miedema Date: Mon Sep 1 15:13:00 2014 -0500 Make Lexer.x more like the 2010 report Summary: I tried reading the lexer and the 2010 report side-by-side. Althought I didn't quite finish, here are some small discrepancies that I found. This revision may be low priority for reviewers, but having these commits just in my local repository does no good either. Changes: * $nl was defined, but not used anywhere * formfeed is a newline character * add \: to $ascsymbol For simplification reason, the colon (':') was added to the character set $ascsymbol in the 2010 report. Here we make the same change. * introduce the macros `qvarid`, `qconid`, `qvarsym` and `qconsym` * foreign is a Haskell keyword * add/update comments Test Plan: Harbormaster (is awesome) Reviewers: simonmar, hvr, austin Reviewed By: austin Subscribers: hvr, simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D180 >--------------------------------------------------------------- 64c9898f7b5239435f131f5444d62bda23dfc9ef compiler/parser/Lexer.x | 115 ++++++++++++++++++++++++++++++------------------ 1 file changed, 73 insertions(+), 42 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 64c9898f7b5239435f131f5444d62bda23dfc9ef From git at git.haskell.org Mon Sep 1 20:15:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Sep 2014 20:15:15 +0000 (UTC) Subject: [commit: ghc] master: Set llc and opt commands on all platforms (918719b) Message-ID: <20140901201515.CE0D624121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/918719b936b878ab660f20ceef8afc9e3a898c5a/ghc >--------------------------------------------------------------- commit 918719b936b878ab660f20ceef8afc9e3a898c5a Author: Austin Seipp Date: Mon Sep 1 15:14:07 2014 -0500 Set llc and opt commands on all platforms Summary: LLVM llc and opt commands should be set on all platforms, including Windows. If they're not, GHC tries to execute an unnamed executable, resulting in error messages such as: Error (figuring out LLVM version): : runInteractiveProcess: invalid argument (Invalid argument) : Warning: Couldn't figure out LLVM version! Make sure you have installed LLVM This regression was introduced in e6bfc596. Test Plan: Build GHC and test if --info shows sensible values of "LLVM llc command" and "LLVM opt command" Reviewers: austin, #ghc Reviewed By: austin, #ghc Subscribers: austin Projects: #ghc Differential Revision: https://phabricator.haskell.org/D190 GHC Trac Issues: #7143 >--------------------------------------------------------------- 918719b936b878ab660f20ceef8afc9e3a898c5a aclocal.m4 | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/aclocal.m4 b/aclocal.m4 index bdc6c5d..09300f1 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -473,18 +473,18 @@ AC_DEFUN([FP_SETTINGS], SettingsWindresCommand="/bin/false" SettingsLibtoolCommand="libtool" SettingsTouchCommand='touch' - if test -z "$LlcCmd" - then - SettingsLlcCommand="llc" - else - SettingsLlcCommand="$LlcCmd" - fi - if test -z "$OptCmd" - then - SettingsOptCommand="opt" - else - SettingsOptCommand="$OptCmd" - fi + fi + if test -z "$LlcCmd" + then + SettingsLlcCommand="llc" + else + SettingsLlcCommand="$LlcCmd" + fi + if test -z "$OptCmd" + then + SettingsOptCommand="opt" + else + SettingsOptCommand="$OptCmd" fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" From git at git.haskell.org Mon Sep 1 20:15:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Sep 2014 20:15:18 +0000 (UTC) Subject: [commit: ghc] master: Fix a couple test failures encountered when building on Windows (9711f78) Message-ID: <20140901201518.7053A24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9711f78f790d10d914e08851544c6fc96f9a030a/ghc >--------------------------------------------------------------- commit 9711f78f790d10d914e08851544c6fc96f9a030a Author: Austin Seipp Date: Mon Sep 1 15:14:18 2014 -0500 Fix a couple test failures encountered when building on Windows Summary: * Adjusts performance tests * Change ghcpkg05.stderr-mingw32 to match ghcpkg05.stderr Test Plan: Ran 'sh validate' and observed fewer test failures afterwards Reviewers: austin Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D191 >--------------------------------------------------------------- 9711f78f790d10d914e08851544c6fc96f9a030a testsuite/driver/runtests.py | 5 ++++- testsuite/tests/cabal/ghcpkg05.stderr-mingw32 | 2 +- testsuite/tests/callarity/perf/all.T | 3 ++- testsuite/tests/perf/compiler/all.T | 3 ++- testsuite/tests/perf/haddock/all.T | 9 +++++---- testsuite/tests/perf/should_run/all.T | 19 +++++++++++++------ 6 files changed, 27 insertions(+), 14 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9711f78f790d10d914e08851544c6fc96f9a030a From git at git.haskell.org Mon Sep 1 21:12:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Sep 2014 21:12:40 +0000 (UTC) Subject: [commit: ghc] master: systools: fix gcc version detecton on non-english locale (4d4d077) Message-ID: <20140901211241.8C6D424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4d4d07704ee78221607a18b8118294b0aea1bac4/ghc >--------------------------------------------------------------- commit 4d4d07704ee78221607a18b8118294b0aea1bac4 Author: Sergei Trofimovich Date: Tue Sep 2 00:06:56 2014 +0300 systools: fix gcc version detecton on non-english locale Summary: ghc runs 'gcc -v' to check if we run under vanilla gcc or disaguised clang by checking for string "gcc version " But this check does not always work as gcc has that string localized via gettext mechanism: (some gcc's locale strings) be.po-msgstr "?????? gcc %s\n" da.po-msgstr "GCC version %s\n" de.po-msgstr "gcc-Version %s %s\n" el.po-msgstr "?????? gcc %s\n" ... To ping gcc to English locale we now override environment variable with 'LANGUAGE=en' value. Fixes Issue #8825 Signed-off-by: Sergei Trofimovich Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D185 GHC Trac Issues: #8825 >--------------------------------------------------------------- 4d4d07704ee78221607a18b8118294b0aea1bac4 compiler/main/SysTools.lhs | 56 ++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 52 insertions(+), 4 deletions(-) diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 72fa19b..67926f5 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -492,6 +492,51 @@ readCreateProcess proc = do return (ex, output) +readProcessEnvWithExitCode + :: String -- ^ program path + -> [String] -- ^ program args + -> [(String, String)] -- ^ environment to override + -> IO (ExitCode, String, String) -- ^ (exit_code, stdout, stderr) +readProcessEnvWithExitCode prog args env_update = do + current_env <- getEnvironment + let new_env = env_update ++ [ (k, v) + | let overriden_keys = map fst env_update + , (k, v) <- current_env + , k `notElem` overriden_keys + ] + p = proc prog args + + (_stdin, Just stdoh, Just stdeh, pid) <- + createProcess p{ std_out = CreatePipe + , std_err = CreatePipe + , env = Just new_env + } + + outMVar <- newEmptyMVar + errMVar <- newEmptyMVar + + _ <- forkIO $ do + stdo <- hGetContents stdoh + _ <- evaluate (length stdo) + putMVar outMVar stdo + + _ <- forkIO $ do + stde <- hGetContents stdeh + _ <- evaluate (length stde) + putMVar errMVar stde + + out <- takeMVar outMVar + hClose stdoh + err <- takeMVar errMVar + hClose stdeh + + ex <- waitForProcess pid + + return (ex, out, err) + +-- Don't let gcc localize version info string, #8825 +en_locale_env :: [(String, String)] +en_locale_env = [("LANGUAGE", "en")] -- If the -B option is set, add to PATH. This works around -- a bug in gcc on Windows Vista where it can't find its auxiliary @@ -746,8 +791,9 @@ getLinkerInfo' dflags = do _ -> do -- In practice, we use the compiler as the linker here. Pass -- -Wl,--version to get linker version info. - (exitc, stdo, stde) <- readProcessWithExitCode pgm - ["-Wl,--version"] "" + (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm + ["-Wl,--version"] + en_locale_env -- Split the output by lines to make certain kinds -- of processing easier. In particular, 'clang' and 'gcc' -- have slightly different outputs for '-Wl,--version', but @@ -802,7 +848,8 @@ getCompilerInfo' dflags = do -- Process the executable call info <- catchIO (do - (exitc, stdo, stde) <- readProcessWithExitCode pgm ["-v"] "" + (exitc, stdo, stde) <- + readProcessEnvWithExitCode pgm ["-v"] en_locale_env -- Split the output by lines to make certain kinds -- of processing easier. parseCompilerInfo (lines stdo) (lines stde) exitc @@ -952,7 +999,8 @@ readElfSection _dflags section exe = do prog = "readelf" args = [Option "-p", Option section, FileOption "" exe] -- - r <- readProcessWithExitCode prog (filter notNull (map showOpt args)) "" + r <- readProcessEnvWithExitCode prog (filter notNull (map showOpt args)) + en_locale_env case r of (ExitSuccess, out, _err) -> return (doFilter (lines out)) _ -> return Nothing From git at git.haskell.org Mon Sep 1 22:27:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Sep 2014 22:27:38 +0000 (UTC) Subject: [commit: ghc] master: Revert "Fix a couple test failures encountered when building on Windows" (31f43e8) Message-ID: <20140901222738.B73AD24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/31f43e806beeac434b1330ba5a04746ae79275fc/ghc >--------------------------------------------------------------- commit 31f43e806beeac434b1330ba5a04746ae79275fc Author: Austin Seipp Date: Mon Sep 1 17:26:47 2014 -0500 Revert "Fix a couple test failures encountered when building on Windows" This reverts commit 9711f78f790d10d914e08851544c6fc96f9a030a, as it's causing build phailures in phabricator. >--------------------------------------------------------------- 31f43e806beeac434b1330ba5a04746ae79275fc testsuite/driver/runtests.py | 5 +---- testsuite/tests/cabal/ghcpkg05.stderr-mingw32 | 2 +- testsuite/tests/callarity/perf/all.T | 3 +-- testsuite/tests/perf/compiler/all.T | 3 +-- testsuite/tests/perf/haddock/all.T | 3 +-- testsuite/tests/perf/should_run/all.T | 19 ++++++------------- 6 files changed, 11 insertions(+), 24 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 52b5471..103c7ac 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -143,11 +143,8 @@ if windows: # msys gives "MINGW32" # msys2 gives "MINGW_NT-6.2" config.msys = True -# msys2 gives 'MSYS_NT-6.3' unless you set MSYSTEM, which is also needed elsewhere - elif v.startswith("MSYS"): - raise Exception("Remember to set your MSYSTEM environment variable to MINGW32 or MINGW64") else: - raise Exception("Can't detect Windows terminal type: " + v) + raise Exception("Can't detect Windows terminal type") # Try to use UTF8 if windows: diff --git a/testsuite/tests/cabal/ghcpkg05.stderr-mingw32 b/testsuite/tests/cabal/ghcpkg05.stderr-mingw32 index 55a82814..ac51816 100644 --- a/testsuite/tests/cabal/ghcpkg05.stderr-mingw32 +++ b/testsuite/tests/cabal/ghcpkg05.stderr-mingw32 @@ -15,4 +15,4 @@ The following packages are broken, either because they have a problem listed above, or because they depend on a broken package. testpkg-2.0 testpkg-3.0 -ghc-pkg.exe: unregistering would break the following packages: testpkg-3.0 (use --force to override) +ghc-pkg.exe: unregistering testpkg-2.0 would break the following packages: testpkg-3.0 (use --force to override) diff --git a/testsuite/tests/callarity/perf/all.T b/testsuite/tests/callarity/perf/all.T index 40b9f01..1c79694 100644 --- a/testsuite/tests/callarity/perf/all.T +++ b/testsuite/tests/callarity/perf/all.T @@ -1,10 +1,9 @@ test('T3924', [stats_num_field('bytes allocated', - [ (wordsize(64), 47080, 5), + [ (wordsize(64), 50760, 5), # previously, without call-arity: 22326544 # 2014-01-18: 51480 (amd64/Linux) # 2014-07-17: 50760 (amd64/Linux) (Roundabout adjustment) - # 2014-09-01: 47080 (amd64/Windows) (wordsize(32), 44988, 5) ]), # 2014-04-04: 44988 (Windows, 64-bit machine) only_ways(['normal']) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index cf6ad8c..f53787a 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -449,9 +449,8 @@ test('T9020', [(wordsize(32), 343005716, 10), # Original: 381360728 # 2014-07-31: 343005716 (Windows) (general round of updates) - (wordsize(64), 627647808, 10)]) + (wordsize(64), 728263536, 10)]) # prev: 795469104 # 2014-07-17: 728263536 (general round of updates) - # 2014-09-01: 627647808 (SPJ compiler improvements) ], compile,['']) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 94aef3a..ce11f60 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -34,7 +34,7 @@ test('haddock.base', # 2014-01-22: 62189068 (x86/Linux) # 2014-06-29: 58243640 (x86/Linux) ,stats_num_field('bytes allocated', - [(wordsize(64), 7499083776, 5) + [(wordsize(64), 7946284944, 5) # 2012-08-14: 5920822352 (amd64/Linux) # 2012-09-20: 5829972376 (amd64/Linux) # 2012-10-08: 5902601224 (amd64/Linux) @@ -47,7 +47,6 @@ test('haddock.base', # 2014-06-12: 7498123680 (x86_64/Linux) # 2014-08-05: 7992757384 (x86_64/Linux - bugfix for #314, Haddock now parses more URLs) # 2014-08-08: 7946284944 (x86_64/Linux - Haddock updates to attoparsec-0.12.1.0) - # 2014-09-01: 7499083776 (x86_64/Windows) ,(platform('i386-unknown-mingw32'), 3548581572, 5) # 2013-02-10: 3358693084 (x86/Windows) # 2013-11-13: 3097751052 (x86/Windows, 64bit machine) diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 457b2ef..1bf0143 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -16,11 +16,10 @@ test('T3586', test('T4830', [stats_num_field('bytes allocated', - [(wordsize(64), 94496, 1), + [(wordsize(64), 98248, 1), # 127000 (amd64/Linux) # 2013-02-07: 99264 (amd64/Linux) # 2014-01-13: 98248 (amd64/Linux) due to #8647 - # 2014-09-01: 94496 (amd64/Windows) (wordsize(32), 70646, 3)]), # 2013-02-10: 69744 (x86/Windows) # 2013-02-10: 71548 (x86/OSX) @@ -40,11 +39,10 @@ test('lazy-bs-alloc', [stats_num_field('peak_megabytes_allocated', (2, 1)), # expected value: 2 (amd64/Linux) stats_num_field('bytes allocated', - [(wordsize(64), 438320, 1), + [(wordsize(64), 425400, 1), # 489776 (amd64/Linux) # 2013-02-07: 429744 (amd64/Linux) # 2013-12-12: 425400 (amd64/Linux) - # 2014-09-01: 438320 (amd64/Windows) (wordsize(32), 411500, 2)]), # 2013-02-10: 421296 (x86/Windows) # 2013-02-10: 414180 (x86/OSX) @@ -60,10 +58,9 @@ test('lazy-bs-alloc', test('T876', [stats_num_field('bytes allocated', - [(wordsize(64), 72168 , 5), + [(wordsize(64), 63216 , 5), # 2013-02-14: 1263712 (x86_64/Linux) # 2014-02-10: 63216 (x86_64/Linux), call arity analysis - # 2014-09-01: 72168 (x86_64/Windows) (wordsize(32), 53024, 5) ]), # some date: 663712 (Windows, 64-bit machine) # 2014-04-04: 56820 (Windows, 64-bit machine) @@ -95,11 +92,9 @@ test('T3738', stats_num_field('bytes allocated', [(wordsize(32), 45648, 5), # expected value: 50520 (x86/Linux) - (wordsize(64), 46840, 5)]), - # 2014-09-01: 46840 (amd64/Windows) + (wordsize(64), 49400, 5)]), # prev: 49400 (amd64/Linux) # 2014-07-17: 50520 (amd64/Linux) general round of updates - only_ways(['normal']) ], compile_and_run, @@ -161,10 +156,9 @@ test('T5205', [stats_num_field('bytes allocated', [(wordsize(32), 47088, 5), # expected value: 47088 (x86/Darwin) - (wordsize(64), 48920, 5)]), + (wordsize(64), 52600, 5)]), # expected value: 51320 (amd64/Linux) # 2014-07-17: 52600 (amd64/Linux) general round of updates - # 2014-09-01: 48920 (amd64/Windows) only_ways(['normal', 'optasm']) ], compile_and_run, @@ -275,10 +269,9 @@ test('T7507', omit_ways(['ghci']), compile_and_run, ['-O']) test('T7436', [stats_num_field('max_bytes_used', - [(wordsize(64), 58520, 1), + [(wordsize(64), 60360, 1), # 127000 (amd64/Linux) # 2013-02-07: 60360 (amd64/Linux) - # 2014-09-01: 58520 (amd64/Windows) (wordsize(32), 58434, 1)]), # 2013-02-10: 58032 (x86/Windows) # 2013-02-10: 58836 (x86/OSX) From git at git.haskell.org Tue Sep 2 09:43:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Sep 2014 09:43:51 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9535' created Message-ID: <20140902094353.AB42E24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T9535 Referencing: 89b314216281eff885cf6e7f93022a933ee82c63 From git at git.haskell.org Tue Sep 2 09:43:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Sep 2014 09:43:54 +0000 (UTC) Subject: [commit: ghc] wip/T9535: Remove max_bytes_used test from haddock test cases (89b3142) Message-ID: <20140902094354.82E8724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9535 Link : http://ghc.haskell.org/trac/ghc/changeset/89b314216281eff885cf6e7f93022a933ee82c63/ghc >--------------------------------------------------------------- commit 89b314216281eff885cf6e7f93022a933ee82c63 Author: Joachim Breitner Date: Tue Sep 2 10:48:27 2014 +0200 Remove max_bytes_used test from haddock test cases Summary: as these are not very reliable, and the advice to make them reliable is hard to apply to them. (This is just my practicing phab...) Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: carter, ezyang, simonmar Differential Revision: https://phabricator.haskell.org/D188 GHC Trac Issues: #9535 >--------------------------------------------------------------- 89b314216281eff885cf6e7f93022a933ee82c63 testsuite/tests/perf/haddock/all.T | 113 ++----------------------------------- 1 file changed, 4 insertions(+), 109 deletions(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 80a55d1..823bcea 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -1,38 +1,9 @@ +# We do not add peak_megabytes_allocated and max_bytes_used to these tests, as +# they are somewhat unreliable, and it is harder to re-run these numbers to +# detect outliers, as described in Note [residency] + test('haddock.base', [unless(in_tree_compiler(), skip) - ,stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 323, 10) - # 2012-08-14: 240 (amd64/Linux) - # 2012-09-18: 237 (amd64/Linux) - # 2012-11-12: 249 (amd64/Linux) - # 2013-01-29: 274 (amd64/Linux) - # 2013-10-18: 323 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 163, 10) - # 2013-02-10: 133 (x86/Windows) - # 2013-11-13: 163 (x86/Windows, 64bit machine) - ,(wordsize(32), 156, 1)]) - # 2012-08-14: 144 (x86/OSX) - # 2012-10-30: 113 (x86/Windows) - # 2013-02-10: 139 (x86/OSX) - # 2014-01-22: 168 (x86/Linux - new haddock) - # 2014-06-29: 156 (x86/Linux) - ,stats_num_field('max_bytes_used', - [(wordsize(64), 112286208, 10) - # 2012-08-14: 87374568 (amd64/Linux) - # 2012-08-21: 86428216 (amd64/Linux) - # 2012-09-20: 84794136 (amd64/Linux) - # 2012-11-12: 87265136 (amd64/Linux) - # 2013-01-29: 96022312 (amd64/Linux) - # 2013-10-18: 115113864 (amd64/Linux) - # 2014-07-31: 127954488 (amd64/Linux), correlates with 1ae5fa45 - # 2014-08-29: 112286208 (amd64/Linux), w/w for INLINABLE things - ,(platform('i386-unknown-mingw32'), 58557136, 10) - # 2013-02-10: 47988488 (x86/Windows) - # 2013-11-13: 58557136 (x86/Windows, 64bit machine) - ,(wordsize(32), 58243640, 1)]) - # 2013-02-10: 52237984 (x86/OSX) - # 2014-01-22: 62189068 (x86/Linux) - # 2014-06-29: 58243640 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 7946284944, 5) # 2012-08-14: 5920822352 (amd64/Linux) @@ -65,44 +36,6 @@ test('haddock.base', test('haddock.Cabal', [unless(in_tree_compiler(), skip) - ,stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 309, 10) - # 2012-08-14: 202 (amd64/Linux) - # 2012-08-29: 211 (amd64/Linux, new codegen) - # 2012-09-20: 227 (amd64/Linux) - # 2012-10-08: 217 (amd64/Linux) - # 2013-06-07: 246 (amd64/Linux) (reason unknown) - # 2013-11-21: 269 - # 2013-11-22: 278 (amd64/Linux) (TH refactoring; weird) - # 2014-07-14: 309 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 144, 10) - # 2012-10-30: 83 (x86/Windows) - # 2013-02-10: 116 (x86/Windows) - # 2013-11-13: 129 (x86/Windows, 64bit machine) - # 2014-01-28: 136 - # 2014-04-04: 144 - ,(wordsize(32), 147, 1)]) - # 2012-08-14: 116 (x86/OSX) - # 2013-02-10: 89 (x86/Windows) - # 2014-01-22: 139 (x86/Linux - new haddock, but out of date before) - # 2014-06-29: 147 (x86/Linux) - ,stats_num_field('max_bytes_used', - [(wordsize(64), 113232208, 15) - # 2012-08-14: 74119424 (amd64/Linux) - # 2012-08-29: 77992512 (amd64/Linux, new codegen) - # 2012-10-02: 91341568 (amd64/Linux) - # 2012-10-08: 80590280 (amd64/Linux) - # 2013-03-13: 95356616 (amd64/Linux) Cabal updated - # 2014-07-14: 113232208 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 63493200, 15) - # 2012-10-30: 44224896 (x86/Windows) - # 2013-11-13: 49391436 (x86/Windows, 64bit machine) - # 2014-04-04: 63493200 (x86/Windows, 64bit machine) - ,(wordsize(32), 66411508, 1)]) - # 2012-08-14: 47461532 (x86/OSX) - # 2013-02-10: 46563344 (x86/OSX) - # 2014-01-22: 52718512 (x86/Linux) - # 2014-06-29: 66411508 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 4267311856, 5) # 2012-08-14: 3255435248 (amd64/Linux) @@ -137,44 +70,6 @@ test('haddock.Cabal', test('haddock.compiler', [unless(in_tree_compiler(), skip) - ,stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 1551, 10) - # 2012-08-14: 1203 (amd64/Linux) - # 2012-08-21: 1199 (amd64/Linux) - # 2012-09-20: 1228 (amd64/Linux) - # 2012-10-08: 1240 (amd64/Linux) - # 2013-08-26: 1250 (amd64/Linux) Cabal updated - # 2013-10-18: 1408 (amd64/Linux) - # 2013-12-12: 1551 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 735, 10) - # 2012-10-30: 606 (x86/Windows) - # 2013-02-10: 653 (x86/Windows) - # 2013-11-13: 735 (x86/Windows, 64bit machine) - ,(wordsize(32), 771, 1)]) - # 2012-08-14: 631 (x86/OSX) - # 2013-02-10: 663 (x86/OSX) - # 2014-01-22: 727 (x86/Linux - new haddock, but out of date before) - # 2014-06-29: 771 (x86/Linux) - ,stats_num_field('max_bytes_used', - [(wordsize(64), 541926264, 10) - # 2012-08-14: 428775544 (amd64/Linux) - # 2012-09-20: 437618008 (amd64/Linux) - # 2012-10-08: 442768280 (amd64/Linux) - # 2012-11-12: 420105120 (amd64/Linux) - # 2013-06-08: 477593712 (amd64/Linux) (reason unknown) - # 2013-11-21: 502920176 (amd64/Linux) - # 2013-11-22: 541926264 (amd64/Linux) (TH refactoring; weird) - ,(platform('i386-unknown-mingw32'), 278706344, 10) - # 2012-10-30: 220847924 (x86/Windows) - # 2013-02-10: 238529512 (x86/Windows) - # 2013-11-13: 269147084 (x86/Windows, 64bit machine) - # 2014-01-28: 283814088 (x86/Windows) - # 2014-04-04: 278706344 (x86/Windows) - ,(wordsize(32), 284082916, 1)]) - # 2012-08-14: 231064920 (x86/OSX) - # 2013-02-10: 241785276 (x86/Windows) - # 2014-01-22: 278124612 (x86/Linux - new haddock) - # 2014-06-29: 284082916 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 29809571376, 10) # 2012-08-14: 26070600504 (amd64/Linux) From git at git.haskell.org Tue Sep 2 09:49:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Sep 2014 09:49:31 +0000 (UTC) Subject: [commit: ghc] wip/T9535: Automatic merge by 'arc land' (ce6ec3b) Message-ID: <20140902094931.F070924121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9535 Link : http://ghc.haskell.org/trac/ghc/changeset/ce6ec3bb20a0e4ff68970089681f1eb393e68760/ghc >--------------------------------------------------------------- commit ce6ec3bb20a0e4ff68970089681f1eb393e68760 Merge: 89b3142 31f43e8 Author: Joachim Breitner Date: Tue Sep 2 11:49:24 2014 +0200 Automatic merge by 'arc land' Conflicts: testsuite/tests/perf/haddock/all.T >--------------------------------------------------------------- ce6ec3bb20a0e4ff68970089681f1eb393e68760 aclocal.m4 | 24 +- compiler/main/SysTools.lhs | 56 +++- compiler/parser/Lexer.x | 115 +++++--- compiler/utils/StringBuffer.lhs | 45 +++- includes/Stg.h | 18 -- rts/ThreadPaused.c | 21 +- sync-all | 296 +++++++++++---------- testsuite/.gitignore | 2 + testsuite/tests/parser/unicode/T6016.hs | 34 +++ testsuite/tests/parser/unicode/all.T | 1 + testsuite/tests/perf/haddock/all.T | 2 +- .../tests/simplCore/should_compile/T6056.stderr | 4 +- utils/genprimopcode/Main.hs | 10 +- 13 files changed, 386 insertions(+), 242 deletions(-) From git at git.haskell.org Tue Sep 2 09:49:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Sep 2014 09:49:33 +0000 (UTC) Subject: [commit: ghc] wip/T9535's head updated: Automatic merge by 'arc land' (ce6ec3b) Message-ID: <20140902094934.0FFB124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T9535' now includes: 01a27c9 testsuite: update T6056 rule firing order e81e028 includes/Stg.h: remove unused 'wcStore' inline 9e93940 StringBuffer should not contain initial byte-order mark (BOM) 0f31c2e Cleanup and better documentation of sync-all script 64c9898 Make Lexer.x more like the 2010 report 3be704a genprimopcode: GHC.Prim is Unsafe (#9449) 2f343b0 Refactor stack squeezing logic 918719b Set llc and opt commands on all platforms 9711f78 Fix a couple test failures encountered when building on Windows 4d4d077 systools: fix gcc version detecton on non-english locale 31f43e8 Revert "Fix a couple test failures encountered when building on Windows" ce6ec3b Automatic merge by 'arc land' From git at git.haskell.org Tue Sep 2 09:49:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Sep 2014 09:49:54 +0000 (UTC) Subject: [commit: ghc] master: Remove max_bytes_used test from haddock test cases (8c427eb) Message-ID: <20140902094954.2E2CB24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8c427ebe9c34b9bcecd41fb0584d24989c00ffe6/ghc >--------------------------------------------------------------- commit 8c427ebe9c34b9bcecd41fb0584d24989c00ffe6 Author: Joachim Breitner Date: Tue Sep 2 11:49:49 2014 +0200 Remove max_bytes_used test from haddock test cases Summary: as these are not very reliable, and the advice to make them reliable is hard to apply to them. (This is just my practicing phab...) Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: carter, ezyang, simonmar Differential Revision: https://phabricator.haskell.org/D188 GHC Trac Issues: #9535 >--------------------------------------------------------------- 8c427ebe9c34b9bcecd41fb0584d24989c00ffe6 testsuite/tests/perf/haddock/all.T | 113 ++----------------------------------- 1 file changed, 4 insertions(+), 109 deletions(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index ce11f60..ce7a37c 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -1,38 +1,9 @@ +# We do not add peak_megabytes_allocated and max_bytes_used to these tests, as +# they are somewhat unreliable, and it is harder to re-run these numbers to +# detect outliers, as described in Note [residency] + test('haddock.base', [unless(in_tree_compiler(), skip) - ,stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 323, 10) - # 2012-08-14: 240 (amd64/Linux) - # 2012-09-18: 237 (amd64/Linux) - # 2012-11-12: 249 (amd64/Linux) - # 2013-01-29: 274 (amd64/Linux) - # 2013-10-18: 323 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 163, 10) - # 2013-02-10: 133 (x86/Windows) - # 2013-11-13: 163 (x86/Windows, 64bit machine) - ,(wordsize(32), 156, 1)]) - # 2012-08-14: 144 (x86/OSX) - # 2012-10-30: 113 (x86/Windows) - # 2013-02-10: 139 (x86/OSX) - # 2014-01-22: 168 (x86/Linux - new haddock) - # 2014-06-29: 156 (x86/Linux) - ,stats_num_field('max_bytes_used', - [(wordsize(64), 112286208, 10) - # 2012-08-14: 87374568 (amd64/Linux) - # 2012-08-21: 86428216 (amd64/Linux) - # 2012-09-20: 84794136 (amd64/Linux) - # 2012-11-12: 87265136 (amd64/Linux) - # 2013-01-29: 96022312 (amd64/Linux) - # 2013-10-18: 115113864 (amd64/Linux) - # 2014-07-31: 127954488 (amd64/Linux), correlates with 1ae5fa45 - # 2014-08-29: 112286208 (amd64/Linux), w/w for INLINABLE things - ,(platform('i386-unknown-mingw32'), 58557136, 10) - # 2013-02-10: 47988488 (x86/Windows) - # 2013-11-13: 58557136 (x86/Windows, 64bit machine) - ,(wordsize(32), 58243640, 1)]) - # 2013-02-10: 52237984 (x86/OSX) - # 2014-01-22: 62189068 (x86/Linux) - # 2014-06-29: 58243640 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 7946284944, 5) # 2012-08-14: 5920822352 (amd64/Linux) @@ -65,44 +36,6 @@ test('haddock.base', test('haddock.Cabal', [unless(in_tree_compiler(), skip) - ,stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 309, 10) - # 2012-08-14: 202 (amd64/Linux) - # 2012-08-29: 211 (amd64/Linux, new codegen) - # 2012-09-20: 227 (amd64/Linux) - # 2012-10-08: 217 (amd64/Linux) - # 2013-06-07: 246 (amd64/Linux) (reason unknown) - # 2013-11-21: 269 - # 2013-11-22: 278 (amd64/Linux) (TH refactoring; weird) - # 2014-07-14: 309 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 144, 10) - # 2012-10-30: 83 (x86/Windows) - # 2013-02-10: 116 (x86/Windows) - # 2013-11-13: 129 (x86/Windows, 64bit machine) - # 2014-01-28: 136 - # 2014-04-04: 144 - ,(wordsize(32), 147, 1)]) - # 2012-08-14: 116 (x86/OSX) - # 2013-02-10: 89 (x86/Windows) - # 2014-01-22: 139 (x86/Linux - new haddock, but out of date before) - # 2014-06-29: 147 (x86/Linux) - ,stats_num_field('max_bytes_used', - [(wordsize(64), 113232208, 15) - # 2012-08-14: 74119424 (amd64/Linux) - # 2012-08-29: 77992512 (amd64/Linux, new codegen) - # 2012-10-02: 91341568 (amd64/Linux) - # 2012-10-08: 80590280 (amd64/Linux) - # 2013-03-13: 95356616 (amd64/Linux) Cabal updated - # 2014-07-14: 113232208 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 63493200, 15) - # 2012-10-30: 44224896 (x86/Windows) - # 2013-11-13: 49391436 (x86/Windows, 64bit machine) - # 2014-04-04: 63493200 (x86/Windows, 64bit machine) - ,(wordsize(32), 66411508, 1)]) - # 2012-08-14: 47461532 (x86/OSX) - # 2013-02-10: 46563344 (x86/OSX) - # 2014-01-22: 52718512 (x86/Linux) - # 2014-06-29: 66411508 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 4267311856, 5) # 2012-08-14: 3255435248 (amd64/Linux) @@ -137,44 +70,6 @@ test('haddock.Cabal', test('haddock.compiler', [unless(in_tree_compiler(), skip) - ,stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 1551, 10) - # 2012-08-14: 1203 (amd64/Linux) - # 2012-08-21: 1199 (amd64/Linux) - # 2012-09-20: 1228 (amd64/Linux) - # 2012-10-08: 1240 (amd64/Linux) - # 2013-08-26: 1250 (amd64/Linux) Cabal updated - # 2013-10-18: 1408 (amd64/Linux) - # 2013-12-12: 1551 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 735, 10) - # 2012-10-30: 606 (x86/Windows) - # 2013-02-10: 653 (x86/Windows) - # 2013-11-13: 735 (x86/Windows, 64bit machine) - ,(wordsize(32), 771, 1)]) - # 2012-08-14: 631 (x86/OSX) - # 2013-02-10: 663 (x86/OSX) - # 2014-01-22: 727 (x86/Linux - new haddock, but out of date before) - # 2014-06-29: 771 (x86/Linux) - ,stats_num_field('max_bytes_used', - [(wordsize(64), 541926264, 10) - # 2012-08-14: 428775544 (amd64/Linux) - # 2012-09-20: 437618008 (amd64/Linux) - # 2012-10-08: 442768280 (amd64/Linux) - # 2012-11-12: 420105120 (amd64/Linux) - # 2013-06-08: 477593712 (amd64/Linux) (reason unknown) - # 2013-11-21: 502920176 (amd64/Linux) - # 2013-11-22: 541926264 (amd64/Linux) (TH refactoring; weird) - ,(platform('i386-unknown-mingw32'), 278706344, 10) - # 2012-10-30: 220847924 (x86/Windows) - # 2013-02-10: 238529512 (x86/Windows) - # 2013-11-13: 269147084 (x86/Windows, 64bit machine) - # 2014-01-28: 283814088 (x86/Windows) - # 2014-04-04: 278706344 (x86/Windows) - ,(wordsize(32), 284082916, 1)]) - # 2012-08-14: 231064920 (x86/OSX) - # 2013-02-10: 241785276 (x86/Windows) - # 2014-01-22: 278124612 (x86/Linux - new haddock) - # 2014-06-29: 284082916 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 29809571376, 10) # 2012-08-14: 26070600504 (amd64/Linux) From git at git.haskell.org Tue Sep 2 09:50:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Sep 2014 09:50:22 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9535' deleted Message-ID: <20140902095024.033C524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T9535 From git at git.haskell.org Tue Sep 2 10:03:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Sep 2014 10:03:47 +0000 (UTC) Subject: [commit: ghc] master: rts/Printer.c: update comments about using USING_LIBBFD (8b107b5) Message-ID: <20140902100347.491D524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8b107b514b8f1bad7cbe39f267aadf31db9f7f5e/ghc >--------------------------------------------------------------- commit 8b107b514b8f1bad7cbe39f267aadf31db9f7f5e Author: Sergei Trofimovich Date: Mon Sep 1 18:09:56 2014 +0300 rts/Printer.c: update comments about using USING_LIBBFD Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 8b107b514b8f1bad7cbe39f267aadf31db9f7f5e rts/Printer.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/Printer.c b/rts/Printer.c index cd4b9a1..49e0c05 100644 --- a/rts/Printer.c +++ b/rts/Printer.c @@ -759,14 +759,14 @@ extern void DEBUG_LoadSymbols( char *name ) prepare_table(); } -#else /* HAVE_BFD_H */ +#else /* USING_LIBBFD */ extern void DEBUG_LoadSymbols( char *name STG_UNUSED ) { /* nothing, yet */ } -#endif /* HAVE_BFD_H */ +#endif /* USING_LIBBFD */ void findPtr(P_ p, int); /* keep gcc -Wall happy */ From git at git.haskell.org Tue Sep 2 10:03:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Sep 2014 10:03:49 +0000 (UTC) Subject: [commit: ghc] master: configure.ac: cleanup: remove unused 'HaveLibDL' subst (9692393) Message-ID: <20140902100349.CCCEC24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9692393d7ba91a091c1e61b6754d79ad17c5f193/ghc >--------------------------------------------------------------- commit 9692393d7ba91a091c1e61b6754d79ad17c5f193 Author: Sergei Trofimovich Date: Mon Sep 1 18:52:17 2014 +0300 configure.ac: cleanup: remove unused 'HaveLibDL' subst Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 9692393d7ba91a091c1e61b6754d79ad17c5f193 configure.ac | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/configure.ac b/configure.ac index 9e31c52..e7a0774 100644 --- a/configure.ac +++ b/configure.ac @@ -856,13 +856,7 @@ dnl Check for libraries dnl ################################################################ dnl ** check whether we need -ldl to get dlopen() - -AC_CHECK_LIB(dl, dlopen, - [HaveLibDL=YES - AC_DEFINE([HAVE_LIBDL], [1], [Define to 1 if you need -ldl to get dlopen().]) - LIBS="$LIBS -ldl"], - [HaveLibDL=NO]) -AC_SUBST(HaveLibDL) +AC_CHECK_LIB(dl, dlopen) dnl -------------------------------------------------- dnl * Miscellaneous feature tests From git at git.haskell.org Tue Sep 2 15:54:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Sep 2014 15:54:51 +0000 (UTC) Subject: [commit: nofib] master: Hide Word from Prelude (c9c20d4) Message-ID: <20140902155451.F058824121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c9c20d477088a8a7d5747f16afdf0652fba6dadf/nofib >--------------------------------------------------------------- commit c9c20d477088a8a7d5747f16afdf0652fba6dadf Author: Joachim Breitner Date: Tue Sep 2 17:53:52 2014 +0200 Hide Word from Prelude in benchmarks where Word is used. This fixes fall-out from #9531. >--------------------------------------------------------------- c9c20d477088a8a7d5747f16afdf0652fba6dadf fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/LeftToRight.lhs | 1 + fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/LeftToRightD.lhs | 1 + fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/Posix.lhs | 1 + fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/RightToLeft.lhs | 1 + fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/TwoPasses.lhs | 1 + real/HMMS/Pronunciations.lhs | 1 + spectral/eliza/Main.hs | 1 + spectral/para/Main.lhs | 1 + 8 files changed, 8 insertions(+) diff --git a/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/LeftToRight.lhs b/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/LeftToRight.lhs index 2b1c4be..56977a2 100644 --- a/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/LeftToRight.lhs +++ b/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/LeftToRight.lhs @@ -26,6 +26,7 @@ an emptiable pattern and the input word is fully consumed. > import qualified Data.IntMap as IM > import qualified Data.ByteString.Char8 as S > import Control.DeepSeq +> import Prelude hiding (Word) > import System.IO.Unsafe (unsafePerformIO) diff --git a/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/LeftToRightD.lhs b/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/LeftToRightD.lhs index 64a2e30..ba8e220 100644 --- a/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/LeftToRightD.lhs +++ b/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/LeftToRightD.lhs @@ -26,6 +26,7 @@ an emptiable pattern and the input word is fully consumed. > import qualified Data.IntMap as IM > import qualified Data.ByteString.Char8 as S > import Control.DeepSeq +> import Prelude hiding (Word) > import System.IO.Unsafe (unsafePerformIO) diff --git a/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/Posix.lhs b/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/Posix.lhs index efde6bf..f46d237 100644 --- a/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/Posix.lhs +++ b/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/Posix.lhs @@ -29,6 +29,7 @@ This algorithm implements the POSIX matching policy proceeds by scanning the inp > import GHC.Arr > import qualified Data.IntMap as IM > import qualified Data.ByteString.Char8 as S +> import Prelude hiding (Word) > import Text.Regex.Base(RegexOptions(..),RegexLike(..),MatchArray) diff --git a/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/RightToLeft.lhs b/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/RightToLeft.lhs index f2d0921..fafa5f6 100644 --- a/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/RightToLeft.lhs +++ b/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/RightToLeft.lhs @@ -26,6 +26,7 @@ is reached (AKA init state of the NFA) and the input word is fully consumed. > import GHC.Int > import qualified Data.IntMap as IM > import qualified Data.ByteString.Char8 as S +> import Prelude hiding (Word) > import Text.Regex.Base(RegexOptions(..)) diff --git a/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/TwoPasses.lhs b/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/TwoPasses.lhs index 0f436d8..fd62f69 100644 --- a/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/TwoPasses.lhs +++ b/fibon/Hackage/Regex/Text/Regex/PDeriv/ByteString/TwoPasses.lhs @@ -28,6 +28,7 @@ failures states as long as we cannot find them in the sets. > import GHC.Int > import qualified Data.IntMap as IM > import qualified Data.ByteString.Char8 as S +> import Prelude hiding (Word) > import Text.Regex.Base(RegexOptions(..)) diff --git a/real/HMMS/Pronunciations.lhs b/real/HMMS/Pronunciations.lhs index 1195462..4c0f55a 100644 --- a/real/HMMS/Pronunciations.lhs +++ b/real/HMMS/Pronunciations.lhs @@ -25,6 +25,7 @@ described in later chapters in Part~\ref{part:library}. > import MaybeStateT > import PlainTextIO > import StateT +> import Prelude hiding (Word) \end{verbatim} diff --git a/spectral/eliza/Main.hs b/spectral/eliza/Main.hs index 2158970..e8cbc22 100644 --- a/spectral/eliza/Main.hs +++ b/spectral/eliza/Main.hs @@ -8,6 +8,7 @@ ------------------------------------------------------------------------------- import Data.Char -- 1.3 +import Prelude hiding (Word) main = interact (("\n\ \Hi! I'm Eliza. I am your personal therapy computer.\n\ diff --git a/spectral/para/Main.lhs b/spectral/para/Main.lhs index 120b9b4..3ae76b0 100644 --- a/spectral/para/Main.lhs +++ b/spectral/para/Main.lhs @@ -176,6 +176,7 @@ style. >import Data.Char >import System.IO >import System.Environment +>import Prelude hiding (Word) \end{mcode} \fi From git at git.haskell.org Tue Sep 2 15:57:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Sep 2014 15:57:02 +0000 (UTC) Subject: [commit: ghc] master: Update nofib submodule: Hide Word from Prelude (1719c42) Message-ID: <20140902155702.CF8BD24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1719c4207386a42ba4af9914340a6fe60045efe5/ghc >--------------------------------------------------------------- commit 1719c4207386a42ba4af9914340a6fe60045efe5 Author: Joachim Breitner Date: Tue Sep 2 17:55:16 2014 +0200 Update nofib submodule: Hide Word from Prelude in benchmarks where Word is used. This fixes fall-out from #9531. >--------------------------------------------------------------- 1719c4207386a42ba4af9914340a6fe60045efe5 nofib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nofib b/nofib index 5bc1c75..c9c20d4 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit 5bc1c75db2c74413959772c85d43f8171fdd7b8c +Subproject commit c9c20d477088a8a7d5747f16afdf0652fba6dadf From git at git.haskell.org Thu Sep 4 08:35:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Sep 2014 08:35:35 +0000 (UTC) Subject: [commit: ghc] master: Add Data.List.uncons (e428b5b) Message-ID: <20140904083536.0F6F124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e428b5b8cc1448dcff7d7cdcbeb738eb0bea102f/ghc >--------------------------------------------------------------- commit e428b5b8cc1448dcff7d7cdcbeb738eb0bea102f Author: David Feuer Date: Thu Sep 4 08:04:12 2014 +0200 Add Data.List.uncons Summary: As discussed in http://www.haskell.org/pipermail/libraries/2014-July/023314.html and submitted at #9550. Test Plan: Submit to phab, see what happens. Reviewers: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D195 GHC Trac Issues: #9550 >--------------------------------------------------------------- e428b5b8cc1448dcff7d7cdcbeb738eb0bea102f libraries/base/Data/List.hs | 1 + libraries/base/GHC/List.lhs | 9 ++++++++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs index 2cd9a3b..f813741 100644 --- a/libraries/base/Data/List.hs +++ b/libraries/base/Data/List.hs @@ -24,6 +24,7 @@ module Data.List , last , tail , init + , uncons , null , length diff --git a/libraries/base/GHC/List.lhs b/libraries/base/GHC/List.lhs index bcc5fea..4fcb54a 100644 --- a/libraries/base/GHC/List.lhs +++ b/libraries/base/GHC/List.lhs @@ -21,7 +21,7 @@ module GHC.List ( -- [] (..), -- built-in syntax; can't be used in export list map, (++), filter, concat, - head, last, tail, init, null, length, (!!), + head, last, tail, init, uncons, null, length, (!!), foldl, scanl, scanl1, foldr, foldr1, scanr, scanr1, iterate, repeat, replicate, cycle, take, drop, splitAt, takeWhile, dropWhile, span, break, @@ -71,6 +71,13 @@ badHead = errorEmptyList "head" head (augment g xs) = g (\x _ -> x) (head xs) #-} +-- | Decompose a list into its head and tail. If the list is empty, +-- returns 'Nothing'. If the list is non-empty, returns @'Just' (x, xs)@, +-- where @x@ is the head of the list and @xs@ its tail. +uncons :: [a] -> Maybe (a, [a]) +uncons [] = Nothing +uncons (x:xs) = Just (x, xs) + -- | Extract the elements after the head of a list, which must be non-empty. tail :: [a] -> [a] tail (_:xs) = xs From git at git.haskell.org Thu Sep 4 08:35:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Sep 2014 08:35:38 +0000 (UTC) Subject: [commit: ghc] master: Revert "Remove max_bytes_used test from haddock test cases" (89baab4) Message-ID: <20140904083538.7D43424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/89baab47c0feeee074c8c46ce261a873346cf5c9/ghc >--------------------------------------------------------------- commit 89baab47c0feeee074c8c46ce261a873346cf5c9 Author: Joachim Breitner Date: Thu Sep 4 10:33:51 2014 +0200 Revert "Remove max_bytes_used test from haddock test cases" This reverts commit 8c427ebe9c34b9bcecd41fb0584d24989c00ffe6. Sorry for the noise, but I need to practice my HIW talk, which will involve some live development... >--------------------------------------------------------------- 89baab47c0feeee074c8c46ce261a873346cf5c9 testsuite/tests/perf/haddock/all.T | 113 +++++++++++++++++++++++++++++++++++-- 1 file changed, 109 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index ce7a37c..ce11f60 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -1,9 +1,38 @@ -# We do not add peak_megabytes_allocated and max_bytes_used to these tests, as -# they are somewhat unreliable, and it is harder to re-run these numbers to -# detect outliers, as described in Note [residency] - test('haddock.base', [unless(in_tree_compiler(), skip) + ,stats_num_field('peak_megabytes_allocated', + [(wordsize(64), 323, 10) + # 2012-08-14: 240 (amd64/Linux) + # 2012-09-18: 237 (amd64/Linux) + # 2012-11-12: 249 (amd64/Linux) + # 2013-01-29: 274 (amd64/Linux) + # 2013-10-18: 323 (amd64/Linux) + ,(platform('i386-unknown-mingw32'), 163, 10) + # 2013-02-10: 133 (x86/Windows) + # 2013-11-13: 163 (x86/Windows, 64bit machine) + ,(wordsize(32), 156, 1)]) + # 2012-08-14: 144 (x86/OSX) + # 2012-10-30: 113 (x86/Windows) + # 2013-02-10: 139 (x86/OSX) + # 2014-01-22: 168 (x86/Linux - new haddock) + # 2014-06-29: 156 (x86/Linux) + ,stats_num_field('max_bytes_used', + [(wordsize(64), 112286208, 10) + # 2012-08-14: 87374568 (amd64/Linux) + # 2012-08-21: 86428216 (amd64/Linux) + # 2012-09-20: 84794136 (amd64/Linux) + # 2012-11-12: 87265136 (amd64/Linux) + # 2013-01-29: 96022312 (amd64/Linux) + # 2013-10-18: 115113864 (amd64/Linux) + # 2014-07-31: 127954488 (amd64/Linux), correlates with 1ae5fa45 + # 2014-08-29: 112286208 (amd64/Linux), w/w for INLINABLE things + ,(platform('i386-unknown-mingw32'), 58557136, 10) + # 2013-02-10: 47988488 (x86/Windows) + # 2013-11-13: 58557136 (x86/Windows, 64bit machine) + ,(wordsize(32), 58243640, 1)]) + # 2013-02-10: 52237984 (x86/OSX) + # 2014-01-22: 62189068 (x86/Linux) + # 2014-06-29: 58243640 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 7946284944, 5) # 2012-08-14: 5920822352 (amd64/Linux) @@ -36,6 +65,44 @@ test('haddock.base', test('haddock.Cabal', [unless(in_tree_compiler(), skip) + ,stats_num_field('peak_megabytes_allocated', + [(wordsize(64), 309, 10) + # 2012-08-14: 202 (amd64/Linux) + # 2012-08-29: 211 (amd64/Linux, new codegen) + # 2012-09-20: 227 (amd64/Linux) + # 2012-10-08: 217 (amd64/Linux) + # 2013-06-07: 246 (amd64/Linux) (reason unknown) + # 2013-11-21: 269 + # 2013-11-22: 278 (amd64/Linux) (TH refactoring; weird) + # 2014-07-14: 309 (amd64/Linux) + ,(platform('i386-unknown-mingw32'), 144, 10) + # 2012-10-30: 83 (x86/Windows) + # 2013-02-10: 116 (x86/Windows) + # 2013-11-13: 129 (x86/Windows, 64bit machine) + # 2014-01-28: 136 + # 2014-04-04: 144 + ,(wordsize(32), 147, 1)]) + # 2012-08-14: 116 (x86/OSX) + # 2013-02-10: 89 (x86/Windows) + # 2014-01-22: 139 (x86/Linux - new haddock, but out of date before) + # 2014-06-29: 147 (x86/Linux) + ,stats_num_field('max_bytes_used', + [(wordsize(64), 113232208, 15) + # 2012-08-14: 74119424 (amd64/Linux) + # 2012-08-29: 77992512 (amd64/Linux, new codegen) + # 2012-10-02: 91341568 (amd64/Linux) + # 2012-10-08: 80590280 (amd64/Linux) + # 2013-03-13: 95356616 (amd64/Linux) Cabal updated + # 2014-07-14: 113232208 (amd64/Linux) + ,(platform('i386-unknown-mingw32'), 63493200, 15) + # 2012-10-30: 44224896 (x86/Windows) + # 2013-11-13: 49391436 (x86/Windows, 64bit machine) + # 2014-04-04: 63493200 (x86/Windows, 64bit machine) + ,(wordsize(32), 66411508, 1)]) + # 2012-08-14: 47461532 (x86/OSX) + # 2013-02-10: 46563344 (x86/OSX) + # 2014-01-22: 52718512 (x86/Linux) + # 2014-06-29: 66411508 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 4267311856, 5) # 2012-08-14: 3255435248 (amd64/Linux) @@ -70,6 +137,44 @@ test('haddock.Cabal', test('haddock.compiler', [unless(in_tree_compiler(), skip) + ,stats_num_field('peak_megabytes_allocated', + [(wordsize(64), 1551, 10) + # 2012-08-14: 1203 (amd64/Linux) + # 2012-08-21: 1199 (amd64/Linux) + # 2012-09-20: 1228 (amd64/Linux) + # 2012-10-08: 1240 (amd64/Linux) + # 2013-08-26: 1250 (amd64/Linux) Cabal updated + # 2013-10-18: 1408 (amd64/Linux) + # 2013-12-12: 1551 (amd64/Linux) + ,(platform('i386-unknown-mingw32'), 735, 10) + # 2012-10-30: 606 (x86/Windows) + # 2013-02-10: 653 (x86/Windows) + # 2013-11-13: 735 (x86/Windows, 64bit machine) + ,(wordsize(32), 771, 1)]) + # 2012-08-14: 631 (x86/OSX) + # 2013-02-10: 663 (x86/OSX) + # 2014-01-22: 727 (x86/Linux - new haddock, but out of date before) + # 2014-06-29: 771 (x86/Linux) + ,stats_num_field('max_bytes_used', + [(wordsize(64), 541926264, 10) + # 2012-08-14: 428775544 (amd64/Linux) + # 2012-09-20: 437618008 (amd64/Linux) + # 2012-10-08: 442768280 (amd64/Linux) + # 2012-11-12: 420105120 (amd64/Linux) + # 2013-06-08: 477593712 (amd64/Linux) (reason unknown) + # 2013-11-21: 502920176 (amd64/Linux) + # 2013-11-22: 541926264 (amd64/Linux) (TH refactoring; weird) + ,(platform('i386-unknown-mingw32'), 278706344, 10) + # 2012-10-30: 220847924 (x86/Windows) + # 2013-02-10: 238529512 (x86/Windows) + # 2013-11-13: 269147084 (x86/Windows, 64bit machine) + # 2014-01-28: 283814088 (x86/Windows) + # 2014-04-04: 278706344 (x86/Windows) + ,(wordsize(32), 284082916, 1)]) + # 2012-08-14: 231064920 (x86/OSX) + # 2013-02-10: 241785276 (x86/Windows) + # 2014-01-22: 278124612 (x86/Linux - new haddock) + # 2014-06-29: 284082916 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 29809571376, 10) # 2012-08-14: 26070600504 (amd64/Linux) From git at git.haskell.org Thu Sep 4 08:52:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Sep 2014 08:52:36 +0000 (UTC) Subject: [commit: ghc] master: Do not test max_bytes_used et. al for haddock tests (498d7dd) Message-ID: <20140904085237.4C73224121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/498d7dd2dc731a92eda2210e4ab0a04366511627/ghc >--------------------------------------------------------------- commit 498d7dd2dc731a92eda2210e4ab0a04366511627 Author: Joachim Breitner Date: Thu Sep 4 10:52:32 2014 +0200 Do not test max_bytes_used et. al for haddock tests Summary: as these are unreliable, and it is hard to re-run haddock with other RTS flags. Test Plan: run validate Reviewers: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D196 GHC Trac Issues: #9551 >--------------------------------------------------------------- 498d7dd2dc731a92eda2210e4ab0a04366511627 testsuite/tests/perf/haddock/all.T | 113 ++----------------------------------- 1 file changed, 4 insertions(+), 109 deletions(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index ce11f60..ce7a37c 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -1,38 +1,9 @@ +# We do not add peak_megabytes_allocated and max_bytes_used to these tests, as +# they are somewhat unreliable, and it is harder to re-run these numbers to +# detect outliers, as described in Note [residency] + test('haddock.base', [unless(in_tree_compiler(), skip) - ,stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 323, 10) - # 2012-08-14: 240 (amd64/Linux) - # 2012-09-18: 237 (amd64/Linux) - # 2012-11-12: 249 (amd64/Linux) - # 2013-01-29: 274 (amd64/Linux) - # 2013-10-18: 323 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 163, 10) - # 2013-02-10: 133 (x86/Windows) - # 2013-11-13: 163 (x86/Windows, 64bit machine) - ,(wordsize(32), 156, 1)]) - # 2012-08-14: 144 (x86/OSX) - # 2012-10-30: 113 (x86/Windows) - # 2013-02-10: 139 (x86/OSX) - # 2014-01-22: 168 (x86/Linux - new haddock) - # 2014-06-29: 156 (x86/Linux) - ,stats_num_field('max_bytes_used', - [(wordsize(64), 112286208, 10) - # 2012-08-14: 87374568 (amd64/Linux) - # 2012-08-21: 86428216 (amd64/Linux) - # 2012-09-20: 84794136 (amd64/Linux) - # 2012-11-12: 87265136 (amd64/Linux) - # 2013-01-29: 96022312 (amd64/Linux) - # 2013-10-18: 115113864 (amd64/Linux) - # 2014-07-31: 127954488 (amd64/Linux), correlates with 1ae5fa45 - # 2014-08-29: 112286208 (amd64/Linux), w/w for INLINABLE things - ,(platform('i386-unknown-mingw32'), 58557136, 10) - # 2013-02-10: 47988488 (x86/Windows) - # 2013-11-13: 58557136 (x86/Windows, 64bit machine) - ,(wordsize(32), 58243640, 1)]) - # 2013-02-10: 52237984 (x86/OSX) - # 2014-01-22: 62189068 (x86/Linux) - # 2014-06-29: 58243640 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 7946284944, 5) # 2012-08-14: 5920822352 (amd64/Linux) @@ -65,44 +36,6 @@ test('haddock.base', test('haddock.Cabal', [unless(in_tree_compiler(), skip) - ,stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 309, 10) - # 2012-08-14: 202 (amd64/Linux) - # 2012-08-29: 211 (amd64/Linux, new codegen) - # 2012-09-20: 227 (amd64/Linux) - # 2012-10-08: 217 (amd64/Linux) - # 2013-06-07: 246 (amd64/Linux) (reason unknown) - # 2013-11-21: 269 - # 2013-11-22: 278 (amd64/Linux) (TH refactoring; weird) - # 2014-07-14: 309 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 144, 10) - # 2012-10-30: 83 (x86/Windows) - # 2013-02-10: 116 (x86/Windows) - # 2013-11-13: 129 (x86/Windows, 64bit machine) - # 2014-01-28: 136 - # 2014-04-04: 144 - ,(wordsize(32), 147, 1)]) - # 2012-08-14: 116 (x86/OSX) - # 2013-02-10: 89 (x86/Windows) - # 2014-01-22: 139 (x86/Linux - new haddock, but out of date before) - # 2014-06-29: 147 (x86/Linux) - ,stats_num_field('max_bytes_used', - [(wordsize(64), 113232208, 15) - # 2012-08-14: 74119424 (amd64/Linux) - # 2012-08-29: 77992512 (amd64/Linux, new codegen) - # 2012-10-02: 91341568 (amd64/Linux) - # 2012-10-08: 80590280 (amd64/Linux) - # 2013-03-13: 95356616 (amd64/Linux) Cabal updated - # 2014-07-14: 113232208 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 63493200, 15) - # 2012-10-30: 44224896 (x86/Windows) - # 2013-11-13: 49391436 (x86/Windows, 64bit machine) - # 2014-04-04: 63493200 (x86/Windows, 64bit machine) - ,(wordsize(32), 66411508, 1)]) - # 2012-08-14: 47461532 (x86/OSX) - # 2013-02-10: 46563344 (x86/OSX) - # 2014-01-22: 52718512 (x86/Linux) - # 2014-06-29: 66411508 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 4267311856, 5) # 2012-08-14: 3255435248 (amd64/Linux) @@ -137,44 +70,6 @@ test('haddock.Cabal', test('haddock.compiler', [unless(in_tree_compiler(), skip) - ,stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 1551, 10) - # 2012-08-14: 1203 (amd64/Linux) - # 2012-08-21: 1199 (amd64/Linux) - # 2012-09-20: 1228 (amd64/Linux) - # 2012-10-08: 1240 (amd64/Linux) - # 2013-08-26: 1250 (amd64/Linux) Cabal updated - # 2013-10-18: 1408 (amd64/Linux) - # 2013-12-12: 1551 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 735, 10) - # 2012-10-30: 606 (x86/Windows) - # 2013-02-10: 653 (x86/Windows) - # 2013-11-13: 735 (x86/Windows, 64bit machine) - ,(wordsize(32), 771, 1)]) - # 2012-08-14: 631 (x86/OSX) - # 2013-02-10: 663 (x86/OSX) - # 2014-01-22: 727 (x86/Linux - new haddock, but out of date before) - # 2014-06-29: 771 (x86/Linux) - ,stats_num_field('max_bytes_used', - [(wordsize(64), 541926264, 10) - # 2012-08-14: 428775544 (amd64/Linux) - # 2012-09-20: 437618008 (amd64/Linux) - # 2012-10-08: 442768280 (amd64/Linux) - # 2012-11-12: 420105120 (amd64/Linux) - # 2013-06-08: 477593712 (amd64/Linux) (reason unknown) - # 2013-11-21: 502920176 (amd64/Linux) - # 2013-11-22: 541926264 (amd64/Linux) (TH refactoring; weird) - ,(platform('i386-unknown-mingw32'), 278706344, 10) - # 2012-10-30: 220847924 (x86/Windows) - # 2013-02-10: 238529512 (x86/Windows) - # 2013-11-13: 269147084 (x86/Windows, 64bit machine) - # 2014-01-28: 283814088 (x86/Windows) - # 2014-04-04: 278706344 (x86/Windows) - ,(wordsize(32), 284082916, 1)]) - # 2012-08-14: 231064920 (x86/OSX) - # 2013-02-10: 241785276 (x86/Windows) - # 2014-01-22: 278124612 (x86/Linux - new haddock) - # 2014-06-29: 284082916 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 29809571376, 10) # 2012-08-14: 26070600504 (amd64/Linux) From git at git.haskell.org Thu Sep 4 10:04:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Sep 2014 10:04:18 +0000 (UTC) Subject: [commit: ghc] master: Another test for type function saturation (3034dd4) Message-ID: <20140904100418.A24A524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3034dd40a9c397ab4e5c596c15de83eefd834341/ghc >--------------------------------------------------------------- commit 3034dd40a9c397ab4e5c596c15de83eefd834341 Author: Simon Peyton Jones Date: Wed Sep 3 21:44:40 2014 +0100 Another test for type function saturation Came up on GHC users list >--------------------------------------------------------------- 3034dd40a9c397ab4e5c596c15de83eefd834341 .../tests/indexed-types/should_compile/Sock.hs | 55 +++++++++++++++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + .../tests/indexed-types/should_fail/BadSock.hs | 57 ++++++++++++++++++++++ .../should_fail/{T9097.stderr => BadSock.stderr} | 4 +- testsuite/tests/indexed-types/should_fail/all.T | 1 + 5 files changed, 116 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/indexed-types/should_compile/Sock.hs b/testsuite/tests/indexed-types/should_compile/Sock.hs new file mode 100644 index 0000000..7b89e9a --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/Sock.hs @@ -0,0 +1,55 @@ +-- From the GHC users mailing list, 3/9/14 + +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module Sock where + +import Data.Proxy +import GHC.Exts + +data Message + +data SocketType = Dealer | Push | Pull + +data SocketOperation = Read | Write + +data SockOp :: SocketType -> SocketOperation -> * where + SRead :: Foo 'Read sock => SockOp sock 'Read + SWrite :: Foo Write sock => SockOp sock Write + +data Socket :: SocketType -> * where + Socket :: proxy sock + -> (forall op . Foo op sock => SockOp sock op -> Operation op) + -> Socket sock + +type family Foo (op :: SocketOperation) (s :: SocketType) :: Constraint where + Foo 'Read s = Readable s + Foo Write s = Writable s + +type family Operation (op :: SocketOperation) :: * where + Operation 'Read = IO Message + Operation Write = Message -> IO () + +type family Readable (t :: SocketType) :: Constraint where + Readable Dealer = () + Readable Pull = () + +type family Writable (t :: SocketType) :: Constraint where + Writable Dealer = () + Writable Push = () + +dealer :: Socket Dealer +dealer = undefined + +push :: Socket Push +push = undefined + +pull :: Socket Pull +pull = undefined + +readSocket :: forall sock . Readable sock => Socket sock -> IO Message +readSocket (Socket _ f) = f (SRead :: SockOp sock 'Read) diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index be0099c..ff45df2 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -246,3 +246,4 @@ test('T8979', normal, compile, ['']) test('T9085', normal, compile, ['']) test('T9316', normal, compile, ['']) test('red-black-delete', normal, compile, ['']) +test('Sock', normal, compile, ['']) diff --git a/testsuite/tests/indexed-types/should_fail/BadSock.hs b/testsuite/tests/indexed-types/should_fail/BadSock.hs new file mode 100644 index 0000000..3e72817 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/BadSock.hs @@ -0,0 +1,57 @@ +-- From the GHC users mailing list, 3/9/14 + +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module BadSock where + +import Data.Proxy +import GHC.Exts + +data Message + +data SocketType = Dealer | Push | Pull + +data SocketOperation = Read | Write + +data SockOp :: SocketType -> SocketOperation -> * where + SRead :: Foo 'Read sock => SockOp sock 'Read + SWrite :: Foo Write sock => SockOp sock Write + +data Socket :: SocketType -> * where + Socket :: proxy sock + -> (forall op . Foo op sock => SockOp sock op -> Operation op) + -> Socket sock + +type family Foo (op :: SocketOperation) :: SocketType -> Constraint where + Foo 'Read = Readable + Foo Write = Writable + +type family Operation (op :: SocketOperation) :: * where + Operation 'Read = IO Message + Operation Write = Message -> IO () + +type family Readable (t :: SocketType) :: Constraint where + Readable Dealer = () + Readable Pull = () + +type family Writable (t :: SocketType) :: Constraint where + Writable Dealer = () + Writable Push = () + +{- +dealer :: Socket Dealer +dealer = undefined + +push :: Socket Push +push = undefined + +pull :: Socket Pull +pull = undefined + +readSocket :: forall sock . Readable sock => Socket sock -> IO Message +readSocket (Socket _ f) = f (SRead :: SockOp sock 'Read) +-} \ No newline at end of file diff --git a/testsuite/tests/indexed-types/should_fail/T9097.stderr b/testsuite/tests/indexed-types/should_fail/BadSock.stderr similarity index 52% copy from testsuite/tests/indexed-types/should_fail/T9097.stderr copy to testsuite/tests/indexed-types/should_fail/BadSock.stderr index 02dfc33..fc3fb54 100644 --- a/testsuite/tests/indexed-types/should_fail/T9097.stderr +++ b/testsuite/tests/indexed-types/should_fail/BadSock.stderr @@ -1,5 +1,5 @@ -T9097.hs:10:3: - Illegal type synonym family application in instance: Any +BadSock.hs:30:5: + Type family ?Readable? should have 1 argument, but has been given none In the equations for closed type family ?Foo? In the type family declaration for ?Foo? diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 50eec86..2862f1e 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -127,4 +127,5 @@ test('T9160', normal, compile_fail, ['']) test('T9357', normal, compile_fail, ['']) test('T9371', normal, compile_fail, ['']) test('T9433', normal, compile_fail, ['']) +test('BadSock', normal, compile_fail, ['']) From git at git.haskell.org Thu Sep 4 10:04:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Sep 2014 10:04:20 +0000 (UTC) Subject: [commit: ghc] master: Update performance numbers (mostly improved) (b5a5776) Message-ID: <20140904100421.173F124121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b5a577678caf37f78bf640a15dd6d1dfbb6dd937/ghc >--------------------------------------------------------------- commit b5a577678caf37f78bf640a15dd6d1dfbb6dd937 Author: Simon Peyton Jones Date: Wed Sep 3 21:40:59 2014 +0100 Update performance numbers (mostly improved) >--------------------------------------------------------------- b5a577678caf37f78bf640a15dd6d1dfbb6dd937 testsuite/tests/perf/compiler/all.T | 20 ++++++++++++++------ testsuite/tests/perf/haddock/all.T | 3 ++- 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index f53787a..0ac3ad1 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -179,9 +179,10 @@ test('T4801', [(platform('x86_64-apple-darwin'), 464872776, 5), # expected value: 510938976 (amd64/OS X): - (wordsize(32), 211198056, 10), + (wordsize(32), 185242032, 10), # prev: 185669232 (x86/OSX) # 2014-01-22: 211198056 (x86/Linux) + # 2014-09-03: 185242032 (Windows laptop) (wordsize(64), 392409984, 10)]), # prev: 360243576 (amd64/Linux) # 19/10/2012: 447190832 (amd64/Linux) (-fPIC turned on) @@ -326,11 +327,13 @@ test('T783', [ only_ways(['normal']), # no optimisation for this one # expected value: 175,569,928 (x86/Linux) compiler_stats_num_field('bytes allocated', - [(wordsize(32), 319179104, 5), + [(wordsize(32), 223377364, 5), # 2012-10-08: 226907420 (x86/Linux) # 2013-02-10: 329202116 (x86/Windows) # 2013-02-10: 338465200 (x86/OSX) # 2014-04-04: 319179104 (x86 Windows, 64 bit machine) + # 2014-09-03: 223377364 (Windows, better specialisation, raft of core-to-core optimisations) + (wordsize(64), 441932632, 10)]), # prev: 349263216 (amd64/Linux) # 07/08/2012: 384479856 (amd64/Linux) @@ -353,10 +356,11 @@ test('T783', test('T5321Fun', [ only_ways(['normal']), # no optimisation for this one compiler_stats_num_field('bytes allocated', - [(wordsize(32), 344416344, 10), + [(wordsize(32), 299656164, 10), # prev: 300000000 # 2012-10-08: 344416344 x86/Linux # (increase due to new codegen) + # 2014-09-03: 299656164 (specialisation and inlining) (wordsize(64), 614409344, 10)]) # prev: 585521080 # 29/08/2012: 713385808 # (increase due to new codegen) @@ -394,8 +398,10 @@ test('T5321FD', test('T5642', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(32), 650000000, 10), + [(wordsize(32), 753045568, 10), # sample from x86/Linux + # pref: 650000000 + # 2014-09-03: 753045568 (wordsize(64), 1402242360, 10)]) # prev: 1300000000 # 2014-07-17: 1358833928 (general round of updates) @@ -411,9 +417,10 @@ test('T5642', test('T5837', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(32), 45520936 , 10), + [(wordsize(32), 37096484, 10), # 40000000 (x86/Linux) # 2013-11-13: 45520936 (x86/Windows, 64bit machine) + # 2041-09-03: 37096484 (Windows laptop, w/w for INLINABLE things (wordsize(64), 73639840, 10)]) # sample: 3926235424 (amd64/Linux, 15/2/2012) # 2012-10-02 81879216 @@ -428,10 +435,11 @@ test('T5837', test('T6048', [ only_ways(['optasm']), compiler_stats_num_field('bytes allocated', - [(wordsize(32), 62618072, 10), + [(wordsize(32), 56315812, 10), # prev: 38000000 (x86/Linux) # 2012-10-08: 48887164 (x86/Linux) # 2014-04-04: 62618072 (x86 Windows, 64 bit machine) + # 2014-09-03: 56315812 (x86 Windows, w/w for INLINEAVBLE) (wordsize(64), 108354472, 12)]) # 18/09/2012 97247032 amd64/Linux # 16/01/2014 108578664 amd64/Linux (unknown, likely foldl-via-foldr) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index ce7a37c..f7c25ed 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -18,11 +18,12 @@ test('haddock.base', # 2014-06-12: 7498123680 (x86_64/Linux) # 2014-08-05: 7992757384 (x86_64/Linux - bugfix for #314, Haddock now parses more URLs) # 2014-08-08: 7946284944 (x86_64/Linux - Haddock updates to attoparsec-0.12.1.0) - ,(platform('i386-unknown-mingw32'), 3548581572, 5) + ,(platform('i386-unknown-mingw32'), 3746792812, 5) # 2013-02-10: 3358693084 (x86/Windows) # 2013-11-13: 3097751052 (x86/Windows, 64bit machine) # 2014-04-04: 3548581572 (x86/Windows, 64bit machine) # 2014-08-05: XXX TODO UPDATE ME XXX + # 2014-09-03: Windows laptop, no konwn reason ,(wordsize(32), 3799130400, 1)]) # 2012-08-14: 3046487920 (x86/OSX) # 2012-10-30: 2955470952 (x86/Windows) From git at git.haskell.org Thu Sep 4 10:04:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Sep 2014 10:04:23 +0000 (UTC) Subject: [commit: ghc] master: Small improvement to unsaturated-type-function error message (4c359f5) Message-ID: <20140904100423.9772424121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4c359f5a50bc8ab1fcb51632f08f0cbbeb5e6d47/ghc >--------------------------------------------------------------- commit 4c359f5a50bc8ab1fcb51632f08f0cbbeb5e6d47 Author: Simon Peyton Jones Date: Wed Sep 3 21:47:43 2014 +0100 Small improvement to unsaturated-type-function error message >--------------------------------------------------------------- 4c359f5a50bc8ab1fcb51632f08f0cbbeb5e6d47 compiler/typecheck/TcValidity.lhs | 4 +++- testsuite/tests/indexed-types/should_fail/T9433.stderr | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs index 9e518c7..ad81623 100644 --- a/compiler/typecheck/TcValidity.lhs +++ b/compiler/typecheck/TcValidity.lhs @@ -332,8 +332,10 @@ check_syn_tc_app ctxt rank ty tc tys = mapM_ check_arg tys | otherwise - = failWithTc (arityErr "Type synonym" (tyConName tc) tc_arity n_args) + = failWithTc (arityErr flavour (tyConName tc) tc_arity n_args) where + flavour | isSynFamilyTyCon tc = "Type family" + | otherwise = "Type synonym" n_args = length tys tc_arity = tyConArity tc check_arg | isSynFamilyTyCon tc = check_arg_type ctxt rank diff --git a/testsuite/tests/indexed-types/should_fail/T9433.stderr b/testsuite/tests/indexed-types/should_fail/T9433.stderr index 0b17f57..51780f1 100644 --- a/testsuite/tests/indexed-types/should_fail/T9433.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9433.stderr @@ -1,4 +1,4 @@ T9433.hs:14:6: - Type synonym ?Id? should have 1 argument, but has been given none + Type family ?Id? should have 1 argument, but has been given none In the type signature for ?x?: x :: Map Id [Bool] From git at git.haskell.org Thu Sep 4 10:44:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Sep 2014 10:44:51 +0000 (UTC) Subject: [commit: ghc] master: Add missing changelog/since entry for `uncons` (6af1c9b) Message-ID: <20140904104451.F1E0524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6af1c9b2709281520c2015349e4a15265c364962/ghc >--------------------------------------------------------------- commit 6af1c9b2709281520c2015349e4a15265c364962 Author: Herbert Valerio Riedel Date: Thu Sep 4 12:42:54 2014 +0200 Add missing changelog/since entry for `uncons` This is a follow-up commit to e428b5b8cc1448dcff7d7cdcbeb738eb0bea102f (refs D195 & #9550) >--------------------------------------------------------------- 6af1c9b2709281520c2015349e4a15265c364962 libraries/base/GHC/List.lhs | 2 ++ libraries/base/changelog.md | 2 ++ 2 files changed, 4 insertions(+) diff --git a/libraries/base/GHC/List.lhs b/libraries/base/GHC/List.lhs index 4fcb54a..bbaf39f 100644 --- a/libraries/base/GHC/List.lhs +++ b/libraries/base/GHC/List.lhs @@ -74,6 +74,8 @@ badHead = errorEmptyList "head" -- | Decompose a list into its head and tail. If the list is empty, -- returns 'Nothing'. If the list is non-empty, returns @'Just' (x, xs)@, -- where @x@ is the head of the list and @xs@ its tail. +-- +-- /Since: 4.8.0.0/ uncons :: [a] -> Maybe (a, [a]) uncons [] = Nothing uncons (x:xs) = Just (x, xs) diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 97a8242..4b97c58 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -25,6 +25,8 @@ * Add `countLeadingZeros` and `countTrailingZeros` methods to `Data.Bits.FiniteBits` class + * Add `Data.List.uncons` list destructor (#9550) + ## 4.7.0.1 *Jul 2014* * Bundled with GHC 7.8.3 From git at git.haskell.org Fri Sep 5 06:54:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Sep 2014 06:54:15 +0000 (UTC) Subject: [commit: ghc] master: pprC: declare extern cmm primitives as functions, not data (e18525f) Message-ID: <20140905065434.3F1B724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e18525fae273f4c1ad8d6cbe1dea4fc074cac721/ghc >--------------------------------------------------------------- commit e18525fae273f4c1ad8d6cbe1dea4fc074cac721 Author: Sergei Trofimovich Date: Thu Sep 4 17:50:45 2014 +0300 pprC: declare extern cmm primitives as functions, not data Summary: The commit fixes incorrect code generation of integer-gmp package on ia64 due to C prototypes mismatch. Before the patch prototypes for "foreign import prim" were: StgWord poizh[]; After the patch they became: StgFunPtr poizh(); Long story: Consider the following simple example: {-# LANGUAGE MagicHash, GHCForeignImportPrim, UnliftedFFITypes #-} module M where import GHC.Prim -- Int# foreign import prim "poizh" poi# :: Int# -> Int# Before the patch unregisterised build generated the following 'poizh' reference: EI_(poizh); /* StgWord poizh[]; */ FN_(M_poizh_entry) { // ... JMP_((W_)&poizh); } After the patch it looks this way: EF_(poizh); /* StgFunPtr poizh(); */ FN_(M_poizh_entry) { // ... JMP_((W_)&poizh); } On ia64 it leads to different relocation types being generated: incorrect one: addl r14 = @ltoffx(poizh#) ld8.mov r14 = [r14], poizh# ; r14 = address-of 'poizh#' correct one: addl r14 = @ltoff(@fptr(poizh#)), gp ; r14 = address-of-thunk 'poizh#' ld8 r14 = [r14] '@fptr(poizh#)' basically instructs assembler to creates another obect consisting of real address to 'poizh' instructions and module address. That '@fptr' object is used as a function "address" This object is different for every module referencing 'poizh' symbol. All indirect function calls expect '@fptr' object. That way call site reads real destination address and set destination module address in 'gp' register from '@fptr'. Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- e18525fae273f4c1ad8d6cbe1dea4fc074cac721 compiler/cmm/CLabel.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index 02ad026..0f2c0ae 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -813,6 +813,7 @@ labelType (CmmLabel _ _ CmmClosure) = GcPtrLabel labelType (CmmLabel _ _ CmmCode) = CodeLabel labelType (CmmLabel _ _ CmmInfo) = DataLabel labelType (CmmLabel _ _ CmmEntry) = CodeLabel +labelType (CmmLabel _ _ CmmPrimCall) = CodeLabel labelType (CmmLabel _ _ CmmRetInfo) = DataLabel labelType (CmmLabel _ _ CmmRet) = CodeLabel labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel From git at git.haskell.org Fri Sep 5 21:04:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Sep 2014 21:04:38 +0000 (UTC) Subject: [commit: ghc] master: Revert "Do not test max_bytes_used et. al for haddock tests" (55e4e5a) Message-ID: <20140905210529.2EC8D24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/55e4e5ad3f7a549949c9e369a07df597b3e17ad8/ghc >--------------------------------------------------------------- commit 55e4e5ad3f7a549949c9e369a07df597b3e17ad8 Author: Joachim Breitner Date: Fri Sep 5 23:03:58 2014 +0200 Revert "Do not test max_bytes_used et. al for haddock tests" This reverts commit 498d7dd2dc731a92eda2210e4ab0a04366511627. Again sorry for the noise. This is the last reverstion. I will fix this for good at around 12:13 CEST tomorrow :-) >--------------------------------------------------------------- 55e4e5ad3f7a549949c9e369a07df597b3e17ad8 testsuite/tests/perf/haddock/all.T | 113 +++++++++++++++++++++++++++++++++++-- 1 file changed, 109 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index f7c25ed..dcf41e4 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -1,9 +1,38 @@ -# We do not add peak_megabytes_allocated and max_bytes_used to these tests, as -# they are somewhat unreliable, and it is harder to re-run these numbers to -# detect outliers, as described in Note [residency] - test('haddock.base', [unless(in_tree_compiler(), skip) + ,stats_num_field('peak_megabytes_allocated', + [(wordsize(64), 323, 10) + # 2012-08-14: 240 (amd64/Linux) + # 2012-09-18: 237 (amd64/Linux) + # 2012-11-12: 249 (amd64/Linux) + # 2013-01-29: 274 (amd64/Linux) + # 2013-10-18: 323 (amd64/Linux) + ,(platform('i386-unknown-mingw32'), 163, 10) + # 2013-02-10: 133 (x86/Windows) + # 2013-11-13: 163 (x86/Windows, 64bit machine) + ,(wordsize(32), 156, 1)]) + # 2012-08-14: 144 (x86/OSX) + # 2012-10-30: 113 (x86/Windows) + # 2013-02-10: 139 (x86/OSX) + # 2014-01-22: 168 (x86/Linux - new haddock) + # 2014-06-29: 156 (x86/Linux) + ,stats_num_field('max_bytes_used', + [(wordsize(64), 112286208, 10) + # 2012-08-14: 87374568 (amd64/Linux) + # 2012-08-21: 86428216 (amd64/Linux) + # 2012-09-20: 84794136 (amd64/Linux) + # 2012-11-12: 87265136 (amd64/Linux) + # 2013-01-29: 96022312 (amd64/Linux) + # 2013-10-18: 115113864 (amd64/Linux) + # 2014-07-31: 127954488 (amd64/Linux), correlates with 1ae5fa45 + # 2014-08-29: 112286208 (amd64/Linux), w/w for INLINABLE things + ,(platform('i386-unknown-mingw32'), 58557136, 10) + # 2013-02-10: 47988488 (x86/Windows) + # 2013-11-13: 58557136 (x86/Windows, 64bit machine) + ,(wordsize(32), 58243640, 1)]) + # 2013-02-10: 52237984 (x86/OSX) + # 2014-01-22: 62189068 (x86/Linux) + # 2014-06-29: 58243640 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 7946284944, 5) # 2012-08-14: 5920822352 (amd64/Linux) @@ -37,6 +66,44 @@ test('haddock.base', test('haddock.Cabal', [unless(in_tree_compiler(), skip) + ,stats_num_field('peak_megabytes_allocated', + [(wordsize(64), 309, 10) + # 2012-08-14: 202 (amd64/Linux) + # 2012-08-29: 211 (amd64/Linux, new codegen) + # 2012-09-20: 227 (amd64/Linux) + # 2012-10-08: 217 (amd64/Linux) + # 2013-06-07: 246 (amd64/Linux) (reason unknown) + # 2013-11-21: 269 + # 2013-11-22: 278 (amd64/Linux) (TH refactoring; weird) + # 2014-07-14: 309 (amd64/Linux) + ,(platform('i386-unknown-mingw32'), 144, 10) + # 2012-10-30: 83 (x86/Windows) + # 2013-02-10: 116 (x86/Windows) + # 2013-11-13: 129 (x86/Windows, 64bit machine) + # 2014-01-28: 136 + # 2014-04-04: 144 + ,(wordsize(32), 147, 1)]) + # 2012-08-14: 116 (x86/OSX) + # 2013-02-10: 89 (x86/Windows) + # 2014-01-22: 139 (x86/Linux - new haddock, but out of date before) + # 2014-06-29: 147 (x86/Linux) + ,stats_num_field('max_bytes_used', + [(wordsize(64), 113232208, 15) + # 2012-08-14: 74119424 (amd64/Linux) + # 2012-08-29: 77992512 (amd64/Linux, new codegen) + # 2012-10-02: 91341568 (amd64/Linux) + # 2012-10-08: 80590280 (amd64/Linux) + # 2013-03-13: 95356616 (amd64/Linux) Cabal updated + # 2014-07-14: 113232208 (amd64/Linux) + ,(platform('i386-unknown-mingw32'), 63493200, 15) + # 2012-10-30: 44224896 (x86/Windows) + # 2013-11-13: 49391436 (x86/Windows, 64bit machine) + # 2014-04-04: 63493200 (x86/Windows, 64bit machine) + ,(wordsize(32), 66411508, 1)]) + # 2012-08-14: 47461532 (x86/OSX) + # 2013-02-10: 46563344 (x86/OSX) + # 2014-01-22: 52718512 (x86/Linux) + # 2014-06-29: 66411508 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 4267311856, 5) # 2012-08-14: 3255435248 (amd64/Linux) @@ -71,6 +138,44 @@ test('haddock.Cabal', test('haddock.compiler', [unless(in_tree_compiler(), skip) + ,stats_num_field('peak_megabytes_allocated', + [(wordsize(64), 1551, 10) + # 2012-08-14: 1203 (amd64/Linux) + # 2012-08-21: 1199 (amd64/Linux) + # 2012-09-20: 1228 (amd64/Linux) + # 2012-10-08: 1240 (amd64/Linux) + # 2013-08-26: 1250 (amd64/Linux) Cabal updated + # 2013-10-18: 1408 (amd64/Linux) + # 2013-12-12: 1551 (amd64/Linux) + ,(platform('i386-unknown-mingw32'), 735, 10) + # 2012-10-30: 606 (x86/Windows) + # 2013-02-10: 653 (x86/Windows) + # 2013-11-13: 735 (x86/Windows, 64bit machine) + ,(wordsize(32), 771, 1)]) + # 2012-08-14: 631 (x86/OSX) + # 2013-02-10: 663 (x86/OSX) + # 2014-01-22: 727 (x86/Linux - new haddock, but out of date before) + # 2014-06-29: 771 (x86/Linux) + ,stats_num_field('max_bytes_used', + [(wordsize(64), 541926264, 10) + # 2012-08-14: 428775544 (amd64/Linux) + # 2012-09-20: 437618008 (amd64/Linux) + # 2012-10-08: 442768280 (amd64/Linux) + # 2012-11-12: 420105120 (amd64/Linux) + # 2013-06-08: 477593712 (amd64/Linux) (reason unknown) + # 2013-11-21: 502920176 (amd64/Linux) + # 2013-11-22: 541926264 (amd64/Linux) (TH refactoring; weird) + ,(platform('i386-unknown-mingw32'), 278706344, 10) + # 2012-10-30: 220847924 (x86/Windows) + # 2013-02-10: 238529512 (x86/Windows) + # 2013-11-13: 269147084 (x86/Windows, 64bit machine) + # 2014-01-28: 283814088 (x86/Windows) + # 2014-04-04: 278706344 (x86/Windows) + ,(wordsize(32), 284082916, 1)]) + # 2012-08-14: 231064920 (x86/OSX) + # 2013-02-10: 241785276 (x86/Windows) + # 2014-01-22: 278124612 (x86/Linux - new haddock) + # 2014-06-29: 284082916 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 29809571376, 10) # 2012-08-14: 26070600504 (amd64/Linux) From git at git.haskell.org Sat Sep 6 10:23:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Sep 2014 10:23:09 +0000 (UTC) Subject: [commit: ghc] master: Do not use max_bytes_used for haddock test (7bf7ca2) Message-ID: <20140906102329.6F66B24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7bf7ca2b7a0f5ccf379cc035ad1e8bd80ea045f8/ghc >--------------------------------------------------------------- commit 7bf7ca2b7a0f5ccf379cc035ad1e8bd80ea045f8 Author: Joachim Breitner Date: Sat Sep 6 12:21:34 2014 +0200 Do not use max_bytes_used for haddock test Summary: as they are unreliable and hard to re-run. Test Plan: Run the testsuite Reviewers: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D200 GHC Trac Issues: #9556 >--------------------------------------------------------------- 7bf7ca2b7a0f5ccf379cc035ad1e8bd80ea045f8 testsuite/tests/perf/haddock/all.T | 113 ++----------------------------------- 1 file changed, 4 insertions(+), 109 deletions(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index dcf41e4..87f560f 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -1,38 +1,9 @@ +# We do not add peak_megabytes_allocated and max_bytes_used to these tests, as +# they are somewhat unreliable, and it is harder to re-run these numbers to +# detect outliers, as described in Note [residency]. See #9556. + test('haddock.base', [unless(in_tree_compiler(), skip) - ,stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 323, 10) - # 2012-08-14: 240 (amd64/Linux) - # 2012-09-18: 237 (amd64/Linux) - # 2012-11-12: 249 (amd64/Linux) - # 2013-01-29: 274 (amd64/Linux) - # 2013-10-18: 323 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 163, 10) - # 2013-02-10: 133 (x86/Windows) - # 2013-11-13: 163 (x86/Windows, 64bit machine) - ,(wordsize(32), 156, 1)]) - # 2012-08-14: 144 (x86/OSX) - # 2012-10-30: 113 (x86/Windows) - # 2013-02-10: 139 (x86/OSX) - # 2014-01-22: 168 (x86/Linux - new haddock) - # 2014-06-29: 156 (x86/Linux) - ,stats_num_field('max_bytes_used', - [(wordsize(64), 112286208, 10) - # 2012-08-14: 87374568 (amd64/Linux) - # 2012-08-21: 86428216 (amd64/Linux) - # 2012-09-20: 84794136 (amd64/Linux) - # 2012-11-12: 87265136 (amd64/Linux) - # 2013-01-29: 96022312 (amd64/Linux) - # 2013-10-18: 115113864 (amd64/Linux) - # 2014-07-31: 127954488 (amd64/Linux), correlates with 1ae5fa45 - # 2014-08-29: 112286208 (amd64/Linux), w/w for INLINABLE things - ,(platform('i386-unknown-mingw32'), 58557136, 10) - # 2013-02-10: 47988488 (x86/Windows) - # 2013-11-13: 58557136 (x86/Windows, 64bit machine) - ,(wordsize(32), 58243640, 1)]) - # 2013-02-10: 52237984 (x86/OSX) - # 2014-01-22: 62189068 (x86/Linux) - # 2014-06-29: 58243640 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 7946284944, 5) # 2012-08-14: 5920822352 (amd64/Linux) @@ -66,44 +37,6 @@ test('haddock.base', test('haddock.Cabal', [unless(in_tree_compiler(), skip) - ,stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 309, 10) - # 2012-08-14: 202 (amd64/Linux) - # 2012-08-29: 211 (amd64/Linux, new codegen) - # 2012-09-20: 227 (amd64/Linux) - # 2012-10-08: 217 (amd64/Linux) - # 2013-06-07: 246 (amd64/Linux) (reason unknown) - # 2013-11-21: 269 - # 2013-11-22: 278 (amd64/Linux) (TH refactoring; weird) - # 2014-07-14: 309 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 144, 10) - # 2012-10-30: 83 (x86/Windows) - # 2013-02-10: 116 (x86/Windows) - # 2013-11-13: 129 (x86/Windows, 64bit machine) - # 2014-01-28: 136 - # 2014-04-04: 144 - ,(wordsize(32), 147, 1)]) - # 2012-08-14: 116 (x86/OSX) - # 2013-02-10: 89 (x86/Windows) - # 2014-01-22: 139 (x86/Linux - new haddock, but out of date before) - # 2014-06-29: 147 (x86/Linux) - ,stats_num_field('max_bytes_used', - [(wordsize(64), 113232208, 15) - # 2012-08-14: 74119424 (amd64/Linux) - # 2012-08-29: 77992512 (amd64/Linux, new codegen) - # 2012-10-02: 91341568 (amd64/Linux) - # 2012-10-08: 80590280 (amd64/Linux) - # 2013-03-13: 95356616 (amd64/Linux) Cabal updated - # 2014-07-14: 113232208 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 63493200, 15) - # 2012-10-30: 44224896 (x86/Windows) - # 2013-11-13: 49391436 (x86/Windows, 64bit machine) - # 2014-04-04: 63493200 (x86/Windows, 64bit machine) - ,(wordsize(32), 66411508, 1)]) - # 2012-08-14: 47461532 (x86/OSX) - # 2013-02-10: 46563344 (x86/OSX) - # 2014-01-22: 52718512 (x86/Linux) - # 2014-06-29: 66411508 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 4267311856, 5) # 2012-08-14: 3255435248 (amd64/Linux) @@ -138,44 +71,6 @@ test('haddock.Cabal', test('haddock.compiler', [unless(in_tree_compiler(), skip) - ,stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 1551, 10) - # 2012-08-14: 1203 (amd64/Linux) - # 2012-08-21: 1199 (amd64/Linux) - # 2012-09-20: 1228 (amd64/Linux) - # 2012-10-08: 1240 (amd64/Linux) - # 2013-08-26: 1250 (amd64/Linux) Cabal updated - # 2013-10-18: 1408 (amd64/Linux) - # 2013-12-12: 1551 (amd64/Linux) - ,(platform('i386-unknown-mingw32'), 735, 10) - # 2012-10-30: 606 (x86/Windows) - # 2013-02-10: 653 (x86/Windows) - # 2013-11-13: 735 (x86/Windows, 64bit machine) - ,(wordsize(32), 771, 1)]) - # 2012-08-14: 631 (x86/OSX) - # 2013-02-10: 663 (x86/OSX) - # 2014-01-22: 727 (x86/Linux - new haddock, but out of date before) - # 2014-06-29: 771 (x86/Linux) - ,stats_num_field('max_bytes_used', - [(wordsize(64), 541926264, 10) - # 2012-08-14: 428775544 (amd64/Linux) - # 2012-09-20: 437618008 (amd64/Linux) - # 2012-10-08: 442768280 (amd64/Linux) - # 2012-11-12: 420105120 (amd64/Linux) - # 2013-06-08: 477593712 (amd64/Linux) (reason unknown) - # 2013-11-21: 502920176 (amd64/Linux) - # 2013-11-22: 541926264 (amd64/Linux) (TH refactoring; weird) - ,(platform('i386-unknown-mingw32'), 278706344, 10) - # 2012-10-30: 220847924 (x86/Windows) - # 2013-02-10: 238529512 (x86/Windows) - # 2013-11-13: 269147084 (x86/Windows, 64bit machine) - # 2014-01-28: 283814088 (x86/Windows) - # 2014-04-04: 278706344 (x86/Windows) - ,(wordsize(32), 284082916, 1)]) - # 2012-08-14: 231064920 (x86/OSX) - # 2013-02-10: 241785276 (x86/Windows) - # 2014-01-22: 278124612 (x86/Linux - new haddock) - # 2014-06-29: 284082916 (x86/Linux) ,stats_num_field('bytes allocated', [(wordsize(64), 29809571376, 10) # 2012-08-14: 26070600504 (amd64/Linux) From git at git.haskell.org Sat Sep 6 15:37:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Sep 2014 15:37:32 +0000 (UTC) Subject: [commit: ghc] master: PostTcType replaced with TypeAnnot (7d3f2df) Message-ID: <20140906153732.8D14324121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7d3f2dfc7a45d741224c521e0f2a616a89f9506f/ghc >--------------------------------------------------------------- commit 7d3f2dfc7a45d741224c521e0f2a616a89f9506f Author: Alan Zimmerman Date: Fri Sep 5 18:11:04 2014 -0500 PostTcType replaced with TypeAnnot Summary: This is a first step toward allowing generic traversals of the AST without 'landmines', by removing the `panic`s located throughout `placeHolderType`, `placeHolderKind` & co. See more on the discussion at https://www.mail-archive.com/ghc-devs at haskell.org/msg05564.html (This also makes a corresponding update to the `haddock` submodule.) Test Plan: `sh validate` and new tests pass. Reviewers: austin, simonpj, goldfire Reviewed By: austin, simonpj, goldfire Subscribers: edsko, Fuuzetsu, thomasw, holzensp, goldfire, simonmar, relrod, ezyang, carter Projects: #ghc Differential Revision: https://phabricator.haskell.org/D157 >--------------------------------------------------------------- 7d3f2dfc7a45d741224c521e0f2a616a89f9506f compiler/deSugar/Check.lhs | 40 +- compiler/deSugar/DsExpr.lhs | 3 +- compiler/ghc.cabal.in | 1 + compiler/ghc.mk | 1 + compiler/hsSyn/Convert.lhs | 36 +- compiler/hsSyn/HsBinds.lhs | 50 ++- compiler/hsSyn/HsDecls.lhs | 108 +++--- compiler/hsSyn/HsExpr.lhs | 160 ++++---- compiler/hsSyn/HsExpr.lhs-boot | 29 +- compiler/hsSyn/HsLit.lhs | 75 ++-- compiler/hsSyn/HsPat.lhs | 37 +- compiler/hsSyn/HsPat.lhs-boot | 15 +- compiler/hsSyn/HsSyn.lhs | 10 +- compiler/hsSyn/HsTypes.lhs | 53 ++- compiler/hsSyn/HsUtils.lhs | 235 +++++++----- compiler/hsSyn/PlaceHolder.hs | 103 ++++++ compiler/parser/Parser.y.pp | 58 +-- compiler/parser/RdrHsSyn.lhs | 11 +- compiler/rename/RnBinds.lhs | 404 +++++++++++---------- compiler/rename/RnExpr.lhs | 22 +- compiler/rename/RnPat.lhs | 17 +- compiler/rename/RnSource.lhs | 3 +- compiler/rename/RnSplice.lhs | 7 +- compiler/rename/RnSplice.lhs-boot | 5 +- compiler/rename/RnTypes.lhs | 7 +- compiler/typecheck/Inst.lhs | 10 +- compiler/typecheck/TcArrows.lhs | 10 +- compiler/typecheck/TcBinds.lhs | 5 +- compiler/typecheck/TcGenDeriv.lhs | 8 +- compiler/typecheck/TcGenGenerics.lhs | 2 +- compiler/typecheck/TcHsType.lhs | 6 +- compiler/typecheck/TcPatSyn.lhs | 2 +- compiler/typecheck/TcRnDriver.lhs | 3 +- compiler/typecheck/TcTyClsDecls.lhs | 10 +- testsuite/tests/ghc-api/landmines/.gitignore | 5 + testsuite/tests/ghc-api/landmines/Makefile | 13 + testsuite/tests/ghc-api/landmines/MineFixity.hs | 23 ++ testsuite/tests/ghc-api/landmines/MineKind.hs | 26 ++ testsuite/tests/ghc-api/landmines/MineNames.hs | 22 ++ testsuite/tests/ghc-api/landmines/MineType.hs | 21 ++ testsuite/tests/ghc-api/landmines/all.T | 2 + testsuite/tests/ghc-api/landmines/landmines.hs | 90 +++++ testsuite/tests/ghc-api/landmines/landmines.stdout | 4 + utils/haddock | 2 +- 44 files changed, 1146 insertions(+), 608 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 7d3f2dfc7a45d741224c521e0f2a616a89f9506f From git at git.haskell.org Sat Sep 6 19:58:17 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Sep 2014 19:58:17 +0000 (UTC) Subject: [commit: ghc] master: Update T4801 perf numbers (5a1def9) Message-ID: <20140906195817.E01FD24121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5a1def9732390b65d51dd0aa2d9d8a6cd7204ed2/ghc >--------------------------------------------------------------- commit 5a1def9732390b65d51dd0aa2d9d8a6cd7204ed2 Author: Joachim Breitner Date: Sat Sep 6 21:57:11 2014 +0200 Update T4801 perf numbers no individual cause indentified, but small improvements happened in 1719c42, 9d6fbcc, 949ad67 (or it is noise...) >--------------------------------------------------------------- 5a1def9732390b65d51dd0aa2d9d8a6cd7204ed2 testsuite/tests/perf/compiler/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 0ac3ad1..29c4a78 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -183,10 +183,11 @@ test('T4801', # prev: 185669232 (x86/OSX) # 2014-01-22: 211198056 (x86/Linux) # 2014-09-03: 185242032 (Windows laptop) - (wordsize(64), 392409984, 10)]), + (wordsize(64), 362939272, 10)]), # prev: 360243576 (amd64/Linux) # 19/10/2012: 447190832 (amd64/Linux) (-fPIC turned on) # 19/10/2012: 392409984 (amd64/Linux) (-fPIC turned off) + # 2014-04-08: 362939272 (amd64/Linux) cumulation of various smaller improvements over recent commits compiler_stats_num_field('max_bytes_used', [(platform('x86_64-apple-darwin'), 25145320, 5), From git at git.haskell.org Sat Sep 6 20:22:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Sep 2014 20:22:02 +0000 (UTC) Subject: [commit: ghc] master: INLINE unfoldr (78209d7) Message-ID: <20140906202202.6D42524121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/78209d70596dcbfcb11ad1de1c961ab8479e531e/ghc >--------------------------------------------------------------- commit 78209d70596dcbfcb11ad1de1c961ab8479e531e Author: Joachim Breitner Date: Sat Sep 6 22:21:54 2014 +0200 INLINE unfoldr Summary: to allow GHC to maybe remove the Maybe. See the code comment for more commentary. This fixes #9369. Test Plan: see what happens on ghcspeed (once it is merged) Reviewers: austin Reviewed By: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D198 GHC Trac Issues: #9369 >--------------------------------------------------------------- 78209d70596dcbfcb11ad1de1c961ab8479e531e libraries/base/Data/List.hs | 37 ++++++++++++++++++++++++++++++++----- 1 file changed, 32 insertions(+), 5 deletions(-) diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs index f813741..f7b58c1 100644 --- a/libraries/base/Data/List.hs +++ b/libraries/base/Data/List.hs @@ -995,11 +995,38 @@ sortOn f = -- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10 -- > [10,9,8,7,6,5,4,3,2,1] -- -unfoldr :: (b -> Maybe (a, b)) -> b -> [a] -unfoldr f b = - case f b of - Just (a,new_b) -> a : unfoldr f new_b - Nothing -> [] + +-- Note [INLINE unfoldr] +-- We treat unfoldr a little differently from some other forms for list fusion +-- for two reasons: +-- +-- 1. We don't want to use a rule to rewrite a basic form to a fusible +-- form because this would inline before constant floating. As Simon Peyton- +-- Jones and others have pointed out, this could reduce sharing in some cases +-- where sharing is beneficial. Thus we simply INLINE it, which is, for +-- example, how enumFromTo::Int becomes eftInt. Unfortunately, we don't seem +-- to get enough of an inlining discount to get a version of eftInt based on +-- unfoldr to inline as readily as the usual one. We know that all the Maybe +-- nonsense will go away, but the compiler does not. +-- +-- 2. The benefit of inlining unfoldr is likely to be huge in many common cases, +-- even apart from list fusion. In particular, inlining unfoldr often +-- allows GHC to erase all the Maybes. This appears to be critical if unfoldr +-- is to be used in high-performance code. A small increase in code size +-- in the relatively rare cases when this does not happen looks like a very +-- small price to pay. +-- +-- Doing a back-and-forth dance doesn't seem to accomplish anything if the +-- final form has to be inlined in any case. + +unfoldr :: (b -> Maybe (a, b)) -> b -> [a] + +{-# INLINE unfoldr #-} -- See Note [INLINE unfoldr] +unfoldr f b0 = build (\c n -> + let go b = case f b of + Just (a, new_b) -> a `c` go new_b + Nothing -> n + in go b0) -- ----------------------------------------------------------------------------- From git at git.haskell.org Sat Sep 6 22:24:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Sep 2014 22:24:34 +0000 (UTC) Subject: [commit: ghc] master: Typos (f0e725a) Message-ID: <20140906222434.834E724121@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f0e725ab762fa62e20b4dac7384b0859626a266f/ghc >--------------------------------------------------------------- commit f0e725ab762fa62e20b4dac7384b0859626a266f Author: Gabor Greif Date: Thu Sep 4 23:00:06 2014 +0200 Typos >--------------------------------------------------------------- f0e725ab762fa62e20b4dac7384b0859626a266f testsuite/tests/perf/compiler/all.T | 2 +- testsuite/tests/perf/haddock/all.T | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 29c4a78..16ab036 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -401,7 +401,7 @@ test('T5642', compiler_stats_num_field('bytes allocated', [(wordsize(32), 753045568, 10), # sample from x86/Linux - # pref: 650000000 + # prev: 650000000 # 2014-09-03: 753045568 (wordsize(64), 1402242360, 10)]) # prev: 1300000000 diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 87f560f..d4dad1d 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -23,7 +23,7 @@ test('haddock.base', # 2013-11-13: 3097751052 (x86/Windows, 64bit machine) # 2014-04-04: 3548581572 (x86/Windows, 64bit machine) # 2014-08-05: XXX TODO UPDATE ME XXX - # 2014-09-03: Windows laptop, no konwn reason + # 2014-09-03: Windows laptop, no known reason ,(wordsize(32), 3799130400, 1)]) # 2012-08-14: 3046487920 (x86/OSX) # 2012-10-30: 2955470952 (x86/Windows) From git at git.haskell.org Mon Sep 8 16:18:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Sep 2014 16:18:56 +0000 (UTC) Subject: [commit: ghc] master: rules: cleanup: use '$way_*suf' var instead of open-coded '($3_way_)s' (049bef7) Message-ID: <20140908161856.CC4E63A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/049bef7dc8858cff1b69002cde91b9d1cdef8e70/ghc >--------------------------------------------------------------- commit 049bef7dc8858cff1b69002cde91b9d1cdef8e70 Author: Sergei Trofimovich Date: Mon Sep 8 19:11:49 2014 +0300 rules: cleanup: use '$way_*suf' var instead of open-coded '($3_way_)s' The changes look like: -$1/$2/build/%.$$($3_way_)s : $1/%.c $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) +$1/$2/build/%.$$($3_ssuf) : $1/%.c $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) This way typos will manifest themselves in all ways, not only non-vanilla. Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 049bef7dc8858cff1b69002cde91b9d1cdef8e70 rules/c-suffix-rules.mk | 10 +++++----- rules/cmm-suffix-rules.mk | 12 ++++++------ rules/hs-suffix-way-rules-srcdir.mk | 8 ++++---- rules/way-prelims.mk | 8 +++++--- 4 files changed, 20 insertions(+), 18 deletions(-) diff --git a/rules/c-suffix-rules.mk b/rules/c-suffix-rules.mk index 8aede2c..9b4e3de 100644 --- a/rules/c-suffix-rules.mk +++ b/rules/c-suffix-rules.mk @@ -27,16 +27,16 @@ $1/$2/build/%.$$($3_osuf) : $1/%.c $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) | $$$$ $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.c $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) $$(call cmd,$1_$2_HC) $$($1_$2_$3_GHC_CC_OPTS) -c $$< -o $$@ -$1/$2/build/%.$$($3_osuf) : $1/$2/build/%.$$($3_way_)s $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) +$1/$2/build/%.$$($3_osuf) : $1/$2/build/%.$$($3_ssuf) $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) $$(call cmd,$1_$2_HC) $$($1_$2_$3_GHC_CC_OPTS) -c $$< -o $$@ $1/$2/build/%.$$($3_osuf) : $1/%.S $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) | $$$$(dir $$$$@)/. $$(call cmd,$1_$2_HC) $$($1_$2_$3_GHC_CC_OPTS) -c $$< -o $$@ -$1/$2/build/%.$$($3_way_)s : $1/$2/build/%.c $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) +$1/$2/build/%.$$($3_ssuf) : $1/$2/build/%.c $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) $$(call cmd,$1_$2_HC) $$($1_$2_$3_GHC_CC_OPTS) -S $$< -o $$@ -$1/$2/build/%.$$($3_way_)s : $1/%.c $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) +$1/$2/build/%.$$($3_ssuf) : $1/%.c $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) $$(call cmd,$1_$2_HC) $$($1_$2_$3_GHC_CC_OPTS) -S $$< -o $$@ else @@ -47,13 +47,13 @@ $1/$2/build/%.$$($3_osuf) : $1/%.c | $$$$(dir $$$$@)/. $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.c $$(call cmd,$1_$2_CC) $$($1_$2_$3_ALL_CC_OPTS) -c $$< -o $$@ -$1/$2/build/%.$$($3_osuf) : $1/$2/build/%.$$($3_way_)s +$1/$2/build/%.$$($3_osuf) : $1/$2/build/%.$$($3_ssuf) $$(call cmd,$1_$2_AS) $$($1_$2_$3_ALL_AS_OPTS) -o $$@ $$< $1/$2/build/%.$$($3_osuf) : $1/%.S | $$$$(dir $$$$@)/. $$(call cmd,$1_$2_CC) $$($1_$2_$3_ALL_CC_OPTS) -c $$< -o $$@ -$1/$2/build/%.$$($3_way_)s : $1/$2/build/%.c +$1/$2/build/%.$$($3_ssuf) : $1/$2/build/%.c $$(call cmd,$1_$2_CC) $$($1_$2_$3_ALL_CC_OPTS) -S $$< -o $$@ endif diff --git a/rules/cmm-suffix-rules.mk b/rules/cmm-suffix-rules.mk index d8f5e6c..2832411 100644 --- a/rules/cmm-suffix-rules.mk +++ b/rules/cmm-suffix-rules.mk @@ -20,16 +20,16 @@ define cmm-suffix-rules ifneq "$$(CLEANING)" "YES" -$1/$2/build/%.$$($3_way_)o : $1/%.cmm $$(rts_H_FILES) $$(includes_H_FILES) $$(includes_DERIVEDCONSTANTS) $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) | $$$$(dir $$$$@)/. +$1/$2/build/%.$$($3_osuf) : $1/%.cmm $$(rts_H_FILES) $$(includes_H_FILES) $$(includes_DERIVEDCONSTANTS) $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) | $$$$(dir $$$$@)/. $$(call cmd,$1_$2_HC) $$($1_$2_$3_MOST_HC_OPTS) -c $$< -o $$@ -$1/$2/build/%.$$($3_way_)o : $1/$2/build/%.cmm $$(rts_H_FILES) $$(includes_H_FILES) $$(includes_DERIVEDCONSTANTS) $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) | $$$$(dir $$$$@)/. +$1/$2/build/%.$$($3_osuf) : $1/$2/build/%.cmm $$(rts_H_FILES) $$(includes_H_FILES) $$(includes_DERIVEDCONSTANTS) $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) | $$$$(dir $$$$@)/. $$(call cmd,$1_$2_HC) $$($1_$2_$3_MOST_HC_OPTS) -c $$< -o $$@ -$1/$2/build/%.$$($3_way_)hc : $1/%.cmm $$(rts_H_FILES) $$(includes_H_FILES) $$(includes_DERIVEDCONSTANTS) $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) | $$$$(dir $$$$@)/. +$1/$2/build/%.$$($3_hcsuf) : $1/%.cmm $$(rts_H_FILES) $$(includes_H_FILES) $$(includes_DERIVEDCONSTANTS) $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) | $$$$(dir $$$$@)/. $$(call cmd,$1_$2_HC) $$($1_$2_$3_MOST_HC_OPTS) -C $$< -o $$@ -$1/$2/build/%.$$($3_way_)hc : $1/$2/build/%.cmm $$(rts_H_FILES) $$(includes_H_FILES) $$(includes_DERIVEDCONSTANTS) $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) | $$$$(dir $$$$@)/. +$1/$2/build/%.$$($3_hcsuf) : $1/$2/build/%.cmm $$(rts_H_FILES) $$(includes_H_FILES) $$(includes_DERIVEDCONSTANTS) $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) | $$$$(dir $$$$@)/. $$(call cmd,$1_$2_HC) $$($1_$2_$3_MOST_HC_OPTS) -C $$< -o $$@ # XXX @@ -40,10 +40,10 @@ $1/$2/build/%.$$($3_way_)hc : $1/$2/build/%.cmm $$(rts_H_FILES) $$(includes_H_FI # so for now they're commented out. They aren't needed, as we can always # go directly to .o files. # -# $1/$2/build/%.$$($3_way_)s : $1/%.cmm $$(rts_H_FILES) $$(includes_H_FILES) $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) | $$$$(dir $$$$@)/. +# $1/$2/build/%.$$($3_ssuf) : $1/%.cmm $$(rts_H_FILES) $$(includes_H_FILES) $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) | $$$$(dir $$$$@)/. # $$(call cmd,$1_$2_HC) $$($1_$2_$3_MOST_HC_OPTS) -S $$< -o $$@ # -# $1/$2/build/%.$$($3_way_)s : $1/$2/build/%.cmm $$(rts_H_FILES) $$(includes_H_FILES) $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) | $$$$(dir $$$$@)/. +# $1/$2/build/%.$$($3_ssuf) : $1/$2/build/%.cmm $$(rts_H_FILES) $$(includes_H_FILES) $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) | $$$$(dir $$$$@)/. # $$(call cmd,$1_$2_HC) $$($1_$2_$3_MOST_HC_OPTS) -S $$< -o $$@ endif diff --git a/rules/hs-suffix-way-rules-srcdir.mk b/rules/hs-suffix-way-rules-srcdir.mk index 8059448..7b6055a 100644 --- a/rules/hs-suffix-way-rules-srcdir.mk +++ b/rules/hs-suffix-way-rules-srcdir.mk @@ -41,21 +41,21 @@ $1/$2/build/%.$$($3_osuf) : $1/$4/%.hc includes/ghcautoconf.h includes/ghcplatfo $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.hc includes/ghcautoconf.h includes/ghcplatform.h $$(call cmd,$1_$2_CC) $$($1_$2_$3_ALL_CC_OPTS) $$(addprefix -I,$$(GHC_INCLUDE_DIRS)) -x c -c $$< -o $$@ $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),-dyno $$(addsuffix .$$(dyn_osuf),$$(basename $$@))) -# $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.$$($3_way_)hc +# $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.$$($3_hcsuf) # $$(call cmd,$1_$2_HC) $$($1_$2_$3_ALL_HC_OPTS) -c $$< -o $$@ # # $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.hc # $$(call cmd,$1_$2_HC) $$($1_$2_$3_ALL_HC_OPTS) -c $$< -o $$@ # -# $1/$2/build/%.$$($3_way_)s : $1/$2/build/%.$$($3_way_)hc +# $1/$2/build/%.$$($3_ssuf) : $1/$2/build/%.$$($3_hcsuf) # $$(call cmd,$1_$2_HC) $$($1_$2_$3_ALL_HC_OPTS) -S $$< -o $$@ # Now the rules for hs-boot files. -$1/$2/build/%.$$($3_way_)o-boot : $1/$4/%.hs-boot $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) $$($1_$2_PKGDATA_DEP) +$1/$2/build/%.$$($3_o-boot) : $1/$4/%.hs-boot $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) $$($1_$2_PKGDATA_DEP) $$(call cmd,$1_$2_HC) $$($1_$2_$3_ALL_HC_OPTS) -c $$< -o $$@ $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),-dyno $$(addsuffix .$$(dyn_osuf)-boot,$$(basename $$@))) -$1/$2/build/%.$$($3_way_)o-boot : $1/$4/%.lhs-boot $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) $$($1_$2_PKGDATA_DEP) +$1/$2/build/%.$$($3_o-boot) : $1/$4/%.lhs-boot $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) $$($1_$2_PKGDATA_DEP) $$(call cmd,$1_$2_HC) $$($1_$2_$3_ALL_HC_OPTS) -c $$< -o $$@ $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),-dyno $$(addsuffix .$$(dyn_osuf)-boot,$$(basename $$@))) # stubs are automatically generated and compiled by GHC diff --git a/rules/way-prelims.mk b/rules/way-prelims.mk index c6c8498..75a23df 100644 --- a/rules/way-prelims.mk +++ b/rules/way-prelims.mk @@ -18,9 +18,11 @@ else $1__way = _$1 $1_way_ = $1_ endif -$1_osuf = $$($1_way_)o -$1_hisuf = $$($1_way_)hi -$1_hcsuf = $$($1_way_)hc +$1_osuf = $$($1_way_)o +$1_o-bootsuf = $$($1_way_)o-boot +$1_hisuf = $$($1_way_)hi +$1_hcsuf = $$($1_way_)hc +$1_ssuf = $$($1_way_)s ifneq "$(findstring dyn,$1)" "" # If the way includes "dyn" then it's a dynamic lib way. We mangle the From git at git.haskell.org Mon Sep 8 16:31:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Sep 2014 16:31:44 +0000 (UTC) Subject: [commit: ghc] master: rules: fix buld failure due to o-boot suffix typo (fdfe6c0) Message-ID: <20140908163144.8CE003A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fdfe6c0e50001add357475a1a3a7627243a28a70/ghc >--------------------------------------------------------------- commit fdfe6c0e50001add357475a1a3a7627243a28a70 Author: Sergei Trofimovich Date: Mon Sep 8 19:29:26 2014 +0300 rules: fix buld failure due to o-boot suffix typo Last-time tweak in commit 049bef7dc8858cff1b69002cde91b9d1cdef8e70 broke build. Update '_o-boot' to '_o-bootsuf' variable name. Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- fdfe6c0e50001add357475a1a3a7627243a28a70 rules/hs-suffix-way-rules-srcdir.mk | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rules/hs-suffix-way-rules-srcdir.mk b/rules/hs-suffix-way-rules-srcdir.mk index 7b6055a..18bf353 100644 --- a/rules/hs-suffix-way-rules-srcdir.mk +++ b/rules/hs-suffix-way-rules-srcdir.mk @@ -52,10 +52,10 @@ $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.hc includes/ghcautoconf.h includes/ghc # Now the rules for hs-boot files. -$1/$2/build/%.$$($3_o-boot) : $1/$4/%.hs-boot $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) $$($1_$2_PKGDATA_DEP) +$1/$2/build/%.$$($3_o-bootsuf) : $1/$4/%.hs-boot $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) $$($1_$2_PKGDATA_DEP) $$(call cmd,$1_$2_HC) $$($1_$2_$3_ALL_HC_OPTS) -c $$< -o $$@ $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),-dyno $$(addsuffix .$$(dyn_osuf)-boot,$$(basename $$@))) -$1/$2/build/%.$$($3_o-boot) : $1/$4/%.lhs-boot $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) $$($1_$2_PKGDATA_DEP) +$1/$2/build/%.$$($3_o-bootsuf) : $1/$4/%.lhs-boot $$(LAX_DEPS_FOLLOW) $$$$($1_$2_HC_DEP) $$($1_$2_PKGDATA_DEP) $$(call cmd,$1_$2_HC) $$($1_$2_$3_ALL_HC_OPTS) -c $$< -o $$@ $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),-dyno $$(addsuffix .$$(dyn_osuf)-boot,$$(basename $$@))) # stubs are automatically generated and compiled by GHC From git at git.haskell.org Tue Sep 9 13:13:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 13:13:55 +0000 (UTC) Subject: [commit: ghc] master: Make Applicative a superclass of Monad (d94de87) Message-ID: <20140909131355.15C843A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d94de87252d0fe2ae97341d186b03a2fbe136b04/ghc >--------------------------------------------------------------- commit d94de87252d0fe2ae97341d186b03a2fbe136b04 Author: Austin Seipp Date: Tue Apr 22 06:09:40 2014 -0500 Make Applicative a superclass of Monad Summary: This includes pretty much all the changes needed to make `Applicative` a superclass of `Monad` finally. There's mostly reshuffling in the interests of avoid orphans and boot files, but luckily we can resolve all of them, pretty much. The only catch was that Alternative/MonadPlus also had to go into Prelude to avoid this. As a result, we must update the hsc2hs and haddock submodules. Signed-off-by: Austin Seipp Test Plan: Build things, they might not explode horribly. Reviewers: hvr, simonmar Subscribers: simonmar Differential Revision: https://phabricator.haskell.org/D13 >--------------------------------------------------------------- d94de87252d0fe2ae97341d186b03a2fbe136b04 aclocal.m4 | 4 +- compiler/cmm/CmmLayoutStack.hs | 4 + compiler/cmm/CmmLint.hs | 4 +- compiler/cmm/PprC.hs | 2 + compiler/codeGen/StgCmmBind.hs | 4 + compiler/codeGen/StgCmmExpr.hs | 4 + compiler/codeGen/StgCmmExtCode.hs | 5 +- compiler/codeGen/StgCmmForeign.hs | 5 + compiler/codeGen/StgCmmHeap.hs | 4 + compiler/codeGen/StgCmmLayout.hs | 4 + compiler/codeGen/StgCmmMonad.hs | 20 +- compiler/codeGen/StgCmmPrim.hs | 4 + compiler/codeGen/StgCmmUtils.hs | 2 +- compiler/coreSyn/CoreLint.lhs | 2 +- compiler/deSugar/Coverage.lhs | 2 +- compiler/deSugar/DsExpr.lhs | 2 +- compiler/deSugar/MatchLit.lhs | 2 +- compiler/ghci/ByteCodeAsm.lhs | 2 + compiler/ghci/ByteCodeGen.lhs | 2 + compiler/hsSyn/Convert.lhs | 3 + compiler/hsSyn/HsBinds.lhs | 7 +- compiler/iface/IfaceSyn.lhs | 34 +-- compiler/iface/LoadIface.lhs | 26 +-- compiler/iface/MkIface.lhs | 4 +- compiler/llvmGen/LlvmCodeGen/Base.hs | 2 + compiler/main/CmdLineParser.hs | 3 +- compiler/main/DriverPipeline.hs | 6 +- compiler/main/ErrUtils.lhs | 4 + compiler/main/Finder.lhs | 14 +- compiler/main/HeaderInfo.hs | 2 +- compiler/main/Packages.lhs | 6 +- compiler/nativeGen/AsmCodeGen.lhs | 10 +- compiler/nativeGen/NCGMonad.hs | 2 + compiler/nativeGen/RegAlloc/Linear/State.hs | 4 +- compiler/parser/Lexer.x | 8 + compiler/parser/RdrHsSyn.lhs | 5 + compiler/prelude/PrelNames.lhs | 14 +- compiler/prelude/PrelRules.lhs | 3 + compiler/profiling/SCCfinal.lhs | 3 +- compiler/rename/RnEnv.lhs | 14 +- compiler/rename/RnExpr.lhs | 2 +- compiler/rename/RnNames.lhs | 8 +- compiler/simplCore/CoreMonad.lhs | 8 +- compiler/specialise/Specialise.lhs | 2 + compiler/stgSyn/StgLint.lhs | 4 +- compiler/typecheck/TcBinds.lhs | 2 +- compiler/typecheck/TcDeriv.lhs | 2 +- compiler/typecheck/TcExpr.lhs | 10 +- compiler/typecheck/TcForeign.lhs | 6 +- compiler/typecheck/TcInstDcls.lhs | 2 +- compiler/typecheck/TcPat.lhs | 2 +- compiler/typecheck/TcRnDriver.lhs | 4 + compiler/typecheck/TcRnMonad.lhs | 6 +- compiler/typecheck/TcTyClsDecls.lhs | 2 +- compiler/typecheck/TcTyDecls.lhs | 4 + compiler/typecheck/TcType.lhs | 2 + compiler/typecheck/TcUnify.lhs | 4 +- compiler/typecheck/TcValidity.lhs | 2 +- compiler/types/Unify.lhs | 2 + compiler/utils/IOEnv.hs | 3 + compiler/utils/Maybes.lhs | 3 + compiler/utils/Stream.hs | 5 +- compiler/vectorise/Vectorise/Exp.hs | 24 +- compiler/vectorise/Vectorise/Type/Env.hs | 2 +- ghc/GhciMonad.hs | 7 +- ghc/InteractiveUI.hs | 3 +- libraries/base/Control/Applicative.hs | 214 +---------------- libraries/base/Control/Arrow.hs | 8 + libraries/base/Control/Monad.hs | 120 ++++------ libraries/base/Control/Monad/ST/Lazy/Imp.hs | 4 + libraries/base/Data/Either.hs | 5 + libraries/base/Data/Maybe.hs | 16 ++ libraries/base/Data/Monoid.hs | 106 +-------- libraries/base/Data/Proxy.hs | 11 + libraries/base/Foreign/Storable.hs | 2 - libraries/base/GHC/Base.lhs | 258 ++++++++++++++++++++- libraries/base/GHC/Conc/Sync.lhs | 12 +- libraries/base/GHC/Event/Array.hs | 2 +- libraries/base/GHC/Event/EPoll.hsc | 1 - libraries/base/GHC/Event/Internal.hs | 1 - libraries/base/GHC/Event/Manager.hs | 3 +- libraries/base/GHC/Event/Poll.hsc | 3 +- libraries/base/GHC/Event/TimerManager.hs | 3 +- libraries/base/GHC/GHCi.hs | 9 +- libraries/base/GHC/ST.lhs | 4 + libraries/base/Prelude.hs | 3 +- libraries/base/Text/ParserCombinators/ReadP.hs | 59 +++-- libraries/base/Text/ParserCombinators/ReadPrec.hs | 11 +- .../template-haskell/Language/Haskell/TH/PprLib.hs | 1 - .../template-haskell/Language/Haskell/TH/Syntax.hs | 4 +- mk/validate-settings.mk | 8 +- testsuite/tests/deriving/should_fail/T3621.hs | 4 +- testsuite/tests/deriving/should_fail/T3621.stderr | 2 +- testsuite/tests/deriving/should_run/drvrun019.hs | 2 +- testsuite/tests/ghci/scripts/T4175.stdout | 1 + testsuite/tests/ghci/scripts/T7627.stdout | 2 + testsuite/tests/ghci/scripts/T8535.stdout | 3 +- testsuite/tests/ghci/scripts/ghci011.stdout | 3 + testsuite/tests/ghci/scripts/ghci020.stdout | 1 + testsuite/tests/ghci/scripts/ghci025.stdout | 5 +- testsuite/tests/ghci/scripts/ghci027.stdout | 4 +- testsuite/tests/indexed-types/should_fail/T4485.hs | 6 +- .../tests/indexed-types/should_fail/T4485.stderr | 8 +- testsuite/tests/indexed-types/should_fail/T7729.hs | 8 + .../tests/indexed-types/should_fail/T7729.stderr | 6 +- .../tests/indexed-types/should_fail/T7729a.hs | 8 + .../tests/indexed-types/should_fail/T7729a.stderr | 8 +- testsuite/tests/mdo/should_compile/mdo002.hs | 8 + .../tests/parser/should_compile/T7476/T7476.stdout | 2 +- testsuite/tests/perf/compiler/all.T | 17 +- testsuite/tests/perf/haddock/all.T | 6 +- testsuite/tests/polykinds/MonoidsFD.hs | 6 +- testsuite/tests/polykinds/MonoidsTF.hs | 6 +- testsuite/tests/rebindable/rebindable2.hs | 12 +- testsuite/tests/rename/should_compile/T1954.hs | 2 - testsuite/tests/rename/should_compile/T7145a.hs | 1 - .../tests/rename/should_compile/T7145b.stderr | 2 +- testsuite/tests/rename/should_fail/T2993.stderr | 4 +- .../tests/simplCore/should_compile/T8848.stderr | 6 +- .../tests/simplCore/should_compile/simpl017.hs | 11 + .../tests/simplCore/should_compile/simpl017.stderr | 26 +-- testsuite/tests/simplCore/should_run/T3591.hs | 18 +- testsuite/tests/typecheck/should_compile/T4524.hs | 13 +- testsuite/tests/typecheck/should_compile/T4969.hs | 9 +- testsuite/tests/typecheck/should_compile/tc213.hs | 2 +- utils/ghc-pkg/Main.hs | 2 + utils/haddock | 2 +- utils/hsc2hs | 2 +- 128 files changed, 848 insertions(+), 621 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 d94de87252d0fe2ae97341d186b03a2fbe136b04 From git at git.haskell.org Tue Sep 9 13:19:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 13:19:04 +0000 (UTC) Subject: [commit: ghc] master: base: Bump version to 4.8.0.0 (0829f4c) Message-ID: <20140909131904.679443A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0829f4c829a92d1287b820b12102a64dac91d35a/ghc >--------------------------------------------------------------- commit 0829f4c829a92d1287b820b12102a64dac91d35a Author: Austin Seipp Date: Tue Sep 9 08:18:56 2014 -0500 base: Bump version to 4.8.0.0 Signed-off-by: Austin Seipp >--------------------------------------------------------------- 0829f4c829a92d1287b820b12102a64dac91d35a libraries/base/base.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index b7828a9..dd4c9a4 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -1,5 +1,5 @@ name: base -version: 4.7.1.0 +version: 4.8.0.0 -- GHC 7.6.1 released with 4.6.0.0 license: BSD3 license-file: LICENSE From git at git.haskell.org Tue Sep 9 13:51:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 13:51:34 +0000 (UTC) Subject: [commit: ghc] master: Revert "base: Bump version to 4.8.0.0" (27a642c) Message-ID: <20140909135134.4B36B3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/27a642cc3a448c5b9bb0774d413f27aef0c63379/ghc >--------------------------------------------------------------- commit 27a642cc3a448c5b9bb0774d413f27aef0c63379 Author: Austin Seipp Date: Tue Sep 9 08:51:04 2014 -0500 Revert "base: Bump version to 4.8.0.0" This reverts commit 0829f4c829a92d1287b820b12102a64dac91d35a. This fails to build, because I'm dumb and hasty, obviously. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 27a642cc3a448c5b9bb0774d413f27aef0c63379 libraries/base/base.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index dd4c9a4..b7828a9 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -1,5 +1,5 @@ name: base -version: 4.8.0.0 +version: 4.7.1.0 -- GHC 7.6.1 released with 4.6.0.0 license: BSD3 license-file: LICENSE From git at git.haskell.org Tue Sep 9 14:15:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 14:15:08 +0000 (UTC) Subject: [commit: packages/array] master: Bump `base` constraint and convert changelog to MD (bfb4885) Message-ID: <20140909141508.DA9123A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/array On branch : master Link : http://git.haskell.org/packages/array.git/commitdiff/bfb488592cf5c92a6970eff64b9495970464014b >--------------------------------------------------------------- commit bfb488592cf5c92a6970eff64b9495970464014b Author: Herbert Valerio Riedel Date: Tue Sep 9 16:13:17 2014 +0200 Bump `base` constraint and convert changelog to MD >--------------------------------------------------------------- bfb488592cf5c92a6970eff64b9495970464014b array.cabal | 13 ++++--------- changelog | 23 ----------------------- changelog.md | 30 ++++++++++++++++++++++++++++++ 3 files changed, 34 insertions(+), 32 deletions(-) diff --git a/array.cabal b/array.cabal index 68e826e..c6b732d 100644 --- a/array.cabal +++ b/array.cabal @@ -1,6 +1,6 @@ name: array -version: 0.5.0.0 --- GHC 7.6.1 released with 0.4.0.1 +version: 0.5.0.1 +-- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE maintainer: libraries at haskell.org @@ -17,17 +17,12 @@ description: immutable arrays and 'MArray' of arrays mutable within appropriate monads, as well as some instances of these classes. -extra-source-files: changelog +extra-source-files: changelog.md source-repository head type: git location: http://git.haskell.org/packages/array.git -source-repository this - type: git - location: http://git.haskell.org/packages/array.git - tag: array-0.5.0.0-release - library default-language: Haskell2010 other-extensions: @@ -42,7 +37,7 @@ library Trustworthy, UnboxedTuples, UnliftedFFITypes - build-depends: base >= 4.5 && < 4.8 + build-depends: base >= 4.5 && < 4.9 ghc-options: -Wall exposed-modules: Data.Array diff --git a/changelog b/changelog deleted file mode 100644 index 6654c9f..0000000 --- a/changelog +++ /dev/null @@ -1,23 +0,0 @@ --*-change-log-*- - -0.5.0.0 Nov 2013 - * Update to Cabal 1.10 format - * Remove NHC and Hugs specific code - * Remove deprecated function exports `Data.Array.IO.castIOUArray`, - `Data.Array.MArray.unsafeFreeze`, `Data.Array.MArray.unsafeThaw`, - and `Data.Array.ST.castSTUArray`; These functions are still - available from the "Data.Array.Unsafe" module. - -0.4.0.1 Sep 2012 - * Bundled with GHC 7.6.1 - * Fix inline rule shadowing warnings - -0.4.0.0 Feb 2012 - * Bundled with GHC 7.4.1 - * Add support for SafeHaskell - * New "Data.Array.IO.Safe" module - * New "Data.Array.MArray.safe" module - * New "Data.Array.ST.safe" module - * New "Data.Array.Storable.Internals" module - * New "Data.Array.Storable.Safe" module - * New "Data.Array.Unsafe" module diff --git a/changelog.md b/changelog.md new file mode 100644 index 0000000..5a04388 --- /dev/null +++ b/changelog.md @@ -0,0 +1,30 @@ +# Changelog for [`array` package](http://hackage.haskell.org/package/array) + +## 0.5.0.1 *TBA* + + * Bundled with GHC 7.10.1 + +## 0.5.0.0 *Nov 2013* + + * Update to Cabal 1.10 format + * Remove NHC and Hugs specific code + * Remove deprecated function exports `Data.Array.IO.castIOUArray`, + `Data.Array.MArray.unsafeFreeze`, `Data.Array.MArray.unsafeThaw`, + and `Data.Array.ST.castSTUArray`; These functions are still + available from the `Data.Array.Unsafe` module. + +## 0.4.0.1 *Sep 2012* + + * Bundled with GHC 7.6.1 + * Fix inline rule shadowing warnings + +## 0.4.0.0 *Feb 2012* + + * Bundled with GHC 7.4.1 + * Add support for SafeHaskell + * New `Data.Array.IO.Safe` module + * New `Data.Array.MArray.safe` module + * New `Data.Array.ST.safe` module + * New `Data.Array.Storable.Internals` module + * New `Data.Array.Storable.Safe` module + * New `Data.Array.Unsafe` module From git at git.haskell.org Tue Sep 9 14:25:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 14:25:22 +0000 (UTC) Subject: [commit: packages/deepseq] master: Bump `base` constraint and convert changelog to MD (3815fe8) Message-ID: <20140909142522.659F43A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/deepseq On branch : master Link : http://git.haskell.org/packages/deepseq.git/commitdiff/3815fe819ba465159cc618b3521adcba97e3c0d1 >--------------------------------------------------------------- commit 3815fe819ba465159cc618b3521adcba97e3c0d1 Author: Herbert Valerio Riedel Date: Tue Sep 9 16:24:42 2014 +0200 Bump `base` constraint and convert changelog to MD >--------------------------------------------------------------- 3815fe819ba465159cc618b3521adcba97e3c0d1 changelog => changelog.md | 34 ++++++++++++++++++++++++---------- deepseq.cabal | 6 +++--- 2 files changed, 27 insertions(+), 13 deletions(-) diff --git a/changelog b/changelog.md similarity index 62% rename from changelog rename to changelog.md index 9c3286d..10ef7cc 100644 --- a/changelog +++ b/changelog.md @@ -1,35 +1,49 @@ --*-change-log-*- +# Changelog for [`deepseq` package](http://hackage.haskell.org/package/deepseq) -1.3.0.2 Nov 2013 +## 1.3.0.3 *TBA* + + * Bundled with GHC 7.10 + +## 1.3.0.2 *Nov 2013* + + * Bundled with GHC 7.8.1 * Update package description to Cabal 1.10 format * Add support for GHC 7.8 * Drop support for GHCs older than GHC 7.0.1 * Add `/since: .../` annotations to Haddock comments * Add changelog -1.3.0.1 Sep 2012 +## 1.3.0.1 *Sep 2012* + * No changes -1.3.0.0 Feb 2012 +## 1.3.0.0 *Feb 2012* + * Add instances for `Fixed`, `a->b` and `Version` -1.2.0.1 Sep 2011 +## 1.2.0.1 *Sep 2011* + * Disable SafeHaskell for GHC 7.2 -1.2.0.0 Sep 2011 +## 1.2.0.0 *Sep 2011* + * New function `force` * New operator `$!!` * Add SafeHaskell support * Dropped dependency on containers -1.1.0.2 Nov 2010 +## 1.1.0.2 *Nov 2010* + * Improve Haddock documentation -1.1.0.1 Oct 2010 +## 1.1.0.1 *Oct 2010* + * Enable support for containers-0.4.x -1.1.0.0 Nov 2009 +## 1.1.0.0 *Nov 2009* + * Major rewrite -1.0.0.0 Nov 2009 +## 1.0.0.0 *Nov 2009* + * Initial release diff --git a/deepseq.cabal b/deepseq.cabal index 0793123..e043ca1 100644 --- a/deepseq.cabal +++ b/deepseq.cabal @@ -1,6 +1,6 @@ name: deepseq -version: 1.3.0.2 --- GHC 7.6.1 released with 1.3.0.1 +version: 1.3.0.3 +-- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE maintainer: libraries at haskell.org @@ -45,6 +45,6 @@ library if impl(ghc >= 7.2) other-extensions: Safe exposed-modules: Control.DeepSeq - build-depends: base >= 4.3 && < 4.8, + build-depends: base >= 4.3 && < 4.9, array >= 0.3 && < 0.6 ghc-options: -Wall From git at git.haskell.org Tue Sep 9 14:40:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 14:40:22 +0000 (UTC) Subject: [commit: packages/filepath] master: Bump `base` constraint (7011e20) Message-ID: <20140909144022.77E2C3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/filepath On branch : master Link : http://git.haskell.org/packages/filepath.git/commitdiff/7011e20dbe30f96f34f6cfb1fd3f3aad9e7a6534 >--------------------------------------------------------------- commit 7011e20dbe30f96f34f6cfb1fd3f3aad9e7a6534 Author: Herbert Valerio Riedel Date: Tue Sep 9 16:38:57 2014 +0200 Bump `base` constraint ...and update cabal meta-info while at it >--------------------------------------------------------------- 7011e20dbe30f96f34f6cfb1fd3f3aad9e7a6534 changelog.md | 4 ++++ filepath.cabal | 15 +++++---------- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/changelog.md b/changelog.md index ef3eb46..2feaf5a 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ # Changelog for [`filepath` package](http://hackage.haskell.org/package/filepath) +## 1.3.0.3 *TBA* + + * Bundled with GHC 7.10.1 + ## 1.3.0.2 *Mar 2014* * Bundled with GHC 7.8.1 diff --git a/filepath.cabal b/filepath.cabal index c510089..37f1de0 100644 --- a/filepath.cabal +++ b/filepath.cabal @@ -1,11 +1,11 @@ Name: filepath -Version: 1.3.0.2 --- GHC 7.6.1 released with 1.3.0.1 +Version: 1.3.0.3 +-- NOTE: Don't forget to update ./changelog.md License: BSD3 license-file: LICENSE Author: Neil Mitchell Maintainer: libraries at haskell.org -bug-reports: http://ghc.haskell.org/trac/ghc/newticket?component=libraries%20%28other%29&keywords=filepath +bug-reports: https://github.com/haskell/filepath/issues Homepage: http://www-users.cs.york.ac.uk/~ndm/filepath/ Category: System build-type: Simple @@ -38,7 +38,7 @@ Library System.FilePath.Windows Build-Depends: - base >= 4 && < 4.8 + base >= 4 && < 4.9 ghc-options: -Wall @@ -60,9 +60,4 @@ Test-Suite filepath-tests source-repository head type: git - location: http://git.haskell.org/packages/filepath.git - -source-repository this - type: git - location: http://git.haskell.org/packages/filepath.git - tag: filepath-1.3.0.2-release + location: https://github.com/haskell/filepath.git \ No newline at end of file From git at git.haskell.org Tue Sep 9 15:01:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 15:01:29 +0000 (UTC) Subject: [commit: packages/haskell2010] master: Bump `base` constraint (acf64b6) Message-ID: <20140909150129.71C083A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell2010 On branch : master Link : http://git.haskell.org/packages/haskell2010.git/commitdiff/acf64b69b05aab78d67461facaf83d4473c05959 >--------------------------------------------------------------- commit acf64b69b05aab78d67461facaf83d4473c05959 Author: Herbert Valerio Riedel Date: Tue Sep 9 16:59:13 2014 +0200 Bump `base` constraint >--------------------------------------------------------------- acf64b69b05aab78d67461facaf83d4473c05959 changelog.md | 4 ++++ haskell2010.cabal | 11 +++-------- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/changelog.md b/changelog.md index 87d0012..de2739a 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ # Changelog for [`haskell2010` package](http://hackage.haskell.org/package/haskell2010) +## 1.1.2.1 *TBA* + + - Bundled with GHC 7.10.1 + ## 1.1.2.0 *Mar 2014* - Bundled with GHC 7.8.1 diff --git a/haskell2010.cabal b/haskell2010.cabal index 4cc8167..cb8d539 100644 --- a/haskell2010.cabal +++ b/haskell2010.cabal @@ -1,6 +1,6 @@ name: haskell2010 -version: 1.1.2.0 --- GHC 7.6.1 released with 1.1.1.0 +version: 1.1.2.1 +-- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE maintainer: libraries at haskell.org @@ -21,11 +21,6 @@ source-repository head type: git location: http://git.haskell.org/packages/haskell2010.git -source-repository this - type: git - location: http://git.haskell.org/packages/haskell2010.git - tag: haskell2010-1.1.2.0-release - Library default-language: Haskell2010 other-extensions: @@ -39,7 +34,7 @@ Library build-depends: array >= 0.5 && < 0.6, - base >= 4.7 && < 4.8 + base >= 4.7 && < 4.9 -- this hack adds a dependency on ghc-prim for Haddock. The GHC -- build system doesn't seem to track transitive dependencies when From git at git.haskell.org Tue Sep 9 15:03:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 15:03:26 +0000 (UTC) Subject: [commit: packages/haskell98] master: Bump `base` constraint (737333d) Message-ID: <20140909150326.530573A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell98 On branch : master Link : http://git.haskell.org/packages/haskell98.git/commitdiff/737333db1a8eaed9312268e02bade5344d175d05 >--------------------------------------------------------------- commit 737333db1a8eaed9312268e02bade5344d175d05 Author: Herbert Valerio Riedel Date: Tue Sep 9 17:02:51 2014 +0200 Bump `base` constraint >--------------------------------------------------------------- 737333db1a8eaed9312268e02bade5344d175d05 changelog.md | 4 ++++ haskell98.cabal | 11 +++-------- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/changelog.md b/changelog.md index 4509de5..0fec6a3 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ # Changelog for [`haskell98` package](http://hackage.haskell.org/package/haskell98) +## 2.0.0.4 *TBA* + + - Bundled with GHC 7.10.1 + ## 2.0.0.3 *Mar 2014* - Bundled with GHC 7.8.1 diff --git a/haskell98.cabal b/haskell98.cabal index 8a22c65..e28430d 100644 --- a/haskell98.cabal +++ b/haskell98.cabal @@ -1,6 +1,6 @@ name: haskell98 -version: 2.0.0.3 --- GHC 7.6.1 released with 2.0.0.2 +version: 2.0.0.4 +-- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE maintainer: libraries at haskell.org @@ -24,11 +24,6 @@ source-repository head type: git location: http://git.haskell.org/packages/haskell98.git -source-repository this - type: git - location: http://git.haskell.org/packages/haskell98.git - tag: haskell98-2.0.0.3-release - Library default-language: Haskell98 other-extensions: @@ -43,7 +38,7 @@ Library build-depends: array >= 0.5 && < 0.6, - base >= 4.7 && < 4.8, + base >= 4.7 && < 4.9, directory >= 1.2 && < 1.3, old-locale >= 1.0 && < 1.1, old-time >= 1.1 && < 1.2, From git at git.haskell.org Tue Sep 9 15:09:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 15:09:29 +0000 (UTC) Subject: [commit: packages/hoopl] master: Bump `base` constraint (7f06b16) Message-ID: <20140909150929.157F63A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hoopl On branch : master Link : http://git.haskell.org/packages/hoopl.git/commitdiff/7f06b16ba3a49c2c927fb06fe7dc89089dd7e29f >--------------------------------------------------------------- commit 7f06b16ba3a49c2c927fb06fe7dc89089dd7e29f Author: Herbert Valerio Riedel Date: Tue Sep 9 17:08:27 2014 +0200 Bump `base` constraint ...and update cabal meta-info while at it >--------------------------------------------------------------- 7f06b16ba3a49c2c927fb06fe7dc89089dd7e29f changelog.md | 4 ++++ hoopl.cabal | 18 +++--------------- 2 files changed, 7 insertions(+), 15 deletions(-) diff --git a/changelog.md b/changelog.md index deff9b2..234c993 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ # Changelog for [`hoopl` package](http://hackage.haskell.org/package/hoopl) +## 3.10.0.2 *TBA* + + - Add support for `base-4.8.0.0` package version + ## 3.10.0.1 *Mar 2014* - Remove UTF8 character from hoopl.cabal to workaround issue diff --git a/hoopl.cabal b/hoopl.cabal index d73b61c..d487d49 100644 --- a/hoopl.cabal +++ b/hoopl.cabal @@ -1,13 +1,6 @@ Name: hoopl -Version: 3.10.0.1 --- NOTE: Don't forget to update 'repository this' tag when incrementing version! --- GHC 7.6.1 released with 3.9.0.0 --- version 3.8.6.0 is the version that goes with the camera-ready Haskell'10 paper --- version 3.8.7.0 works with GHC 7 --- version 3.8.7.1 adds some unnamed functions without breaking compatibility --- version 3.8.7.2 adds Compiler.Hoopl.Fuel.liftFuel --- version 3.8.7.4 re-exports runWithFuel --- version 3.9.0.0 adds the new API for working with blocks, and lots of internal refactoring +Version: 3.10.0.2 +-- NOTE: Don't forget to update ./changelog.md Description: Higher-order optimization library . @@ -31,11 +24,6 @@ Source-repository head Type: git Location: http://git.haskell.org/packages/hoopl.git -Source-repository this - Type: git - Location: http://git.haskell.org/packages/hoopl.git - Tag: hoopl-3.10.0.1-release - Library Default-Language: Haskell2010 Other-Extensions: CPP @@ -52,7 +40,7 @@ Library Other-Extensions: Safe Trustworthy Hs-Source-Dirs: src - Build-Depends: base >= 4.3 && < 4.8, containers >= 0.4 && < 0.6 + Build-Depends: base >= 4.3 && < 4.9, containers >= 0.4 && < 0.6 Exposed-Modules: Compiler.Hoopl, Compiler.Hoopl.Internals, Compiler.Hoopl.Wrappers, From git at git.haskell.org Tue Sep 9 15:12:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 15:12:07 +0000 (UTC) Subject: [commit: packages/hpc] master: Bump `base` constraint (79eaff2) Message-ID: <20140909151207.F3DFA3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/79eaff2567872279fd916e52f0c39de5e6370b59 >--------------------------------------------------------------- commit 79eaff2567872279fd916e52f0c39de5e6370b59 Author: Herbert Valerio Riedel Date: Tue Sep 9 17:10:44 2014 +0200 Bump `base` constraint >--------------------------------------------------------------- 79eaff2567872279fd916e52f0c39de5e6370b59 changelog.md | 4 ++++ hpc.cabal | 11 +++-------- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/changelog.md b/changelog.md index 65446bc..1bd2a96 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ # Changelog for [`hpc` package](http://hackage.haskell.org/package/hpc) +## 0.6.0.2 *TBA* + + * Bundled with GHC 7.10.1 + ## 0.6.0.1 *Mar 2014* * Bundled with GHC 7.8.1 diff --git a/hpc.cabal b/hpc.cabal index 42e4d3b..0ea97db 100644 --- a/hpc.cabal +++ b/hpc.cabal @@ -1,6 +1,6 @@ name: hpc -version: 0.6.0.1 --- GHC 7.6.1 released with 0.6.0.0 +version: 0.6.0.2 +-- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE author: Andy Gill @@ -24,11 +24,6 @@ source-repository head type: git location: http://git.haskell.org/packages/hpc.git -source-repository this - type: git - location: http://git.haskell.org/packages/hpc.git - tag: hpc-0.6.0.1-release - Library default-language: Haskell98 other-extensions: CPP @@ -40,7 +35,7 @@ Library Trace.Hpc.Reflect Build-Depends: - base >= 4.4.1 && < 4.8, + base >= 4.4.1 && < 4.9, containers >= 0.4.1 && < 0.6, directory >= 1.1 && < 1.3, time >= 1.2 && < 1.5 From git at git.haskell.org Tue Sep 9 15:14:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 15:14:56 +0000 (UTC) Subject: [commit: ghc] wip/new-flatten-skolems-Aug14: More wip on flatten-skolems (c19b6a3) Message-ID: <20140909151456.2D7283A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/new-flatten-skolems-Aug14 Link : http://ghc.haskell.org/trac/ghc/changeset/c19b6a36b76521968a672375ae0231f4c3fc5171/ghc >--------------------------------------------------------------- commit c19b6a36b76521968a672375ae0231f4c3fc5171 Author: Simon Peyton Jones Date: Tue Sep 9 16:09:44 2014 +0100 More wip on flatten-skolems >--------------------------------------------------------------- c19b6a36b76521968a672375ae0231f4c3fc5171 compiler/typecheck/TcCanonical.lhs | 28 +-- compiler/typecheck/TcHsSyn.lhs | 2 +- compiler/typecheck/TcHsType.lhs | 9 +- compiler/typecheck/TcInteract.lhs | 255 +++++++++++---------- compiler/typecheck/TcMType.lhs | 3 +- compiler/typecheck/TcRnTypes.lhs | 9 +- compiler/typecheck/TcRules.lhs | 2 + compiler/typecheck/TcSMonad.lhs | 238 ++++++++++++------- compiler/typecheck/TcSimplify.lhs | 57 ++++- compiler/typecheck/TcType.lhs | 21 +- compiler/typecheck/TcUnify.lhs | 7 +- .../indexed-types/should_compile/T3017.stderr | 2 +- .../tests/indexed-types/should_compile/T3826.hs | 14 +- .../tests/indexed-types/should_compile/T7804.hs | 12 + .../typecheck/should_fail/ContextStack2.stderr | 7 +- testsuite/tests/typecheck/should_fail/T8142.stderr | 4 +- 16 files changed, 416 insertions(+), 254 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 c19b6a36b76521968a672375ae0231f4c3fc5171 From git at git.haskell.org Tue Sep 9 15:18:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 15:18:12 +0000 (UTC) Subject: [commit: packages/old-locale] master: Bump `base` constraint (6a0f699) Message-ID: <20140909151812.88EF53A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/old-locale On branch : master Link : http://git.haskell.org/packages/old-locale.git/commitdiff/6a0f699014a61c23e84036a6fcce97ecc8562342 >--------------------------------------------------------------- commit 6a0f699014a61c23e84036a6fcce97ecc8562342 Author: Herbert Valerio Riedel Date: Tue Sep 9 17:17:58 2014 +0200 Bump `base` constraint >--------------------------------------------------------------- 6a0f699014a61c23e84036a6fcce97ecc8562342 changelog.md | 4 ++++ old-locale.cabal | 6 +++--- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/changelog.md b/changelog.md index 65ba802..955fa7b 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ # Changelog for [`old-locale` package](http://hackage.haskell.org/package/old-locale) +## 1.0.0.7 *TBA* + + * Bundled with GHC 7.10.1 + ## 1.0.0.6 *Mar 2014* * Bundled with GHC 7.8.1 diff --git a/old-locale.cabal b/old-locale.cabal index e535fe1..cbc1ced 100644 --- a/old-locale.cabal +++ b/old-locale.cabal @@ -1,6 +1,6 @@ name: old-locale -version: 1.0.0.6 --- GHC 7.6.1 released with 1.0.0.5 +version: 1.0.0.7 +-- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE maintainer: libraries at haskell.org @@ -35,5 +35,5 @@ Library exposed-modules: System.Locale - build-depends: base >= 4.2 && < 4.8 + build-depends: base >= 4.2 && < 4.9 ghc-options: -Wall From git at git.haskell.org Tue Sep 9 15:18:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 15:18:35 +0000 (UTC) Subject: [commit: packages/old-time] master: Bump `base` constraint (6a13541) Message-ID: <20140909151835.612643A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/old-time On branch : master Link : http://git.haskell.org/packages/old-time.git/commitdiff/6a13541b3fff7ff59a17689efaed0818bf87a6e4 >--------------------------------------------------------------- commit 6a13541b3fff7ff59a17689efaed0818bf87a6e4 Author: Herbert Valerio Riedel Date: Tue Sep 9 17:16:10 2014 +0200 Bump `base` constraint >--------------------------------------------------------------- 6a13541b3fff7ff59a17689efaed0818bf87a6e4 changelog.md | 4 ++++ old-time.cabal | 11 +++-------- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/changelog.md b/changelog.md index 155acf7..e612213 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ # Changelog for [`old-time` package](http://hackage.haskell.org/package/old-time) +## 1.1.0.3 *TBA* + + * Bundled with GHC 7.10.1 + ## 1.1.0.2 *Mar 2014* * Bundled with GHC 7.8.1 diff --git a/old-time.cabal b/old-time.cabal index 1d99557..9c85da7 100644 --- a/old-time.cabal +++ b/old-time.cabal @@ -1,6 +1,6 @@ name: old-time -version: 1.1.0.2 --- GHC 7.6.1 released with 1.1.0.1 +version: 1.1.0.3 +-- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE maintainer: libraries at haskell.org @@ -37,11 +37,6 @@ source-repository head type: git location: http://git.haskell.org/packages/old-time.git -source-repository this - type: git - location: http://git.haskell.org/packages/old-time.git - tag: old-time-1.1.0.2-release - Library default-language: Haskell2010 other-extensions: Trustworthy @@ -58,7 +53,7 @@ Library HsTime.h build-depends: - base == 4.7.*, + base >= 4.7 && < 4.9, old-locale == 1.0.* ghc-options: -Wall From git at git.haskell.org Tue Sep 9 15:21:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 15:21:19 +0000 (UTC) Subject: [commit: packages/parallel] master: Bump `base` constraint and convert changelog to MD (94e1aa6) Message-ID: <20140909152119.08F8E3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/parallel On branch : master Link : http://git.haskell.org/packages/parallel.git/commitdiff/94e1aa6f621df464c237c9987bb7f65bd4cb5ff1 >--------------------------------------------------------------- commit 94e1aa6f621df464c237c9987bb7f65bd4cb5ff1 Author: Herbert Valerio Riedel Date: Tue Sep 9 17:20:52 2014 +0200 Bump `base` constraint and convert changelog to MD >--------------------------------------------------------------- 94e1aa6f621df464c237c9987bb7f65bd4cb5ff1 changelog | 8 -------- changelog.md | 13 +++++++++++++ parallel.cabal | 10 +++------- 3 files changed, 16 insertions(+), 15 deletions(-) diff --git a/changelog b/changelog deleted file mode 100644 index 47d98ce..0000000 --- a/changelog +++ /dev/null @@ -1,8 +0,0 @@ --*-change-log-*- - -3.2.0.4 Nov 2013 - * Update package description to Cabal 1.10 format - * Add support for GHC 7.8 - * Drop support for GHCs older than GHC 7.0.1 - * Add NOINLINE pragmas to `parBuffer`, `parList`, and `evalBuffer` - to make RULEs more likely to fire diff --git a/changelog.md b/changelog.md new file mode 100644 index 0000000..fce3072 --- /dev/null +++ b/changelog.md @@ -0,0 +1,13 @@ +# Changelog for [`parallel` package](http://hackage.haskell.org/package/parallel) + +## 3.2.0.5 *TBA* + + - Support `base-4.8.0.0` + +## 3.2.0.4 *Nov 2013* + + * Update package description to Cabal 1.10 format + * Add support for GHC 7.8 + * Drop support for GHCs older than GHC 7.0.1 + * Add NOINLINE pragmas to `parBuffer`, `parList`, and `evalBuffer` + to make RULEs more likely to fire diff --git a/parallel.cabal b/parallel.cabal index 1906333..38c3293 100644 --- a/parallel.cabal +++ b/parallel.cabal @@ -1,5 +1,6 @@ name: parallel -version: 3.2.0.4 +version: 3.2.0.5 +-- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE maintainer: libraries at haskell.org @@ -17,11 +18,6 @@ source-repository head type: git location: http://git.haskell.org/packages/parallel.git -source-repository this - type: git - location: http://git.haskell.org/packages/parallel.git - tag: parallel-3.2.0.4-release - library default-language: Haskell2010 other-extensions: @@ -38,7 +34,7 @@ library build-depends: array >= 0.3 && < 0.6, - base >= 4.3 && < 4.8, + base >= 4.3 && < 4.9, containers >= 0.4 && < 0.6, deepseq >= 1.1 && < 1.4 From git at git.haskell.org Tue Sep 9 15:34:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 15:34:59 +0000 (UTC) Subject: [commit: packages/stm] master: Bump `base` constraint for AMP (40fd6d8) Message-ID: <20140909153459.0A57B3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/stm On branch : master Link : http://git.haskell.org/packages/stm.git/commitdiff/40fd6d88f75c31b66419ab93f436225c9403846c >--------------------------------------------------------------- commit 40fd6d88f75c31b66419ab93f436225c9403846c Author: Herbert Valerio Riedel Date: Tue Sep 9 17:34:28 2014 +0200 Bump `base` constraint for AMP >--------------------------------------------------------------- 40fd6d88f75c31b66419ab93f436225c9403846c changelog.md | 4 ++++ stm.cabal | 9 ++------- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/changelog.md b/changelog.md index 8feaa2f..faf959b 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ # Changelog for [`stm` package](http://hackage.haskell.org/package/stm) +## 2.4.3.1 *TBA* + + * Add support for `base-4.8.0.0` + ## 2.4.3 *Mar 2014* * Update behaviour of `newBroadcastTChanIO` to match diff --git a/stm.cabal b/stm.cabal index 9313ced..5ea002a 100644 --- a/stm.cabal +++ b/stm.cabal @@ -1,5 +1,5 @@ name: stm -version: 2.4.3 +version: 2.4.3.1 license: BSD3 license-file: LICENSE maintainer: libraries at haskell.org @@ -18,11 +18,6 @@ source-repository head type: git location: http://git.haskell.org/packages/stm.git -source-repository this - type: git - location: http://git.haskell.org/packages/stm.git - tag: stm-2.4.3-release - library default-language: Haskell98 other-extensions: @@ -36,7 +31,7 @@ library other-extensions: Trustworthy build-depends: - base >= 4.2 && < 4.8, + base >= 4.2 && < 4.9, array >= 0.3 && < 0.6 exposed-modules: From git at git.haskell.org Tue Sep 9 16:30:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 16:30:10 +0000 (UTC) Subject: [commit: ghc] branch 'origin/wip/new-flatten-skolems-Aug14' created Message-ID: <20140909163010.23DA93A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : origin/wip/new-flatten-skolems-Aug14 Referencing: 84b34639ae19ce5c04f93dfead4d40f0349b8d09 From git at git.haskell.org Tue Sep 9 16:30:12 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 16:30:12 +0000 (UTC) Subject: [commit: ghc] origin/wip/new-flatten-skolems-Aug14: More wip on flatten-skolems (84b3463) Message-ID: <20140909163012.AF95B3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : origin/wip/new-flatten-skolems-Aug14 Link : http://ghc.haskell.org/trac/ghc/changeset/84b34639ae19ce5c04f93dfead4d40f0349b8d09/ghc >--------------------------------------------------------------- commit 84b34639ae19ce5c04f93dfead4d40f0349b8d09 Author: Simon Peyton Jones Date: Tue Sep 9 17:29:50 2014 +0100 More wip on flatten-skolems >--------------------------------------------------------------- 84b34639ae19ce5c04f93dfead4d40f0349b8d09 compiler/typecheck/TcRnTypes.lhs | 5 ++-- compiler/typecheck/TcSMonad.lhs | 2 +- compiler/typecheck/TcSimplify.lhs | 48 ++++++++++++++++++++++++++++++++------- 3 files changed, 44 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index b0d0c6c..1072d99 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -1285,8 +1285,9 @@ data Implication -- (order does not matter) -- See Invariant (GivenInv) in TcType - ic_fsks :: [TcTyVar], -- Extra flatten-skolems introduced by - -- by flattening the givens + ic_fsks :: Cts -- Extra Given constraints, all CFunEqCans, + -- arising from flattening the givens + ic_no_eqs :: Bool, -- True <=> ic_givens have no equalities, for sure -- False <=> ic_givens might have equalities diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index f542c1e..a5275d1 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1970,7 +1970,7 @@ deferTcSForAllEq role loc (tvs1,body1) (tvs2,body2) , ic_skols = skol_tvs , ic_no_eqs = True , ic_given = [] - , ic_fsks = [] + , ic_fsks = emptyCts , ic_wanted = wc , ic_insol = False , ic_binds = ev_binds_var diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index b14715f..4a1aff2 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -1122,7 +1122,10 @@ they carry evidence). \begin{code} -floatEqualities :: [TcTyVar] -> Bool -> [TcTyVar] +data SkolStatus = Pinned | CanFloat | Pending + +floatEqualities :: [TcTyVar] -> Bool + -> Cts -- Given fsks -> WantedConstraints -> TcS (Cts, WantedConstraints) -- Main idea: see Note [Float Equalities out of Implications] -- @@ -1140,14 +1143,43 @@ floatEqualities skols no_given_eqs fsks wanteds@(WC { wc_flat = flats }) | otherwise = where - (ufsk_funeqs, others) = partitionBag isCFunEqCan flats + skol_set = mkVarSet skols + (ufsks, others) = partitionBag isCFunEqCan flats + all_fsks = ufsks `andCts` fsks + + fsk_tvs :: VarEnv [TcTyVar] + fsk_tvs = foldBag (\env (CFunEqCan { cc_fsk = tv, cc_tyargs = xis }) + -> extendVarEnv env tv (varSetElems (tyVarsOfTypes xis))) + emptyVarEnv all_fsks + + fsk_map :: VarEnv SkolStatus -- True <=> pinned by skolem + fsk_map = foldrBag mk_fsk_map emptyVarEnv (ufsks `andCts` fsks) + + mk_fsk_map :: Ct -> VarEnv SkolStatus -> VarEnv SkolStatus + mk_fsk_map (CFunEqCan { cc_fsk = tv }) map_so_far + = snd (mk_fsk_map_tv map_so_far tv) + + mk_fsk_map_tv :: VarEnv SkolStatus -> TcTyVar -> (Bool, VarEnv SkolStatus) + mk_fsk_map_tv map_so_far tv + | Just status <- lookupVarEnv map_so_far tv + = (status, map_so_far) + | tv `elem skol_set + = (Pinned, extendVarEnv map_so_far tv Pinned) + | Just new_tvs <- lookupVarEnv fsk_tvs tv + , (status, map_so_far') <- mk_fsk_map_tvs (extendVarEnv map_so_far tv Pending) new_tvs + = (status, extendVarEnv map_so_far' tv status) + | otherwise + = (CanFloat, extendVarEnv map_so_far tv CanFloat) + + mk_fsk_map_tvs :: VarEnv Bool -> [TcTyVar] -> (Bool, VarEnv Bool) + mk_fsk_map_tvs map_so_far [] + = (CanFloat, map_so_far) + mk_fsk_map_tvs map_so_far (tv:tvs) + | (status, map_so_far') <- mk_fsk_map_tv map_so_far tv + = case status of + Pinned -> (Pinned, map_so_far') + _ -> mk_fsk_map_tvs map_so_far' tvs - pinned_tvs = fixVarSet mk_next (mkVarSet skols) - mk_next tvs = foldr grow_one tvs flat_eqs - grow_one (tvs1,tvs2) tvs - | intersectsVarSet tvs tvs1 = tvs `unionVarSet` tvs2 - | intersectsVarSet tvs tvs2 = tvs `unionVarSet` tvs2 - | otherwise = tvs (float_candidates, flats1) = partitionBag is_candidate flats is_candidate (CTyEqCan { cc_tyvar = tv, cc_rhs = xi }) From git at git.haskell.org Tue Sep 9 16:36:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 16:36:50 +0000 (UTC) Subject: [commit: packages/haskeline] master: Add a "forall" quantifier before rank-n-types (2d3e35d) Message-ID: <20140909163650.C8F803A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/2d3e35d3e139ee1633956e15f7c30a7feeea08fb >--------------------------------------------------------------- commit 2d3e35d3e139ee1633956e15f7c30a7feeea08fb Author: Krzysztof Gogolewski Date: Sat Feb 1 22:55:42 2014 +0100 Add a "forall" quantifier before rank-n-types This is for compatibility with GHC Trac #4426 >--------------------------------------------------------------- 2d3e35d3e139ee1633956e15f7c30a7feeea08fb System/Console/Haskeline/Term.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/System/Console/Haskeline/Term.hs b/System/Console/Haskeline/Term.hs index a4b2638..9689a16 100644 --- a/System/Console/Haskeline/Term.hs +++ b/System/Console/Haskeline/Term.hs @@ -40,7 +40,7 @@ data RunTerm = RunTerm { -- | Operations needed for terminal-style interaction. data TermOps = TermOps { getLayout :: IO Layout - , withGetEvent :: CommandMonad m => (m Event -> m a) -> m a + , withGetEvent :: forall m a . CommandMonad m => (m Event -> m a) -> m a , evalTerm :: forall m . CommandMonad m => EvalTerm m , saveUnusedKeys :: [Key] -> IO () } From git at git.haskell.org Tue Sep 9 16:36:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 16:36:52 +0000 (UTC) Subject: [commit: packages/haskeline] master: Add Eq and Ord instances to Completion. (62ca19e) Message-ID: <20140909163652.CDE993A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/62ca19ec634616c9dd0732cb716f60f43bdb9df0 >--------------------------------------------------------------- commit 62ca19ec634616c9dd0732cb716f60f43bdb9df0 Author: joneshf Date: Thu Feb 20 21:19:43 2014 -0800 Add Eq and Ord instances to Completion. >--------------------------------------------------------------- 62ca19ec634616c9dd0732cb716f60f43bdb9df0 System/Console/Haskeline/Completion.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/System/Console/Haskeline/Completion.hs b/System/Console/Haskeline/Completion.hs index 853561c..b17bb0c 100644 --- a/System/Console/Haskeline/Completion.hs +++ b/System/Console/Haskeline/Completion.hs @@ -39,7 +39,7 @@ data Completion = Completion {replacement :: String, -- ^ Text to insert in lin -- ^ Whether this word should be followed by a -- space, end quote, etc. } - deriving Show + deriving (Eq, Ord, Show) -- | Disable completion altogether. noCompletion :: Monad m => CompletionFunc m From git at git.haskell.org Tue Sep 9 16:36:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 16:36:54 +0000 (UTC) Subject: [commit: packages/haskeline] master: Bump version to 0.7.1.3 and update changelog. (c8cc19f) Message-ID: <20140909163654.D2D7C3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/c8cc19fb88f91cfd751ac73904b85aff631c11d7 >--------------------------------------------------------------- commit c8cc19fb88f91cfd751ac73904b85aff631c11d7 Author: Judah Jacobson Date: Wed Jun 11 21:57:32 2014 -0700 Bump version to 0.7.1.3 and update changelog. >--------------------------------------------------------------- c8cc19fb88f91cfd751ac73904b85aff631c11d7 Changelog | 3 +++ haskeline.cabal | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/Changelog b/Changelog index c414fc9..aadc660 100644 --- a/Changelog +++ b/Changelog @@ -1,3 +1,6 @@ +Changed in version 0.7.1.3: + * Add support for transformers-0.4.0.0. + Changed in version 0.7.1.2: * Require ghc>=7.0.1. * Allow building with terminfo-0.4. diff --git a/haskeline.cabal b/haskeline.cabal index c26768f..84166bf 100644 --- a/haskeline.cabal +++ b/haskeline.cabal @@ -1,6 +1,6 @@ Name: haskeline Cabal-Version: >=1.16 -Version: 0.7.1.2 +Version: 0.7.1.3 Category: User Interfaces License: BSD3 License-File: LICENSE From git at git.haskell.org Tue Sep 9 16:36:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 16:36:56 +0000 (UTC) Subject: [commit: packages/haskeline] master: Merge pull request #6 from joneshf/master (f543665) Message-ID: <20140909163656.D7B0A3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/f543665bfb781ab9771d488fa3f836ac4c5e8ecb >--------------------------------------------------------------- commit f543665bfb781ab9771d488fa3f836ac4c5e8ecb Merge: c8cc19f 62ca19e Author: Judah Jacobson Date: Wed Jun 11 22:04:58 2014 -0700 Merge pull request #6 from joneshf/master Add Eq and Ord instances to Completion. >--------------------------------------------------------------- f543665bfb781ab9771d488fa3f836ac4c5e8ecb System/Console/Haskeline/Completion.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) From git at git.haskell.org Tue Sep 9 16:36:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 16:36:58 +0000 (UTC) Subject: [commit: packages/haskeline] master: Merge pull request #4 from monoidal/patch-1 (0f4ba2c) Message-ID: <20140909163658.DD4E73A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/0f4ba2c51691f2031371c0bfadcd652abf57ad27 >--------------------------------------------------------------- commit 0f4ba2c51691f2031371c0bfadcd652abf57ad27 Merge: f543665 2d3e35d Author: Judah Jacobson Date: Wed Jun 11 22:05:18 2014 -0700 Merge pull request #4 from monoidal/patch-1 Add a "forall" quantifier before rank-n-types >--------------------------------------------------------------- 0f4ba2c51691f2031371c0bfadcd652abf57ad27 System/Console/Haskeline/Term.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) From git at git.haskell.org Tue Sep 9 16:37:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 16:37:00 +0000 (UTC) Subject: [commit: packages/haskeline] master: Bump upper bound on `base` to accomodate GHC HEAD-to-become-7.10 (d62474e) Message-ID: <20140909163700.E44043A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/d62474efd5256a0668634f612f078a1c730a8d07 >--------------------------------------------------------------- commit d62474efd5256a0668634f612f078a1c730a8d07 Author: Herbert Valerio Riedel Date: Tue Sep 9 16:49:15 2014 +0200 Bump upper bound on `base` to accomodate GHC HEAD-to-become-7.10 base needed a major version bump due to AMP landing >--------------------------------------------------------------- d62474efd5256a0668634f612f078a1c730a8d07 haskeline.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haskeline.cabal b/haskeline.cabal index 84166bf..404bf65 100644 --- a/haskeline.cabal +++ b/haskeline.cabal @@ -50,7 +50,7 @@ flag legacy-encoding Default: False Library - Build-depends: base >=4.3 && < 4.8, containers>=0.4 && < 0.6, + Build-depends: base >=4.3 && < 4.9, containers>=0.4 && < 0.6, directory>=1.1 && < 1.3, bytestring>=0.9 && < 0.11, filepath >= 1.2 && < 1.4, transformers >= 0.2 && < 0.5 Default-Language: Haskell98 From git at git.haskell.org Tue Sep 9 16:37:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 16:37:29 +0000 (UTC) Subject: [commit: packages/terminfo] branch 'ghc-head' deleted Message-ID: <20140909163729.D860B3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/terminfo Deleted branch: ghc-head From git at git.haskell.org Tue Sep 9 16:37:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 16:37:31 +0000 (UTC) Subject: [commit: packages/terminfo] master: Bump upper bound on `base` to accomodate GHC HEAD-to-become-7.10 (de93eba) Message-ID: <20140909163731.DEC623A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/terminfo On branch : master Link : http://git.haskell.org/packages/terminfo.git/commitdiff/de93eba74cd4537771b65117d4ad00db9943657d >--------------------------------------------------------------- commit de93eba74cd4537771b65117d4ad00db9943657d Author: Herbert Valerio Riedel Date: Tue Sep 9 16:52:03 2014 +0200 Bump upper bound on `base` to accomodate GHC HEAD-to-become-7.10 base needed a major version bump due to AMP landing >--------------------------------------------------------------- de93eba74cd4537771b65117d4ad00db9943657d terminfo.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/terminfo.cabal b/terminfo.cabal index b8265a0..7c88f52 100644 --- a/terminfo.cabal +++ b/terminfo.cabal @@ -29,7 +29,7 @@ Library other-extensions: CPP, DeriveDataTypeable, FlexibleInstances, ScopedTypeVariables if impl(ghc>=7.3) other-extensions: Safe, Trustworthy - build-depends: base >= 4.3 && < 4.8 + build-depends: base >= 4.3 && < 4.9 ghc-options: -Wall exposed-modules: System.Console.Terminfo From git at git.haskell.org Tue Sep 9 16:37:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 16:37:33 +0000 (UTC) Subject: [commit: packages/terminfo] master's head updated: Bump upper bound on `base` to accomodate GHC HEAD-to-become-7.10 (de93eba) Message-ID: <20140909163733.EAFF23A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/terminfo Branch 'master' now includes: 76a3cea Bump version to 0.3.2.6. 679784c Add `.travis.yml` and `README.md` file 13ef85a Declare language extensions locally via `{-# LANGUAGE #-}`s dd0a84c Modernize `terminfo.cabal` to `cabal-version: >=1.10` format 1ceae93 Merge pull request #1 from hvr/enable-travis ed359f2 Change stability field to "Stable". 8475af0 Add missing Functor/Applicative/Alternative instances e13ed46 Merge pull request #2 from hvr/fix-amp-warnings 8e706c8 Bump version to 0.4.0.0. 1ce8379 Merge branch 'master' of github.com:judah/terminfo de93eba Bump upper bound on `base` to accomodate GHC HEAD-to-become-7.10 From git at git.haskell.org Tue Sep 9 16:37:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 16:37:46 +0000 (UTC) Subject: [commit: ghc] master: Bump `base` version to 4.8.0.0 for real (c6f502b) Message-ID: <20140909163746.88CC43A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c6f502b211d03ff8408b17932a4435e4d5f6cd31/ghc >--------------------------------------------------------------- commit c6f502b211d03ff8408b17932a4435e4d5f6cd31 Author: Herbert Valerio Riedel Date: Tue Sep 9 17:39:57 2014 +0200 Bump `base` version to 4.8.0.0 for real This commit updates several submodules in order to bump the upper bounds on `base` of most boot packages Moreover, this updates some of the test-suite cases which have version numbers hardcoded within. However, I'm not sure if this commit didn't introduce the following two test-failures ghc-api T8628 [bad stdout] (normal) ghc-api T8639_api [bad stdout] (normal) This needs investigation >--------------------------------------------------------------- c6f502b211d03ff8408b17932a4435e4d5f6cd31 libraries/array | 2 +- libraries/base/base.cabal | 4 ++-- libraries/deepseq | 2 +- libraries/directory | 2 +- libraries/filepath | 2 +- libraries/haskeline | 2 +- libraries/haskell2010 | 2 +- libraries/haskell98 | 2 +- libraries/hoopl | 2 +- libraries/hpc | 2 +- libraries/old-locale | 2 +- libraries/old-time | 2 +- libraries/parallel | 2 +- libraries/process | 2 +- libraries/stm | 2 +- libraries/template-haskell/changelog.md | 5 +++++ libraries/template-haskell/template-haskell.cabal | 6 ++++-- libraries/terminfo | 2 +- libraries/unix | 2 +- testsuite/tests/cabal/cabal06/q/q-1.0.conf | 2 +- testsuite/tests/ghci/scripts/T5979.stderr | 6 +++--- .../tests/indexed-types/should_compile/T3017.stderr | 2 +- testsuite/tests/indexed-types/should_fail/T9160.stderr | 2 +- testsuite/tests/roles/should_compile/Roles1.stderr | 2 +- testsuite/tests/roles/should_compile/Roles14.stderr | 2 +- testsuite/tests/roles/should_compile/Roles2.stderr | 2 +- testsuite/tests/roles/should_compile/Roles3.stderr | 2 +- testsuite/tests/roles/should_compile/Roles4.stderr | 2 +- testsuite/tests/roles/should_compile/T8958.stderr | 2 +- testsuite/tests/safeHaskell/check/Check01.stderr | 2 +- testsuite/tests/safeHaskell/check/Check06.stderr | 2 +- testsuite/tests/safeHaskell/check/Check08.stderr | 2 +- testsuite/tests/safeHaskell/check/Check09.stderr | 2 +- testsuite/tests/safeHaskell/check/pkg01/ImpSafe01.stderr | 2 +- .../tests/safeHaskell/check/pkg01/ImpSafeOnly07.stderr | 2 +- .../tests/safeHaskell/check/pkg01/ImpSafeOnly08.stderr | 2 +- testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout | 16 ++++++++-------- testsuite/tests/safeHaskell/flags/SafeFlags17.stderr | 2 +- testsuite/tests/simplCore/should_compile/T5550.stderr | 2 +- testsuite/tests/th/TH_Roles2.stderr | 2 +- testsuite/tests/typecheck/should_compile/tc231.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail182.stderr | 2 +- utils/haddock | 2 +- 43 files changed, 60 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 c6f502b211d03ff8408b17932a4435e4d5f6cd31 From git at git.haskell.org Tue Sep 9 16:50:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 16:50:50 +0000 (UTC) Subject: [commit: ghc] master: base: replace ver 4.7.1.0 references by 4.8.0.0 (68ecc57) Message-ID: <20140909165050.22A693A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/68ecc578c800aa2767dbf48863f4742859b1a8ec/ghc >--------------------------------------------------------------- commit 68ecc578c800aa2767dbf48863f4742859b1a8ec Author: Herbert Valerio Riedel Date: Tue Sep 9 18:46:10 2014 +0200 base: replace ver 4.7.1.0 references by 4.8.0.0 Since we now had to major bump due to AMP being landed, `base-4.7.1.0` is not gonna happen, as we're going straight for a `base-4.8.0.0` release. [skip ci] since this is a doc-only change >--------------------------------------------------------------- 68ecc578c800aa2767dbf48863f4742859b1a8ec libraries/base/Control/Monad.hs | 2 +- libraries/base/Data/Function.hs | 2 +- libraries/base/Data/List.hs | 2 +- libraries/base/GHC/TypeLits.hs | 4 ++-- libraries/base/System/Exit.hs | 2 +- libraries/base/changelog.md | 4 +++- 6 files changed, 9 insertions(+), 7 deletions(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index bfadd7c..532c42c 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -335,7 +335,7 @@ infixl 4 <$!> -- | Strict version of 'Data.Functor.<$>'. -- --- /Since: 4.7.1.0/ +-- /Since: 4.8.0.0/ (<$!>) :: Monad m => (a -> b) -> m a -> m b {-# INLINE (<$!>) #-} f <$!> m = do diff --git a/libraries/base/Data/Function.hs b/libraries/base/Data/Function.hs index afb6e56..a3fac7c 100644 --- a/libraries/base/Data/Function.hs +++ b/libraries/base/Data/Function.hs @@ -94,6 +94,6 @@ on :: (b -> b -> c) -> (a -> b) -> a -> a -> c -- convenience. Its precedence is one higher than that of the forward -- application operator '$', which allows '&' to be nested in '$'. -- --- /Since: 4.7.1.0/ +-- /Since: 4.8.0.0/ (&) :: a -> (a -> b) -> b x & f = f x diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs index f7b58c1..5e5acc1 100644 --- a/libraries/base/Data/List.hs +++ b/libraries/base/Data/List.hs @@ -967,7 +967,7 @@ rqpart cmp x (y:ys) rle rgt r = -- input list. This is called the decorate-sort-undecorate paradigm, or -- Schwartzian transform. -- --- /Since: 4.7.1.0/ +-- /Since: 4.8.0.0/ sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) diff --git a/libraries/base/GHC/TypeLits.hs b/libraries/base/GHC/TypeLits.hs index 7ae6fb0..cd404f1 100644 --- a/libraries/base/GHC/TypeLits.hs +++ b/libraries/base/GHC/TypeLits.hs @@ -81,12 +81,12 @@ symbolVal :: forall n proxy. KnownSymbol n => proxy n -> String symbolVal _ = case symbolSing :: SSymbol n of SSymbol x -> x --- | /Since: 4.7.1.0/ +-- | /Since: 4.8.0.0/ natVal' :: forall n. KnownNat n => Proxy# n -> Integer natVal' _ = case natSing :: SNat n of SNat x -> x --- | /Since: 4.7.1.0/ +-- | /Since: 4.8.0.0/ symbolVal' :: forall n. KnownSymbol n => Proxy# n -> String symbolVal' _ = case symbolSing :: SSymbol n of SSymbol x -> x diff --git a/libraries/base/System/Exit.hs b/libraries/base/System/Exit.hs index 932cbfb..33cc4e8 100644 --- a/libraries/base/System/Exit.hs +++ b/libraries/base/System/Exit.hs @@ -78,6 +78,6 @@ exitSuccess = exitWith ExitSuccess -- | Write given error message to `stderr` and terminate with `exitFailure`. -- --- /Since: 4.7.1.0/ +-- /Since: 4.8.0.0/ die :: String -> IO a die err = hPutStrLn stderr err >> exitFailure diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 4b97c58..6f3c8cc 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -1,9 +1,11 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) -## 4.7.1.0 *TBA* +## 4.8.0.0 *TBA* * Bundled with GHC 7.10.1 + * Make `Applicative` a superclass of `Monad` + * Add reverse application operator `Data.Function.(&)` * Add `Data.List.sortOn` sorting function From git at git.haskell.org Tue Sep 9 17:32:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 17:32:44 +0000 (UTC) Subject: [commit: ghc] master: build.mk.sample: Stage1 needn't be built with -fllvm (841924c) Message-ID: <20140909173244.B9BA33A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/841924c9587c10488a18e307b573720977bf4f13/ghc >--------------------------------------------------------------- commit 841924c9587c10488a18e307b573720977bf4f13 Author: Ben Gamari Date: Sat Sep 6 13:24:30 2014 -0400 build.mk.sample: Stage1 needn't be built with -fllvm Summary: We can use the native codegen for stage 1 as it is to run on the host platform. Test Plan: Reviewers: Subscribers: GHC Trac Issues: >--------------------------------------------------------------- 841924c9587c10488a18e307b573720977bf4f13 mk/build.mk.sample | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mk/build.mk.sample b/mk/build.mk.sample index 4189882..9d80fa9 100644 --- a/mk/build.mk.sample +++ b/mk/build.mk.sample @@ -108,7 +108,7 @@ endif ifeq "$(BuildFlavour)" "perf-cross" SRC_HC_OPTS = -O -H64m -fllvm -GhcStage1HcOpts = -O2 -fllvm +GhcStage1HcOpts = -O2 GhcStage2HcOpts = -O2 -fllvm GhcHcOpts = -Rghc-timing GhcLibHcOpts = -O2 @@ -179,7 +179,7 @@ endif ifeq "$(BuildFlavour)" "quick-cross" SRC_HC_OPTS = -H64m -O0 -GhcStage1HcOpts = -O -fllvm +GhcStage1HcOpts = -O GhcStage2HcOpts = -O0 -fllvm GhcLibHcOpts = -O -fllvm SplitObjs = NO From git at git.haskell.org Tue Sep 9 17:56:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 17:56:10 +0000 (UTC) Subject: [commit: ghc] wip/new-flatten-skolems-Aug14's head updated: More wip on flatten-skolems (84b3463) Message-ID: <20140909175610.5940C3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/new-flatten-skolems-Aug14' now includes: 84b3463 More wip on flatten-skolems From git at git.haskell.org Tue Sep 9 20:45:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 20:45:35 +0000 (UTC) Subject: [commit: nofib] master: Fix conflict with newly exported 'empty' from Prelude. (a79a273) Message-ID: <20140909204535.3EBB03A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a79a27325ade644f4a6beac0b80eae1f90d7ceb7/nofib >--------------------------------------------------------------- commit a79a27325ade644f4a6beac0b80eae1f90d7ceb7 Author: Edward Z. Yang Date: Tue Sep 9 13:43:36 2014 -0700 Fix conflict with newly exported 'empty' from Prelude. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- a79a27325ade644f4a6beac0b80eae1f90d7ceb7 spectral/calendar/Main.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/spectral/calendar/Main.hs b/spectral/calendar/Main.hs index 94902a1..0bb489a 100644 --- a/spectral/calendar/Main.hs +++ b/spectral/calendar/Main.hs @@ -30,8 +30,8 @@ stack, spread :: [Picture] -> Picture stack = foldr1 above spread = foldr1 beside -empty :: (Int,Int) -> Picture -empty (h,w) = copy h (copy w ' ') +emptyPic :: (Int,Int) -> Picture +emptyPic (h,w) = copy h (copy w ' ') block, blockT :: Int -> [Picture] -> Picture block n = stack . map spread . groop n @@ -42,7 +42,7 @@ groop n [] = [] groop n xs = take n xs : groop n (drop n xs) lframe :: (Int,Int) -> Picture -> Picture -lframe (m,n) p = (p `beside` empty (h,n-w)) `above` empty (m-h,n) +lframe (m,n) p = (p `beside` emptyPic (h,n-w)) `above` emptyPic (m-h,n) where h = height p w = width p @@ -90,12 +90,12 @@ calendar = unlines . block 3 . map picture . months -- In a format somewhat closer to UNIX cal: cal year = unlines (banner year `above` body year) - where banner yr = [cjustify 75 (show yr)] `above` empty (1,75) + where banner yr = [cjustify 75 (show yr)] `above` emptyPic (1,75) body = block 3 . map (pad . pic) . months pic (mn,fd,ml) = title mn `above` table fd ml pad p = (side`beside`p`beside`side)`above`end - side = empty (8,2) - end = empty (1,25) + side = emptyPic (8,2) + end = emptyPic (1,25) title mn = [cjustify 21 mn] table fd ml = daynames `above` entries fd ml daynames = [" Su Mo Tu We Th Fr Sa"] From git at git.haskell.org Tue Sep 9 22:27:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 22:27:43 +0000 (UTC) Subject: [commit: nofib] master: Have cryptarithm2 use transformers, fixes AMP errors. (91e7be1) Message-ID: <20140909222743.800F53A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/91e7be14ffd8ab9170dd89357d8337a03f43a841/nofib >--------------------------------------------------------------- commit 91e7be14ffd8ab9170dd89357d8337a03f43a841 Author: Edward Z. Yang Date: Tue Sep 9 15:27:36 2014 -0700 Have cryptarithm2 use transformers, fixes AMP errors. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 91e7be14ffd8ab9170dd89357d8337a03f43a841 spectral/cryptarithm2/Main.hs | 3 +- spectral/cryptarithm2/Makefile | 2 - spectral/cryptarithm2/MonadState.lhs | 184 ----------------------------------- spectral/cryptarithm2/MonadTrans.hs | 15 --- 4 files changed, 2 insertions(+), 202 deletions(-) diff --git a/spectral/cryptarithm2/Main.hs b/spectral/cryptarithm2/Main.hs index 5d14e5d..09657a5 100644 --- a/spectral/cryptarithm2/Main.hs +++ b/spectral/cryptarithm2/Main.hs @@ -15,7 +15,8 @@ can not ever reach valid results. module Main where import Control.Monad -import MonadState +import Control.Monad.Trans.State +import Control.Monad.Trans.Class import Data.List import Data.Maybe diff --git a/spectral/cryptarithm2/Makefile b/spectral/cryptarithm2/Makefile index b9798ec..b0ddca4 100644 --- a/spectral/cryptarithm2/Makefile +++ b/spectral/cryptarithm2/Makefile @@ -1,7 +1,5 @@ TOP = ../.. include $(TOP)/mk/boilerplate.mk -SRC_HC_OPTS += -fglasgow-exts - include $(TOP)/mk/target.mk diff --git a/spectral/cryptarithm2/MonadState.lhs b/spectral/cryptarithm2/MonadState.lhs deleted file mode 100644 index 0a264a6..0000000 --- a/spectral/cryptarithm2/MonadState.lhs +++ /dev/null @@ -1,184 +0,0 @@ - -

MonadState

- - MonadState - 0.1 alpha - The contents of this module are - understood to be a straightforward implementation of - part of the fokelore of the functional programming community, - and therefore the contents are in the public domain. - - Rendered by Andy Gill, - based on the paper - Functional Programming with Overloading and - Higher-Order Polymorphism, - Mark P Jones, - Advanced School of Functional Programming, 1995. - - This requires multi parameter classes - and functional dependencies. - - Hugs98 - - -
- -> module MonadState ( -> MonadState(..), -> modify, -> State, -- abstract -> runState, -> mapState, -> evalState, -> execState, -> StateT, -- abstract -> runStateT, -> mapStateT, -> evalStateT, -> execStateT, -> module MonadTrans -> ) where - -> import Control.Monad -> import MonadTrans - - - MonadState - -{- - - This class has two functions. - - get : returns the state from the internals of the monad, - - put : changes the state inside the monad. - -} - -> class (Monad m) => MonadState s m where -> get :: m s -> put :: s -> m () - - - - Monadic state transformer. - - Maps an old state to a new state inside a state monad. - The old state is thrown away. - - - Main> :t modify ((+1) :: Int -> Int) - modify (...) :: (MonadState Int a) => a () - -

This says that modify (+1) acts over any - Monad that is a member of the MonadState class, - with an Int state.

-
-
- -> modify :: (MonadState s m) => (s -> s) -> m () -> modify f = do s <- get -> put (f s) - ------------------------------------------------------------------------------- -{- Our parameterizable state monad - -} - -> newtype State s a = State { runState :: s -> (a,s) } - -{- - - The State Monad structure is paramterized over just the state: - - - -} - -> instance Functor (State s) where -> fmap f p = State (\ s -> -> let (x,s') = runState p s -> in (f x,s')) - -> instance Monad (State s) where -> return v = State (\ s -> (v,s)) -> p >>= f = State (\ s -> let (r,s') = runState p s -> in runState (f r) s') -> fail str = State (\ s -> error str) - -> instance MonadState s (State s) where -> get = State (\ s -> (s,s)) -> put v = State (\ _ -> ((),v)) - - -> mapState :: ((a,s) -> (b,s)) -> State s a -> State s b -> mapState f m = State (f . runState m) - -> evalState :: State s a -> s -> a -> evalState m s = fst (runState m s) - -> execState :: State s a -> s -> s -> execState m s = snd (runState m s) - ------------------------------------------------------------------------------- -{- Our parameterizable state monad, with an inner monad - -} - -> newtype StateT s m a = StateT { runStateT :: s -> m (a,s) } - -{- - - The StateT Monad structure is paramterized over two things: - - s: The State itself. - - m: The inner monad. - - - - Here are some examples of use: - - - - (Parser from ParseLib with Hugs) - - type Parser a = StateT String [] a - - ==> StateT (String -> [(a,String)]) - - For example, item can be written as: - - item = do (x:xs) <- get - - put xs - - return x - - - - type BoringState s a = StateT s Indentity a - - ==> StateT (s -> Identity (a,s)) - - - - type StateWithIO s a = StateT s IO a - - ==> StateT (s -> IO (a,s)) - - - - type StateWithErr s a = StateT s Maybe a - - ==> StateT (s -> Maybe (a,s)) - -} - -> instance (Monad m) => Functor (StateT s m) where -> -- fmap :: (a -> b) -> StateT s m a -> StateT s m b -> fmap f p = StateT (\ s -> -> do (x,s') <- runStateT p s -> return (f x,s')) -> -> instance (Monad m) => Monad (StateT s m) where -> return v = StateT (\ s -> return (v,s)) -> p >>= f = StateT (\ s -> do (r,s') <- runStateT p s -> runStateT (f r) s') -> fail str = StateT (\ s -> fail str) -> -> instance (MonadPlus m) => MonadPlus (StateT s m) where -> mzero = StateT (\ s -> mzero) -> p `mplus` q = StateT (\ s -> runStateT p s `mplus` runStateT q s) -> -> instance (Monad m) => MonadState s (StateT s m) where -> get = StateT (\ s -> return (s,s)) -> put v = StateT (\ _ -> return ((),v)) -> -> instance MonadTrans (StateT s) where -> lift f = StateT ( \ s -> do { r <- f ; runStateT (return r) s }) - -> mapStateT :: (m (a,s) -> n (b,s)) -> StateT s m a -> StateT s n b -> mapStateT f m = StateT (f . runStateT m) -> -> evalStateT :: (Monad m) => StateT s m a -> s -> m a -> evalStateT m s = -> do (r,_) <- runStateT m s -> return r -> -> execStateT :: (Monad m) => StateT s m a -> s -> m s -> execStateT m s = -> do (_,s) <- runStateT m s -> return s - ------------------------------------------------------------------------------- - - diff --git a/spectral/cryptarithm2/MonadTrans.hs b/spectral/cryptarithm2/MonadTrans.hs deleted file mode 100644 index 1661410..0000000 --- a/spectral/cryptarithm2/MonadTrans.hs +++ /dev/null @@ -1,15 +0,0 @@ --- This file is understood to be in the public domain. - -module MonadTrans where - - -{- - - This provides a way of accessing a monad that is inside - - another monad. - -} - -class MonadTrans t where - lift :: Monad m => m a -> t m a - ---liftTrans :: (MonadTrans t) => (a -> t m b) -> (t m a -> t m b) ---liftTrans f m = do { a <- m ; f a } From git at git.haskell.org Tue Sep 9 22:28:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 22:28:44 +0000 (UTC) Subject: [commit: ghc] branch 'ghc-validate' created Message-ID: <20140909222844.572313A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : ghc-validate Referencing: 1e400376044f9eb81a579d901c8d2c572ffe52c8 From git at git.haskell.org Tue Sep 9 22:28:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 22:28:46 +0000 (UTC) Subject: [commit: ghc] ghc-validate: Update nofib submodule to fix errors in main suite. (1e40037) Message-ID: <20140909222846.DD5F13A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-validate Link : http://ghc.haskell.org/trac/ghc/changeset/1e400376044f9eb81a579d901c8d2c572ffe52c8/ghc >--------------------------------------------------------------- commit 1e400376044f9eb81a579d901c8d2c572ffe52c8 Author: Edward Z. Yang Date: Tue Sep 9 15:28:00 2014 -0700 Update nofib submodule to fix errors in main suite. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 1e400376044f9eb81a579d901c8d2c572ffe52c8 nofib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nofib b/nofib index c9c20d4..91e7be1 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit c9c20d477088a8a7d5747f16afdf0652fba6dadf +Subproject commit 91e7be14ffd8ab9170dd89357d8337a03f43a841 From git at git.haskell.org Tue Sep 9 22:59:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 22:59:30 +0000 (UTC) Subject: [commit: ghc] master's head updated: Update nofib submodule to fix errors in main suite. (1e40037) Message-ID: <20140909225930.C7D8B3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'master' now includes: 1e40037 Update nofib submodule to fix errors in main suite. From git at git.haskell.org Tue Sep 9 23:11:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Sep 2014 23:11:16 +0000 (UTC) Subject: [commit: ghc] branch 'ghc-validate' deleted Message-ID: <20140909231116.C43343A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: ghc-validate From git at git.haskell.org Wed Sep 10 02:38:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Sep 2014 02:38:11 +0000 (UTC) Subject: [commit: nofib] master: Fix bitrotted gc nofib code. (12b6903) Message-ID: <20140910023811.9AC3A3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/12b6903065ea7fedca06ff21e91272ad6fdd0192/nofib >--------------------------------------------------------------- commit 12b6903065ea7fedca06ff21e91272ad6fdd0192 Author: Edward Z. Yang Date: Tue Sep 9 19:37:39 2014 -0700 Fix bitrotted gc nofib code. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 12b6903065ea7fedca06ff21e91272ad6fdd0192 gc/fibheaps/Main.lhs | 1 + gc/happy/LALR.lhs | 1 + gc/happy/ParseMonad.lhs | 12 ++++++++++++ gc/happy/ProduceCode.lhs | 1 + gc/happy/happy.lhs | 2 +- 5 files changed, 16 insertions(+), 1 deletion(-) diff --git a/gc/fibheaps/Main.lhs b/gc/fibheaps/Main.lhs index 452ae6e..245335d 100644 --- a/gc/fibheaps/Main.lhs +++ b/gc/fibheaps/Main.lhs @@ -50,6 +50,7 @@ first understand binomial queues. See, for example, David King's "Functional Binomial Queues" from the last Glasgow workshop. > -- partain +>{-# LANGUAGE FlexibleContexts #-} >module Main (main) where >import Data.Array >import System.Environment diff --git a/gc/happy/LALR.lhs b/gc/happy/LALR.lhs index f8610fb..08a99b3 100644 --- a/gc/happy/LALR.lhs +++ b/gc/happy/LALR.lhs @@ -5,6 +5,7 @@ Generation of LALR parsing tables. (c) 1997-2001 Simon Marlow ----------------------------------------------------------------------------- +> {-# LANGUAGE FlexibleContexts #-} > module LALR > (genActionTable, genGotoTable, genLR0items, precalcClosure0, > propLookaheads, calcLookaheads, mergeLookaheadInfo, countConflicts, diff --git a/gc/happy/ParseMonad.lhs b/gc/happy/ParseMonad.lhs index 9e576a5..4e29e9e 100644 --- a/gc/happy/ParseMonad.lhs +++ b/gc/happy/ParseMonad.lhs @@ -5,6 +5,7 @@ The parser monad. ----------------------------------------------------------------------------- > module ParseMonad where +> import Control.Monad(ap) > data ParseResult a = OkP a | FailP String > newtype P a = P (String -> Int -> ParseResult a) @@ -13,6 +14,17 @@ The parser monad. > lineP :: P Int > lineP = P $ \_ l -> OkP l +> instance Functor ParseResult where +> fmap f (OkP a) = OkP (f a) +> fmap f (FailP e) = FailP e + +> instance Functor P where +> fmap f m = P $ \s l -> fmap f (runP m s l) + +> instance Applicative P where +> pure = return +> (<*>) = ap + > instance Monad P where > return m = P $ \ _ _ -> OkP m > m >>= k = P $ \s l -> case runP m s l of diff --git a/gc/happy/ProduceCode.lhs b/gc/happy/ProduceCode.lhs index cd1980d..0c0dcc5 100644 --- a/gc/happy/ProduceCode.lhs +++ b/gc/happy/ProduceCode.lhs @@ -4,6 +4,7 @@ The code generator. (c) 1993-2001 Andy Gill, Simon Marlow ----------------------------------------------------------------------------- +> {-# LANGUAGE FlexibleContexts #-} > module ProduceCode (produceParser) where > import Paths_happy ( version ) diff --git a/gc/happy/happy.lhs b/gc/happy/happy.lhs index 149868d..2d8021d 100644 --- a/gc/happy/happy.lhs +++ b/gc/happy/happy.lhs @@ -25,7 +25,7 @@ Path settings auto-generated by Cabal: > import System.Console.GetOpt > import Control.Monad ( liftM ) > import System.Environment -> import System.Exit +> import System.Exit ( exitWith, ExitCode(ExitSuccess, ExitFailure) ) > import Data.Char > import System.IO > import Data.Array( assocs, elems, (!) ) From git at git.haskell.org Wed Sep 10 02:40:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Sep 2014 02:40:16 +0000 (UTC) Subject: [commit: ghc] master: Update nofib submodule to track gc bitrot updates. (f3d2694) Message-ID: <20140910024016.AB9C03A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f3d2694918d10fa693251e7ac094d687b2962360/ghc >--------------------------------------------------------------- commit f3d2694918d10fa693251e7ac094d687b2962360 Author: Edward Z. Yang Date: Tue Sep 9 19:39:58 2014 -0700 Update nofib submodule to track gc bitrot updates. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- f3d2694918d10fa693251e7ac094d687b2962360 nofib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nofib b/nofib index 91e7be1..12b6903 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit 91e7be14ffd8ab9170dd89357d8337a03f43a841 +Subproject commit 12b6903065ea7fedca06ff21e91272ad6fdd0192 From git at git.haskell.org Wed Sep 10 07:01:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Sep 2014 07:01:47 +0000 (UTC) Subject: [commit: ghc] master: testsuite: AMPify ioprof.hs (6477b3d) Message-ID: <20140910070147.76CFB3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6477b3dc058a92b825ef30d98797603b4a44a001/ghc >--------------------------------------------------------------- commit 6477b3dc058a92b825ef30d98797603b4a44a001 Author: Joachim Breitner Date: Wed Sep 10 09:01:33 2014 +0200 testsuite: AMPify ioprof.hs >--------------------------------------------------------------- 6477b3dc058a92b825ef30d98797603b4a44a001 testsuite/tests/profiling/should_run/ioprof.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/testsuite/tests/profiling/should_run/ioprof.hs b/testsuite/tests/profiling/should_run/ioprof.hs index 2a9930e..98c7f4e 100644 --- a/testsuite/tests/profiling/should_run/ioprof.hs +++ b/testsuite/tests/profiling/should_run/ioprof.hs @@ -1,5 +1,7 @@ import Control.Concurrent import Control.Exception +import Control.Monad (ap, liftM) +import Control.Applicative type S = String @@ -10,6 +12,13 @@ instance Monad (M s) where (s',a) -> unM (k a) s' return a = M $ \s -> (s,a) +instance Functor (M s) where + fmap = liftM + +instance Applicative (M s) where + pure = return + (<*>) = ap + errorM :: String -> M s a errorM s = M $ \_ -> error s From git at git.haskell.org Wed Sep 10 09:28:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Sep 2014 09:28:51 +0000 (UTC) Subject: [commit: ghc] master: testsuite: AMPify T3001-2 (29e50da) Message-ID: <20140910092851.408713A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/29e50da4c274eba0e444ce4b95294a76832908f2/ghc >--------------------------------------------------------------- commit 29e50da4c274eba0e444ce4b95294a76832908f2 Author: Joachim Breitner Date: Wed Sep 10 11:26:10 2014 +0200 testsuite: AMPify T3001-2 >--------------------------------------------------------------- 29e50da4c274eba0e444ce4b95294a76832908f2 testsuite/tests/profiling/should_run/T3001-2.hs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/profiling/should_run/T3001-2.hs b/testsuite/tests/profiling/should_run/T3001-2.hs index 5c0cb3e..5a84dcc 100644 --- a/testsuite/tests/profiling/should_run/T3001-2.hs +++ b/testsuite/tests/profiling/should_run/T3001-2.hs @@ -26,6 +26,8 @@ import System.IO import Data.Char (chr,ord) +import Control.Applicative + main :: IO () main = do encodeFile "test.bin" $ replicate 10000 'x' @@ -96,6 +98,10 @@ instance Monad PutM where PairS b w' = unPut k in PairS b (w `mappend` w') +instance Applicative PutM where + pure = return + (<*>) = ap + tell :: Builder -> Put tell b = Put $ PairS () b @@ -188,6 +194,10 @@ instance Monad Get where fail = error "failDesc" +instance Applicative Get where + pure = return + (<*>) = ap + getZ :: Get S getZ = Get (\s -> (s, s)) @@ -238,7 +248,7 @@ toLazyByteString m = L.fromChunks $ unsafePerformIO $ do ensureFree :: Int -> Builder ensureFree n = n `seq` withSize $ \ l -> - if n <= l then empty else + if n <= l then emptyBuilder else flush `append` unsafeLiftIO (const (newBuffer (max n defaultSize))) withSize :: (Int -> Builder) -> Builder @@ -271,10 +281,10 @@ flush = Builder $ \ k buf@(Buffer p o u l) -> then k buf else S.PS p o u : k (Buffer p (o+u) 0 l) -empty :: Builder -empty = Builder id +emptyBuilder :: Builder +emptyBuilder = Builder id instance Monoid Builder where - mempty = empty + mempty = emptyBuilder mappend = append From git at git.haskell.org Wed Sep 10 09:28:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Sep 2014 09:28:53 +0000 (UTC) Subject: [commit: ghc] master: Update performance numbers (71c8530) Message-ID: <20140910092853.C4D083A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/71c85300d6280c250b2dcfb48a85e7583ec59bbc/ghc >--------------------------------------------------------------- commit 71c85300d6280c250b2dcfb48a85e7583ec59bbc Author: Joachim Breitner Date: Wed Sep 10 11:26:25 2014 +0200 Update performance numbers including some that are not failing yet, but did show a significant change, and some that Austing changed post-AMP, but where both harbormaster and ghcspeed reported something else. Numbers taken from the ghcspeed machine. >--------------------------------------------------------------- 71c85300d6280c250b2dcfb48a85e7583ec59bbc testsuite/tests/perf/compiler/all.T | 36 ++++++++++++++++++++++------------- testsuite/tests/perf/haddock/all.T | 13 ++++++++----- testsuite/tests/perf/should_run/all.T | 7 +++++-- 3 files changed, 36 insertions(+), 20 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 71c85300d6280c250b2dcfb48a85e7583ec59bbc From git at git.haskell.org Wed Sep 10 09:59:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Sep 2014 09:59:04 +0000 (UTC) Subject: [commit: ghc] branch 'origin/wip/new-flatten-skolems-Aug14' deleted Message-ID: <20140910095904.A1DBC3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: origin/wip/new-flatten-skolems-Aug14 From git at git.haskell.org Wed Sep 10 12:52:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Sep 2014 12:52:38 +0000 (UTC) Subject: [commit: ghc] master: Fix T5321Fun perf number (57fd8ce) Message-ID: <20140910125238.57D2D3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/57fd8ce37fac58c346ec0256ddc3b987e75dbcfa/ghc >--------------------------------------------------------------- commit 57fd8ce37fac58c346ec0256ddc3b987e75dbcfa Author: Joachim Breitner Date: Wed Sep 10 14:52:20 2014 +0200 Fix T5321Fun perf number (I obviously copy?n?pasted the wrong number.) >--------------------------------------------------------------- 57fd8ce37fac58c346ec0256ddc3b987e75dbcfa testsuite/tests/perf/compiler/all.T | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index c1314d3..661e65c 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -372,13 +372,13 @@ test('T5321Fun', # 2012-10-08: 344416344 x86/Linux # (increase due to new codegen) # 2014-09-03: 299656164 (specialisation and inlining) - (wordsize(64), 408664512, 10)]) + (wordsize(64), 601629032, 10)]) # prev: 585521080 # 29/08/2012: 713385808 # (increase due to new codegen) # 15/05/2013: 628341952 # (reason for decrease unknown) # 24/06/2013: 694019152 # (reason for re-increase unknown) # 12/05/2014: 614409344 # (specialisation and inlining changes) - # 10/09/2014: 408664512 # post-AMP-cleanp + # 10/09/2014: 601629032 # post-AMP-cleanp ], compile,['']) From git at git.haskell.org Wed Sep 10 14:18:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Sep 2014 14:18:27 +0000 (UTC) Subject: [commit: ghc] master: T4801 perf numbers: Another typo (23e764f) Message-ID: <20140910141827.1301B3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23e764f02e2ea0e549e9c66c3c5f57c1b77673df/ghc >--------------------------------------------------------------- commit 23e764f02e2ea0e549e9c66c3c5f57c1b77673df Author: Joachim Breitner Date: Wed Sep 10 16:18:17 2014 +0200 T4801 perf numbers: Another typo >--------------------------------------------------------------- 23e764f02e2ea0e549e9c66c3c5f57c1b77673df testsuite/tests/perf/compiler/all.T | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 661e65c..af13b00 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -169,7 +169,7 @@ test('T4801', # expected value: 58 (amd64/OS X) # 13/01/2014 - 70 (wordsize(32), 30, 20), - (wordsize(64), 52, 20)]), + (wordsize(64), 55, 20)]), # prev: 50 (amd64/Linux) # 19/10/2012: 64 (amd64/Linux) # (^ REASON UNKNOWN!) @@ -177,7 +177,7 @@ test('T4801', # (^ REASON UNKNOWN!) # 28/8/13: 60 (amd64/Linux) # (^ REASON UNKNOWN!) - # 2014-09-10: 52 post-AMP-cleanup + # 2014-09-10: 55 post-AMP-cleanup compiler_stats_num_field('bytes allocated', [(platform('x86_64-apple-darwin'), 464872776, 5), From git at git.haskell.org Wed Sep 10 21:05:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Sep 2014 21:05:30 +0000 (UTC) Subject: [commit: packages/hpc] master: Use import list for `Data.Time` (b2d4836) Message-ID: <20140910210530.DDD973A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/b2d48364e924abe4feb9779c902186575db840ab >--------------------------------------------------------------- commit b2d48364e924abe4feb9779c902186575db840ab Author: Herbert Valerio Riedel Date: Wed Sep 10 23:02:58 2014 +0200 Use import list for `Data.Time` This makes it more obvious why `hpc` depends on `time` in the first place, i.e. for the sole purpose of using the `UTCTime` type. >--------------------------------------------------------------- b2d48364e924abe4feb9779c902186575db840ab Trace/Hpc/Mix.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Trace/Hpc/Mix.hs b/Trace/Hpc/Mix.hs index 5be919d..83e8c02 100644 --- a/Trace/Hpc/Mix.hs +++ b/Trace/Hpc/Mix.hs @@ -21,7 +21,7 @@ module Trace.Hpc.Mix where import Data.Maybe (catMaybes) -import Data.Time +import Data.Time (UTCTime) import Data.Tree import Data.Char From git at git.haskell.org Wed Sep 10 21:05:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Sep 2014 21:05:32 +0000 (UTC) Subject: [commit: packages/hpc] master: Relax upper bound to allow `time-1.5` (d430be4) Message-ID: <20140910210532.E4E323A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/d430be4664aac337cd0e49dd6b69e818f21cde6b >--------------------------------------------------------------- commit d430be4664aac337cd0e49dd6b69e818f21cde6b Author: Herbert Valerio Riedel Date: Wed Sep 10 23:04:51 2014 +0200 Relax upper bound to allow `time-1.5` >--------------------------------------------------------------- d430be4664aac337cd0e49dd6b69e818f21cde6b hpc.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hpc.cabal b/hpc.cabal index 0ea97db..ccf7738 100644 --- a/hpc.cabal +++ b/hpc.cabal @@ -38,5 +38,5 @@ Library base >= 4.4.1 && < 4.9, containers >= 0.4.1 && < 0.6, directory >= 1.1 && < 1.3, - time >= 1.2 && < 1.5 + time >= 1.2 && < 1.6 ghc-options: -Wall From git at git.haskell.org Wed Sep 10 21:35:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Sep 2014 21:35:53 +0000 (UTC) Subject: [commit: packages/haskell98] master: Relax upper bound to allow `time-1.5` (543642a) Message-ID: <20140910213553.B24FB3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell98 On branch : master Link : http://git.haskell.org/packages/haskell98.git/commitdiff/543642a054623ce4c5d681dae63be33983ec6712 >--------------------------------------------------------------- commit 543642a054623ce4c5d681dae63be33983ec6712 Author: Herbert Valerio Riedel Date: Wed Sep 10 23:35:11 2014 +0200 Relax upper bound to allow `time-1.5` >--------------------------------------------------------------- 543642a054623ce4c5d681dae63be33983ec6712 haskell98.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haskell98.cabal b/haskell98.cabal index e28430d..d89087f 100644 --- a/haskell98.cabal +++ b/haskell98.cabal @@ -43,7 +43,7 @@ Library old-locale >= 1.0 && < 1.1, old-time >= 1.1 && < 1.2, process >= 1.2 && < 1.3, - time >= 1.4 && < 1.5 + time >= 1.4 && < 1.6 -- haskell98 is a "hidden" package exposed: False From git at git.haskell.org Wed Sep 10 21:59:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Sep 2014 21:59:40 +0000 (UTC) Subject: [commit: ghc] master: Kill obsolete pre GHC 7.6 bootstrapping support (c0c1772) Message-ID: <20140910215940.169BC3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c0c17721b8ff628bb3ad45dad59d5b0c4106f4de/ghc >--------------------------------------------------------------- commit c0c17721b8ff628bb3ad45dad59d5b0c4106f4de Author: Herbert Valerio Riedel Date: Wed Sep 10 23:46:03 2014 +0200 Kill obsolete pre GHC 7.6 bootstrapping support This left-over is definitely not needed anymore and was probably missed in 527bcc41630918977c7 >--------------------------------------------------------------- c0c17721b8ff628bb3ad45dad59d5b0c4106f4de compiler/ghc.cabal.in | 3 --- 1 file changed, 3 deletions(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index a0be3d9..71065d3 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -57,9 +57,6 @@ Library bin-package-db, hoopl - if flag(stage1) && impl(ghc < 7.5) - Build-Depends: old-time >= 1 && < 1.2 - if os(windows) Build-Depends: Win32 else From git at git.haskell.org Wed Sep 10 21:59:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Sep 2014 21:59:42 +0000 (UTC) Subject: [commit: ghc] master: Make GHC `time-1.5`-ready (0b54f62) Message-ID: <20140910215942.E897D3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0b54f621486ede8019c2c0a94bd8fdc6e1ee2e38/ghc >--------------------------------------------------------------- commit 0b54f621486ede8019c2c0a94bd8fdc6e1ee2e38 Author: Herbert Valerio Riedel Date: Wed Sep 10 23:50:38 2014 +0200 Make GHC `time-1.5`-ready This also updates a few submodules to have their upper-bounds on `time` relaxed to allow `time-1.5`. The only package that can't be upgraded yet is `Cabal` due to API changes breaking `ghc-cabal`. This needs to be addressed in a future commit. >--------------------------------------------------------------- 0b54f621486ede8019c2c0a94bd8fdc6e1ee2e38 compiler/ghc.cabal.in | 2 +- libraries/directory | 2 +- libraries/haskell98 | 2 +- libraries/hpc | 2 +- libraries/unix | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 71065d3..fc3517a 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -48,7 +48,7 @@ Library directory >= 1 && < 1.3, process >= 1 && < 1.3, bytestring >= 0.9 && < 0.11, - time < 1.5, + time < 1.6, containers >= 0.1 && < 0.6, array >= 0.1 && < 0.6, filepath >= 1 && < 1.4, diff --git a/libraries/directory b/libraries/directory index 2cb6678..deb530a 160000 --- a/libraries/directory +++ b/libraries/directory @@ -1 +1 @@ -Subproject commit 2cb66787cc3599d5ded2b8c7f8b23bc7b152b58d +Subproject commit deb530aa8a80214af6cf06e9b1ecc3390a5413dd diff --git a/libraries/haskell98 b/libraries/haskell98 index 737333d..543642a 160000 --- a/libraries/haskell98 +++ b/libraries/haskell98 @@ -1 +1 @@ -Subproject commit 737333db1a8eaed9312268e02bade5344d175d05 +Subproject commit 543642a054623ce4c5d681dae63be33983ec6712 diff --git a/libraries/hpc b/libraries/hpc index 79eaff2..d430be4 160000 --- a/libraries/hpc +++ b/libraries/hpc @@ -1 +1 @@ -Subproject commit 79eaff2567872279fd916e52f0c39de5e6370b59 +Subproject commit d430be4664aac337cd0e49dd6b69e818f21cde6b diff --git a/libraries/unix b/libraries/unix index 8afe57f..b2c8ae1 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit 8afe57ff808499584f43a5cfeb1a3bb42602df8b +Subproject commit b2c8ae1cf231745c928fe51029d391681c1f0c20 From git at git.haskell.org Thu Sep 11 14:43:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Sep 2014 14:43:28 +0000 (UTC) Subject: [commit: nofib] master: Update gitignore with more generated files. (487ff1a) Message-ID: <20140911144328.4F8143A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/487ff1a205ad4314b10c9bf486e84086ef39d419/nofib >--------------------------------------------------------------- commit 487ff1a205ad4314b10c9bf486e84086ef39d419 Author: Edward Z. Yang Date: Wed Sep 10 09:09:54 2014 -0700 Update gitignore with more generated files. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 487ff1a205ad4314b10c9bf486e84086ef39d419 .gitignore | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.gitignore b/.gitignore index 84149ca..9fcfe34 100644 --- a/.gitignore +++ b/.gitignore @@ -5,6 +5,8 @@ .depend.bak cachegrind.out.* cachegrind.out.summary +perf.data +perf.data.* # Specific generated files nofib-analyse/nofib-analyse @@ -143,6 +145,7 @@ gc/mutstore1/mutstore1 gc/mutstore2/mutstore2 gc/power/power gc/spellcheck/spellcheck +gc/treejoin/treejoin parallel/blackscholes/blackscholes parallel/coins/coins From git at git.haskell.org Thu Sep 11 14:43:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Sep 2014 14:43:42 +0000 (UTC) Subject: [commit: ghc] master: Update nofib submodule: Update gitignore with more generated files (695d15d) Message-ID: <20140911144342.615EF3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/695d15d0ab7dd11620a70d15f1720713f35b6e3c/ghc >--------------------------------------------------------------- commit 695d15d0ab7dd11620a70d15f1720713f35b6e3c Author: Edward Z. Yang Date: Thu Sep 11 07:40:27 2014 -0700 Update nofib submodule: Update gitignore with more generated files Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 695d15d0ab7dd11620a70d15f1720713f35b6e3c nofib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nofib b/nofib index 12b6903..487ff1a 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit 12b6903065ea7fedca06ff21e91272ad6fdd0192 +Subproject commit 487ff1a205ad4314b10c9bf486e84086ef39d419 From git at git.haskell.org Fri Sep 12 16:44:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Sep 2014 16:44:46 +0000 (UTC) Subject: [commit: ghc] master: Fix support for deriving Generic1 for data families (FIX #9563) (946cbce) Message-ID: <20140912164446.1D8C43A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/946cbcefab9bc02e12b741e5b070d7521b37ba1a/ghc >--------------------------------------------------------------- commit 946cbcefab9bc02e12b741e5b070d7521b37ba1a Author: Jose Pedro Magalhaes Date: Fri Sep 12 17:44:12 2014 +0100 Fix support for deriving Generic1 for data families (FIX #9563) >--------------------------------------------------------------- 946cbcefab9bc02e12b741e5b070d7521b37ba1a compiler/typecheck/TcGenGenerics.lhs | 9 +++++---- testsuite/tests/generics/T9563.hs | 18 ++++++++++++++++++ testsuite/tests/generics/all.T | 1 + 3 files changed, 24 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index acdd654..158a1e7 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -486,10 +486,11 @@ tc_mkRepFamInsts gk tycon metaDts mod = -- `appT` = D Int a b (data families case) Just (famtycon, apps) -> -- `fam` = D - -- `apps` = [Int, a] - let allApps = apps ++ - drop (length apps + length tyvars - - tyConArity famtycon) tyvar_args + -- `apps` = [Int, a, b] + let allApps = case gk of + Gen0 -> apps + Gen1 -> ASSERT(not $ null apps) + init apps in [mkTyConApp famtycon allApps] -- `appT` = D a b (normal case) Nothing -> [mkTyConApp tycon tyvar_args] diff --git a/testsuite/tests/generics/T9563.hs b/testsuite/tests/generics/T9563.hs new file mode 100644 index 0000000..fd12865 --- /dev/null +++ b/testsuite/tests/generics/T9563.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} + +module T9563 where + +import GHC.Generics + +data family F typ :: * -> * +data A +data instance F A a = AData a + deriving (Generic, Generic1) + +data family G a b c d +data instance G Int b Float d = H deriving Generic + +deriving instance Generic1 (G Int b Float) diff --git a/testsuite/tests/generics/all.T b/testsuite/tests/generics/all.T index 1231c61..df95fa6 100644 --- a/testsuite/tests/generics/all.T +++ b/testsuite/tests/generics/all.T @@ -32,3 +32,4 @@ test('T7878', extra_clean(['T7878A.o' ,'T7878A.hi' test('T8468', normal, compile_fail, ['']) test('T8479', normal, compile, ['']) +test('T9563', normal, compile, ['']) From git at git.haskell.org Fri Sep 12 21:14:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Sep 2014 21:14:19 +0000 (UTC) Subject: [commit: ghc] master: Remove obsolete comment about (!!) (9d71315) Message-ID: <20140912211419.87DC83A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9d713150d87de07e132c1211eec956e0ae69aa7f/ghc >--------------------------------------------------------------- commit 9d713150d87de07e132c1211eec956e0ae69aa7f Author: Joachim Breitner Date: Fri Sep 12 23:13:07 2014 +0200 Remove obsolete comment about (!!) as spotted by David Feuer and reported as #9585. The comment was right until ceb68b9118fa883e88abfaa532fc78f6640cf17f, which is only 13 years ago :-). >--------------------------------------------------------------- 9d713150d87de07e132c1211eec956e0ae69aa7f libraries/base/GHC/List.lhs | 3 --- 1 file changed, 3 deletions(-) diff --git a/libraries/base/GHC/List.lhs b/libraries/base/GHC/List.lhs index bbaf39f..2dffecc 100644 --- a/libraries/base/GHC/List.lhs +++ b/libraries/base/GHC/List.lhs @@ -624,9 +624,6 @@ xs !! n | n < 0 = error "Prelude.!!: negative index" (_:xs) !! n = xs !! (n-1) #else -- HBC version (stolen), then unboxified --- The semantics is not quite the same for error conditions --- in the more efficient version. --- xs !! (I# n0) | isTrue# (n0 <# 0#) = error "Prelude.(!!): negative index\n" | otherwise = sub xs n0 where From git at git.haskell.org Sat Sep 13 08:50:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Sep 2014 08:50:23 +0000 (UTC) Subject: [commit: ghc] master: base: Drop obsolete/redundant `__GLASGOW_HASKELL__` checks (b10a7a4) Message-ID: <20140913085023.1BF6F3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b10a7a412738e16d332917b22ee1037383b81eb7/ghc >--------------------------------------------------------------- commit b10a7a412738e16d332917b22ee1037383b81eb7 Author: Herbert Valerio Riedel Date: Sat Sep 13 10:44:20 2014 +0200 base: Drop obsolete/redundant `__GLASGOW_HASKELL__` checks Since 527bcc41630918977c7 we require GHC >=7.6 for bootstrapping anyway. This also allows to avoid the CPP-processing overhead for these two modules. >--------------------------------------------------------------- b10a7a412738e16d332917b22ee1037383b81eb7 libraries/base/Control/Category.hs | 7 ++----- libraries/base/Text/Printf.hs | 22 +--------------------- 2 files changed, 3 insertions(+), 26 deletions(-) diff --git a/libraries/base/Control/Category.hs b/libraries/base/Control/Category.hs index 35875c9..3b8dc2b 100644 --- a/libraries/base/Control/Category.hs +++ b/libraries/base/Control/Category.hs @@ -1,9 +1,6 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP #-} - -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds, GADTs #-} -#endif ----------------------------------------------------------------------------- -- | diff --git a/libraries/base/Text/Printf.hs b/libraries/base/Text/Printf.hs index ec68edb..a92a1a4 100644 --- a/libraries/base/Text/Printf.hs +++ b/libraries/base/Text/Printf.hs @@ -1,8 +1,5 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE CPP #-} -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 700 {-# LANGUAGE GADTs #-} -#endif +{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | @@ -292,8 +289,6 @@ instance (IsChar c) => PrintfType [c] where -- type system won't readily let us say that without -- bringing the GADTs. So we go conditional for these defs. -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 700 - instance (a ~ ()) => PrintfType (IO a) where spr fmts args = putStr $ map fromChar $ uprintf fmts $ reverse args @@ -302,21 +297,6 @@ instance (a ~ ()) => HPrintfType (IO a) where hspr hdl fmts args = do hPutStr hdl (uprintf fmts (reverse args)) -#else - -instance PrintfType (IO a) where - spr fmts args = do - putStr $ map fromChar $ uprintf fmts $ reverse args - return (error "PrintfType (IO a): result should not be used.") - -instance HPrintfType (IO a) where - hspr hdl fmts args = do - hPutStr hdl (uprintf fmts (reverse args)) - return (error "HPrintfType (IO a): result should not be used.") - -#endif - - instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where spr fmts args = \ a -> spr fmts ((parseFormat a, formatArg a) : args) From git at git.haskell.org Sat Sep 13 10:02:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Sep 2014 10:02:41 +0000 (UTC) Subject: [commit: ghc] master: Move ($!) from Prelude into GHC.Base (b53c95f) Message-ID: <20140913100241.4B8253A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b53c95fe621d3a66a82e6dad383e1c0c08f3871e/ghc >--------------------------------------------------------------- commit b53c95fe621d3a66a82e6dad383e1c0c08f3871e Author: Herbert Valerio Riedel Date: Sat Sep 13 11:56:37 2014 +0200 Move ($!) from Prelude into GHC.Base I don't see any reason why this needs to be in Prelude, where it makes life harder to avoid import cycles involving Prelude. Ideally, the `Prelude` module should only re-export entities from other modules, and not define anything on its own. So this moves `($!)` close to the definition of its `($)` cousin. >--------------------------------------------------------------- b53c95fe621d3a66a82e6dad383e1c0c08f3871e libraries/base/GHC/Base.lhs | 6 +++++- libraries/base/Prelude.hs | 8 -------- 2 files changed, 5 insertions(+), 9 deletions(-) diff --git a/libraries/base/GHC/Base.lhs b/libraries/base/GHC/Base.lhs index 3ee533d..9fe148e 100644 --- a/libraries/base/GHC/Base.lhs +++ b/libraries/base/GHC/Base.lhs @@ -121,7 +121,7 @@ infixr 9 . infixr 5 ++ infixl 4 <$ infixl 1 >>, >>= -infixr 0 $ +infixr 0 $, $! infixl 4 <*>, <*, *>, <**> @@ -841,6 +841,10 @@ flip f x y = f y x ($) :: (a -> b) -> a -> b f $ x = f x +-- | Strict (call-by-value) application, defined in terms of 'seq'. +($!) :: (a -> b) -> a -> b +f $! x = let !vx = x in f vx -- see #2273 + -- | @'until' p f@ yields the result of applying @f@ until @p@ holds. until :: (a -> Bool) -> (a -> a) -> a -> a until p f = go diff --git a/libraries/base/Prelude.hs b/libraries/base/Prelude.hs index 12fe189..12a3d8f 100644 --- a/libraries/base/Prelude.hs +++ b/libraries/base/Prelude.hs @@ -151,14 +151,6 @@ import GHC.Real import GHC.Float import GHC.Show -infixr 0 $! - --- ----------------------------------------------------------------------------- --- Miscellaneous functions - --- | Strict (call-by-value) application, defined in terms of 'seq'. -($!) :: (a -> b) -> a -> b -f $! x = let !vx = x in f vx -- see #2273 #ifdef __HADDOCK__ -- | The value of @'seq' a b@ is bottom if @a@ is bottom, and otherwise From git at git.haskell.org Sat Sep 13 11:23:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Sep 2014 11:23:36 +0000 (UTC) Subject: [commit: packages/haskell2010] master: Hide ($!) from GHC.Base (afec9dc) Message-ID: <20140913112336.D9B713A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell2010 On branch : master Link : http://git.haskell.org/packages/haskell2010.git/commitdiff/afec9dc90b5a7c86093dcbf30fb3c56886aaa1c0 >--------------------------------------------------------------- commit afec9dc90b5a7c86093dcbf30fb3c56886aaa1c0 Author: Herbert Valerio Riedel Date: Sat Sep 13 13:22:19 2014 +0200 Hide ($!) from GHC.Base See also [b53c95fe621d3a66a82e6dad383e1c0c08f3871e/ghc] >--------------------------------------------------------------- afec9dc90b5a7c86093dcbf30fb3c56886aaa1c0 Prelude.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Prelude.hs b/Prelude.hs index 21092e8..b9b3b45 100644 --- a/Prelude.hs +++ b/Prelude.hs @@ -140,7 +140,7 @@ import "base" Data.Tuple #endif #ifdef __GLASGOW_HASKELL__ -import GHC.Base +import GHC.Base hiding ( ($!) ) -- import GHC.IO -- import GHC.IO.Exception import Text.Read From git at git.haskell.org Sat Sep 13 11:24:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Sep 2014 11:24:11 +0000 (UTC) Subject: [commit: packages/haskell98] master: Hide ($!) from GHC.Base (a97ea9f) Message-ID: <20140913112411.D8B8B3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell98 On branch : master Link : http://git.haskell.org/packages/haskell98.git/commitdiff/a97ea9fa765b4d8afe44d92470519719a4ede295 >--------------------------------------------------------------- commit a97ea9fa765b4d8afe44d92470519719a4ede295 Author: Herbert Valerio Riedel Date: Sat Sep 13 13:23:53 2014 +0200 Hide ($!) from GHC.Base See also [b53c95fe621d3a66a82e6dad383e1c0c08f3871e/ghc] >--------------------------------------------------------------- a97ea9fa765b4d8afe44d92470519719a4ede295 Prelude.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Prelude.hs b/Prelude.hs index 4c69a63..f947e7e 100644 --- a/Prelude.hs +++ b/Prelude.hs @@ -141,7 +141,7 @@ import "base" Data.Tuple #endif #ifdef __GLASGOW_HASKELL__ -import GHC.Base +import GHC.Base hiding ( ($!) ) -- import GHC.IO -- import GHC.IO.Exception import Text.Read From git at git.haskell.org Sat Sep 13 11:25:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Sep 2014 11:25:55 +0000 (UTC) Subject: [commit: ghc] master: Follow-up to b53c95fe621d3a66a82e6dad383e1c0c08f3871e (45cd30d) Message-ID: <20140913112555.595B33A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/45cd30d697102817aa4ba27fc9db7aae87049e1f/ghc >--------------------------------------------------------------- commit 45cd30d697102817aa4ba27fc9db7aae87049e1f Author: Herbert Valerio Riedel Date: Sat Sep 13 13:24:38 2014 +0200 Follow-up to b53c95fe621d3a66a82e6dad383e1c0c08f3871e Forgot to fix-up the `haskell2010` and `haskell98` submodules in the previous commit >--------------------------------------------------------------- 45cd30d697102817aa4ba27fc9db7aae87049e1f libraries/haskell2010 | 2 +- libraries/haskell98 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/haskell2010 b/libraries/haskell2010 index acf64b6..afec9dc 160000 --- a/libraries/haskell2010 +++ b/libraries/haskell2010 @@ -1 +1 @@ -Subproject commit acf64b69b05aab78d67461facaf83d4473c05959 +Subproject commit afec9dc90b5a7c86093dcbf30fb3c56886aaa1c0 diff --git a/libraries/haskell98 b/libraries/haskell98 index 543642a..a97ea9f 160000 --- a/libraries/haskell98 +++ b/libraries/haskell98 @@ -1 +1 @@ -Subproject commit 543642a054623ce4c5d681dae63be33983ec6712 +Subproject commit a97ea9fa765b4d8afe44d92470519719a4ede295 From git at git.haskell.org Sat Sep 13 13:02:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Sep 2014 13:02:34 +0000 (UTC) Subject: [commit: ghc] master: Fixup test-case broken by Follow-up to b53c95fe621 (6999223) Message-ID: <20140913130234.7A00D3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6999223fbb95046fe08562559bba1fdeb7d16795/ghc >--------------------------------------------------------------- commit 6999223fbb95046fe08562559bba1fdeb7d16795 Author: Herbert Valerio Riedel Date: Sat Sep 13 15:01:16 2014 +0200 Fixup test-case broken by Follow-up to b53c95fe621 >--------------------------------------------------------------- 6999223fbb95046fe08562559bba1fdeb7d16795 testsuite/tests/ghci/scripts/T5545.stdout | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/ghci/scripts/T5545.stdout b/testsuite/tests/ghci/scripts/T5545.stdout index 6a72f59..2262c35 100644 --- a/testsuite/tests/ghci/scripts/T5545.stdout +++ b/testsuite/tests/ghci/scripts/T5545.stdout @@ -1,2 +1,2 @@ -($!) :: (a -> b) -> a -> b -- Defined in ?Prelude? +($!) :: (a -> b) -> a -> b -- Defined in ?GHC.Base? infixr 0 $! From git at git.haskell.org Sat Sep 13 16:43:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Sep 2014 16:43:46 +0000 (UTC) Subject: [commit: ghc] master: Move docstring of `seq` to primops.txt.pp (abff2ff) Message-ID: <20140913164346.3BD983A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/abff2ffd2d6e30b93daa0def282b9fc0795ad10d/ghc >--------------------------------------------------------------- commit abff2ffd2d6e30b93daa0def282b9fc0795ad10d Author: Herbert Valerio Riedel Date: Sat Sep 13 18:14:55 2014 +0200 Move docstring of `seq` to primops.txt.pp The documentation for `seq` was recently augmented via #9390 & cbfa107604f4cbfaf02bd633c1faa6ecb90c6dd7. However, it doesn't show up in the Haddock generated docs because `#ifdef __HADDOCK__` doesn't work as expected. Also, it's easier to just fix the problem at the origin (which in this is case is the primops.txt.pp file). The benefit/downside of this is that now the extended documentation shows up everywhere `seq` is re-exported directly. >--------------------------------------------------------------- abff2ffd2d6e30b93daa0def282b9fc0795ad10d compiler/prelude/primops.txt.pp | 13 +++++++++++-- libraries/base/Prelude.hs | 16 ---------------- 2 files changed, 11 insertions(+), 18 deletions(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index d5566fe..b1a42b3 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2551,8 +2551,17 @@ pseudoop "proxy#" pseudoop "seq" a -> b -> b - { Evaluates its first argument to head normal form, and then returns its second - argument as the result. } + { The value of {\tt seq a b} is bottom if {\tt a} is bottom, and + otherwise equal to {\tt b}. {\tt seq} is usually introduced to + improve performance by avoiding unneeded laziness. + + A note on evaluation order: the expression {\tt seq a b} does + {\it not} guarantee that {\tt a} will be evaluated before {\tt b}. + The only guarantee given by {\tt seq} is that the both {\tt a} + and {\tt b} will be evaluated before {\tt seq} returns a value. + In particular, this means that {\tt b} may be evaluated before + {\tt a}. If you need to guarantee a specific order of evaluation, + you must use the function {\tt pseq} from the "parallel" package. } primtype Any { The type constructor {\tt Any} is type to which you can unsafely coerce any diff --git a/libraries/base/Prelude.hs b/libraries/base/Prelude.hs index 12a3d8f..f58cd17 100644 --- a/libraries/base/Prelude.hs +++ b/libraries/base/Prelude.hs @@ -150,19 +150,3 @@ import GHC.Num import GHC.Real import GHC.Float import GHC.Show - - -#ifdef __HADDOCK__ --- | The value of @'seq' a b@ is bottom if @a@ is bottom, and otherwise --- equal to @b at . 'seq' is usually introduced to improve performance by --- avoiding unneeded laziness. --- --- A note on evaluation order: the expression @seq a b@ does /not/ guarantee --- that @a@ will be evaluated before @b at . The only guarantee given by @seq@ is --- that the both @a@ and @b@ will be evaluated before @seq@ returns a value. In --- particular, this means that @b@ may be evaluated before @a at . If you need to --- guarantee a specific order of evaluation, you must use the function @pseq@ --- from the parallel package. -seq :: a -> b -> b -seq _ y = y -#endif From git at git.haskell.org Sat Sep 13 16:43:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Sep 2014 16:43:49 +0000 (UTC) Subject: [commit: ghc] master: Detabify primops.txt.pp (2cd76c1) Message-ID: <20140913164349.2C4C53A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2cd76c156b161eb6a60a765088107186322d8c8c/ghc >--------------------------------------------------------------- commit 2cd76c156b161eb6a60a765088107186322d8c8c Author: Herbert Valerio Riedel Date: Sat Sep 13 18:34:08 2014 +0200 Detabify primops.txt.pp >--------------------------------------------------------------- 2cd76c156b161eb6a60a765088107186322d8c8c compiler/prelude/primops.txt.pp | 356 ++++++++++++++++++++-------------------- 1 file changed, 178 insertions(+), 178 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2cd76c156b161eb6a60a765088107186322d8c8c From git at git.haskell.org Sat Sep 13 17:19:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Sep 2014 17:19:38 +0000 (UTC) Subject: [commit: packages/haskell2010] master: Kill CPP conditionals for HUGS and old GHCs (8d5301d) Message-ID: <20140913171938.6DA663A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell2010 On branch : master Link : http://git.haskell.org/packages/haskell2010.git/commitdiff/8d5301d03f2bb945ef3c7d975dcff3a4d93a0adf >--------------------------------------------------------------- commit 8d5301d03f2bb945ef3c7d975dcff3a4d93a0adf Author: Herbert Valerio Riedel Date: Sat Sep 13 18:47:54 2014 +0200 Kill CPP conditionals for HUGS and old GHCs It would seem strange to want to use `haskell2010` with Hugs which never gained support for Haskell2010, so this commit removes that bitrotting part of Prelude.hs. This reduces the CPP clutter to the point of not requiring any CPP processing altogether anymore. >--------------------------------------------------------------- 8d5301d03f2bb945ef3c7d975dcff3a4d93a0adf Prelude.hs | 46 +++------------------------------------------- haskell2010.cabal | 2 +- 2 files changed, 4 insertions(+), 44 deletions(-) diff --git a/Prelude.hs b/Prelude.hs index b9b3b45..a0f0700 100644 --- a/Prelude.hs +++ b/Prelude.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE BangPatterns, CPP, NoImplicitPrelude, PackageImports #-} -#if __GLASGOW_HASKELL__ >= 701 -{-# LANGUAGE Trustworthy #-} -#endif +{-# LANGUAGE BangPatterns, NoImplicitPrelude, PackageImports, Trustworthy #-} -- | -- The Haskell 2010 Prelude: a standard module imported by default @@ -27,10 +24,6 @@ module Prelude ( -- *** Tuples fst, snd, curry, uncurry, -#ifdef __HUGS__ - (:), -- Not legal Haskell 98 -#endif - -- ** Basic type classes Eq((==), (/=)), Ord(compare, (<), (<=), (>=), (>), max, min), @@ -128,7 +121,6 @@ module Prelude ( ) where -#ifndef __HUGS__ import qualified "base" Control.Exception.Base as New (catch) import "base" Control.Monad import "base" System.IO @@ -137,12 +129,8 @@ import "base" Data.List hiding ( splitAt ) import "base" Data.Either import "base" Data.Maybe import "base" Data.Tuple -#endif -#ifdef __GLASGOW_HASKELL__ -import GHC.Base hiding ( ($!) ) --- import GHC.IO --- import GHC.IO.Exception +import GHC.Base import Text.Read import GHC.Enum import GHC.Num @@ -150,35 +138,10 @@ import GHC.Real hiding ( gcd ) import qualified GHC.Real ( gcd ) import GHC.Float import GHC.Show -#endif - -#ifdef __HUGS__ -import Hugs.Prelude -#endif - -#ifndef __HUGS__ -infixr 0 $! -#endif -- ----------------------------------------------------------------------------- -- Miscellaneous functions --- | Strict (call-by-value) application, defined in terms of 'seq'. -($!) :: (a -> b) -> a -> b -#ifdef __GLASGOW_HASKELL__ -f $! x = let !vx = x in f vx -- see #2273 -#elif !defined(__HUGS__) -f $! x = x `seq` f x -#endif - -#ifdef __HADDOCK__ --- | The value of @'seq' a b@ is bottom if @a@ is bottom, and otherwise --- equal to @b at . 'seq' is usually introduced to improve performance by --- avoiding unneeded laziness. -seq :: a -> b -> b -seq _ y = y -#endif - -- | The 'catch' function establishes a handler that receives any -- 'IOError' raised in the action protected by 'catch'. -- An 'IOError' is caught by @@ -202,16 +165,13 @@ seq _ y = y catch :: IO a -> (IOError -> IO a) -> IO a catch = New.catch -#ifdef __GLASGOW_HASKELL__ -- | @'gcd' x y@ is the greatest (positive) integer that divides both @x@ -- and @y@; for example @'gcd' (-3) 6@ = @3@, @'gcd' (-3) (-6)@ = @3@, -- @'gcd' 0 4@ = @4 at . @'gcd' 0 0@ raises a runtime error. gcd :: (Integral a) => a -> a -> a gcd 0 0 = error "Prelude.gcd: gcd 0 0 is undefined" gcd x y = GHC.Real.gcd x y -#endif -#ifndef __HUGS__ -- The GHC's version of 'splitAt' is too strict in 'n' compared to -- Haskell98/2010 version. Ticket #1182. @@ -231,4 +191,4 @@ gcd x y = GHC.Real.gcd x y -- in which @n@ may be of any integral type. splitAt :: Int -> [a] -> ([a],[a]) splitAt n xs = (take n xs, drop n xs) -#endif + diff --git a/haskell2010.cabal b/haskell2010.cabal index cb8d539..976c33c 100644 --- a/haskell2010.cabal +++ b/haskell2010.cabal @@ -34,7 +34,7 @@ Library build-depends: array >= 0.5 && < 0.6, - base >= 4.7 && < 4.9 + base >= 4.8 && < 4.9 -- this hack adds a dependency on ghc-prim for Haddock. The GHC -- build system doesn't seem to track transitive dependencies when From git at git.haskell.org Sat Sep 13 17:20:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Sep 2014 17:20:00 +0000 (UTC) Subject: [commit: ghc] master: Update haskell2010 submodule (5fbd4e36) Message-ID: <20140913172000.1E4663A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5fbd4e3677e3c8f4fed021efb00e5c4780061567/ghc >--------------------------------------------------------------- commit 5fbd4e3677e3c8f4fed021efb00e5c4780061567 Author: Herbert Valerio Riedel Date: Sat Sep 13 19:10:02 2014 +0200 Update haskell2010 submodule ...to kill "Kill CPP conditionals for HUGS and old GHCs" >--------------------------------------------------------------- 5fbd4e3677e3c8f4fed021efb00e5c4780061567 libraries/haskell2010 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/haskell2010 b/libraries/haskell2010 index afec9dc..8d5301d 160000 --- a/libraries/haskell2010 +++ b/libraries/haskell2010 @@ -1 +1 @@ -Subproject commit afec9dc90b5a7c86093dcbf30fb3c56886aaa1c0 +Subproject commit 8d5301d03f2bb945ef3c7d975dcff3a4d93a0adf From git at git.haskell.org Sat Sep 13 18:13:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Sep 2014 18:13:57 +0000 (UTC) Subject: [commit: libffi-tarballs] master: Replace libffi-3.0.11 by libffi-3.1 release (b6658e5) Message-ID: <20140913181357.3FB223A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/libffi-tarballs On branch : master Link : http://git.haskell.org/libffi-tarballs.git/commitdiff/b6658e5d73eb0579b3054593de21f329ab491e77 >--------------------------------------------------------------- commit b6658e5d73eb0579b3054593de21f329ab491e77 Author: Herbert Valerio Riedel Date: Sat Sep 13 19:44:55 2014 +0200 Replace libffi-3.0.11 by libffi-3.1 release libffi 3.1 was released in May 2014, with the following changes - Add AArch64 (ARM64) iOS support. - Add Nios II support. - Add m88k and DEC VAX support. - Add support for stdcall, thiscall, and fastcall on non-Windows 32-bit x86 targets such as Linux. - Various Android, MIPS N32, x86, FreeBSD and UltraSPARC IIi fixes. - Make the testsuite more robust: eliminate several spurious failures, and respect the $CC and $CXX environment variables. - Archive off the manually maintained ChangeLog in favor of git log. The libffi-3.1.tar.gz tarball was retrieved from ftp://sourceware.org/pub/libffi/libffi-3.1.tar.gz and has the following checksums md5sum f5898b29bbfd70502831a212d9249d10 sha1sum cb373ef2115ec7c57913b84ca72eee14b10ccdc3 sha256sum 97feeeadca5e21870fa4433bc953d1b3af3f698d5df8a428f68b73cd60aef6eb >--------------------------------------------------------------- b6658e5d73eb0579b3054593de21f329ab491e77 libffi-3.0.11.tar.gz | Bin 794220 -> 0 bytes libffi-3.1.tar.gz | Bin 0 -> 937214 bytes 2 files changed, 0 insertions(+), 0 deletions(-) diff --git a/libffi-3.0.11.tar.gz b/libffi-3.0.11.tar.gz deleted file mode 100644 index e133230..0000000 Binary files a/libffi-3.0.11.tar.gz and /dev/null differ diff --git a/libffi-3.1.tar.gz b/libffi-3.1.tar.gz new file mode 100644 index 0000000..fed33dc Binary files /dev/null and b/libffi-3.1.tar.gz differ From git at git.haskell.org Sat Sep 13 18:14:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Sep 2014 18:14:45 +0000 (UTC) Subject: [commit: ghc] master: Update libffi-tarballs submodule to libffi 3.1 (re #8701) (39e206a) Message-ID: <20140913181445.93C3A3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/39e206a7badd18792a7c8159cff732c63a9b19e7/ghc >--------------------------------------------------------------- commit 39e206a7badd18792a7c8159cff732c63a9b19e7 Author: Herbert Valerio Riedel Date: Sat Sep 13 19:55:25 2014 +0200 Update libffi-tarballs submodule to libffi 3.1 (re #8701) >--------------------------------------------------------------- 39e206a7badd18792a7c8159cff732c63a9b19e7 libffi-tarballs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libffi-tarballs b/libffi-tarballs index a0088d1..b6658e5 160000 --- a/libffi-tarballs +++ b/libffi-tarballs @@ -1 +1 @@ -Subproject commit a0088d1da0e171849ddb47a46c869856037a01d1 +Subproject commit b6658e5d73eb0579b3054593de21f329ab491e77 From git at git.haskell.org Sun Sep 14 11:47:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Sep 2014 11:47:03 +0000 (UTC) Subject: [commit: ghc] master: Tweak perf-numbers for T1969 and T4801 (004c5f4) Message-ID: <20140914114703.E80B03A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/004c5f4fec78414943d788c2a8b42a4500272949/ghc >--------------------------------------------------------------- commit 004c5f4fec78414943d788c2a8b42a4500272949 Author: Herbert Valerio Riedel Date: Sun Sep 14 12:33:57 2014 +0200 Tweak perf-numbers for T1969 and T4801 Right now, Phab's buildbot complains about Unexpected failures: perf/compiler T1969 [stat too good] (normal) perf/compiler T4801 [stat not good enough] (normal) However, on my workstation, those tests don't fail (c.f. P14). So this commit tries to blindly tweak those numbers and see if if Phabricator succeeds to build this code-revision... Test Plan: Let Harbormaster build it Reviewers: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D210 >--------------------------------------------------------------- 004c5f4fec78414943d788c2a8b42a4500272949 testsuite/tests/perf/compiler/all.T | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index af13b00..f71204f 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -33,15 +33,16 @@ test('T1969', # 2013-02-10 13 (x86/Windows) # 2013-02-10 14 (x86/OSX) # 2013-11-13 17 (x86/Windows, 64bit machine) - (wordsize(64), 30, 15)]), + (wordsize(64), 30, 20)]), # 28 (amd64/Linux) # 34 (amd64/Linux) # 2012-09-20 23 (amd64/Linux) # 2012-10-03 25 (amd64/Linux if .hi exists) # 2013-02-13 23, but unstable so increased to 10% range # 2013-02-13 27, very unstable! - # 2013-09-11 30 (amd64/Linux) # 2014-09-10 29 (amd64/Linux) post-AMP-cleanup + # 2013-09-11 30, 10 (amd64/Linux) + # 2013-09-11 30, 15 (adapt to Phab CI) compiler_stats_num_field('max_bytes_used', [(platform('i386-unknown-mingw32'), 5719436, 20), # 2010-05-17 5717704 (x86/Windows) @@ -54,13 +55,14 @@ test('T1969', # 2009-12-31 6149572 (x86/Linux) # 2014-01-22 6429864 (x86/Linux) # 2014-06-29 5949188 (x86/Linux) - (wordsize(64), 10463640, 10)]), + (wordsize(64), 9684256, 10)]), # 2014-09-10 10463640, 10 # post-AMP-update (somewhat stabelish) # looks like the peak is around ~10M, but we're # unlikely to GC exactly on the peak. # varies quite a lot with CLEANUP and BINDIST, # hence 10% range. # See Note [residency] to get an accurate view. + # 2014-09-14 9684256, 10 # try to lower it a bit more to match Phab's CI compiler_stats_num_field('bytes allocated', [(platform('i386-unknown-mingw32'), 301784492, 5), # 215582916 (x86/Windows) @@ -202,7 +204,7 @@ test('T4801', # 2013-02-10: 11207828 (x86/OSX) # (some date): 11139444 # 2013-11-13: 11829000 (x86/Windows, 64bit machine) - (wordsize(64), 19296544, 10)]), + (wordsize(64), 19296544, 15)]), # prev: 20486256 (amd64/OS X) # 30/08/2012: 17305600--20391920 (varies a lot) # 19/10/2012: 26882576 (-fPIC turned on) @@ -212,7 +214,8 @@ test('T4801', # 13/01/2014: 22646000 (mostly due to #8647) # 18/02/2014: 25002136 (call arity analysis changes) # 12/05/2014: 25002136 (specialisation and inlining changes) - # 10/09/2014: 19296544 (post-AMP-cleanup) + # 10/09/2014: 19296544, 10 (post-AMP-cleanup) + # 14/09/2014: 19585456, 15 (adapt to Phab CI env) only_ways(['normal']), extra_hc_opts('-static') ], From git at git.haskell.org Sun Sep 14 14:25:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Sep 2014 14:25:45 +0000 (UTC) Subject: [commit: ghc] branch 'context-quantification-4426' created Message-ID: <20140914142545.33B8E3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : context-quantification-4426 Referencing: 8fe3aef91a762e0a81fdbe5faa689ca17d845222 From git at git.haskell.org Sun Sep 14 14:25:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Sep 2014 14:25:47 +0000 (UTC) Subject: [commit: ghc] context-quantification-4426: Split SpliceExplicitFlag off HsExplicitFlag (c143a93) Message-ID: <20140914142547.BA01B3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : context-quantification-4426 Link : http://ghc.haskell.org/trac/ghc/changeset/c143a93b00cc350f67db612f2c45047390ba77e6/ghc >--------------------------------------------------------------- commit c143a93b00cc350f67db612f2c45047390ba77e6 Author: Krzysztof Gogolewski Date: Sun Sep 14 13:17:27 2014 +0200 Split SpliceExplicitFlag off HsExplicitFlag SpliceExplicitFlag is used for TH splice explicitness, while HsExplicitFlag for type variable quantification. >--------------------------------------------------------------- c143a93b00cc350f67db612f2c45047390ba77e6 compiler/hsSyn/HsDecls.lhs | 8 ++++++-- compiler/parser/RdrHsSyn.lhs | 4 ++-- compiler/rename/RnSource.lhs | 8 ++++---- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs index f584372..a990d75 100644 --- a/compiler/hsSyn/HsDecls.lhs +++ b/compiler/hsSyn/HsDecls.lhs @@ -49,6 +49,7 @@ module HsDecls ( -- ** @default@ declarations DefaultDecl(..), LDefaultDecl, -- ** Template haskell declaration splice + SpliceExplicitFlag(..), SpliceDecl(..), LSpliceDecl, -- ** Foreign function interface declarations ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..), @@ -291,12 +292,15 @@ instance OutputableBndr name => Outputable (HsGroup name) where vcat_mb gap (Nothing : ds) = vcat_mb gap ds vcat_mb gap (Just d : ds) = gap $$ d $$ vcat_mb blankLine ds +data SpliceExplicitFlag = ExplicitSplice | -- <=> $(f x y) + ImplicitSplice -- <=> f x y, i.e. a naked top level expression + deriving (Data, Typeable) + type LSpliceDecl name = Located (SpliceDecl name) data SpliceDecl id = SpliceDecl -- Top level splice (Located (HsSplice id)) - HsExplicitFlag -- Explicit <=> $(f x y) - -- Implicit <=> f x y, i.e. a naked top level expression + SpliceExplicitFlag deriving (Typeable) deriving instance (DataId id) => Data (SpliceDecl id) diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index b13251c..823be85 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -256,8 +256,8 @@ mkSpliceDecl :: LHsExpr RdrName -> HsDecl RdrName mkSpliceDecl lexpr@(L loc expr) | HsQuasiQuoteE qq <- expr = QuasiQuoteD qq | HsSpliceE is_typed splice <- expr = ASSERT( not is_typed ) - SpliceD (SpliceDecl (L loc splice) Explicit) - | otherwise = SpliceD (SpliceDecl (L loc splice) Implicit) + SpliceD (SpliceDecl (L loc splice) ExplicitSplice) + | otherwise = SpliceD (SpliceDecl (L loc splice) ImplicitSplice) where splice = mkHsSplice lexpr diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs index 2dc71db..aa26b02 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -1471,10 +1471,10 @@ add gp loc (SpliceD splice@(SpliceDecl _ flag)) ds = do { -- We've found a top-level splice. If it is an *implicit* one -- (i.e. a naked top level expression) case flag of - Explicit -> return () - Implicit -> do { th_on <- xoptM Opt_TemplateHaskell - ; unless th_on $ setSrcSpan loc $ - failWith badImplicitSplice } + ExplicitSplice -> return () + ImplicitSplice -> do { th_on <- xoptM Opt_TemplateHaskell + ; unless th_on $ setSrcSpan loc $ + failWith badImplicitSplice } ; return (gp, Just (splice, ds)) } where From git at git.haskell.org Sun Sep 14 14:25:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Sep 2014 14:25:51 +0000 (UTC) Subject: [commit: ghc] context-quantification-4426: Add -fwarn-context-quantification (#4426) (8fe3aef) Message-ID: <20140914142551.007DF3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : context-quantification-4426 Link : http://ghc.haskell.org/trac/ghc/changeset/8fe3aef91a762e0a81fdbe5faa689ca17d845222/ghc >--------------------------------------------------------------- commit 8fe3aef91a762e0a81fdbe5faa689ca17d845222 Author: Krzysztof Gogolewski Date: Sun Sep 14 16:09:16 2014 +0200 Add -fwarn-context-quantification (#4426) This warning (enabled by default) reports places where a context implicitly binds a type variable, for example type T a = {-forall m.-} Monad m => a -> m a >--------------------------------------------------------------- 8fe3aef91a762e0a81fdbe5faa689ca17d845222 compiler/hsSyn/HsTypes.lhs | 27 ++++++++---- compiler/main/DynFlags.hs | 5 ++- compiler/main/GhcMonad.hs | 2 +- compiler/parser/Parser.y.pp | 6 +-- compiler/rename/RnSource.lhs | 5 +++ compiler/rename/RnTypes.lhs | 48 +++++++++++++++++++++- docs/users_guide/glasgow_exts.xml | 21 +++++----- docs/users_guide/using.xml | 26 +++++++++++- testsuite/tests/rename/should_compile/T4426.hs | 22 ++++++++++ testsuite/tests/rename/should_compile/T4426.stderr | 30 ++++++++++++++ testsuite/tests/rename/should_compile/all.T | 1 + testsuite/tests/th/T7021a.hs | 4 +- testsuite/tests/th/T8807.hs | 4 +- testsuite/tests/typecheck/should_compile/T3018.hs | 2 +- testsuite/tests/typecheck/should_compile/tc092.hs | 2 +- 15 files changed, 170 insertions(+), 35 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8fe3aef91a762e0a81fdbe5faa689ca17d845222 From git at git.haskell.org Mon Sep 15 06:39:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Sep 2014 06:39:01 +0000 (UTC) Subject: [commit: ghc] master: Export `Traversable()` and `Foldable()` from Prelude (c0fa383) Message-ID: <20140915063901.7FB713A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c0fa383d9109800a4e46a81b418f1794030ba1bd/ghc >--------------------------------------------------------------- commit c0fa383d9109800a4e46a81b418f1794030ba1bd Author: Herbert Valerio Riedel Date: Mon Sep 15 08:37:30 2014 +0200 Export `Traversable()` and `Foldable()` from Prelude This exposes *only* the type-classes w/o any of their methods. This is the very first step for implementing BPP (see #9586), which already requires breaking up several import-cycles leading back to `Prelude`. Ideally, importing `Prelude` should be avoided in most `base` modules, as `Prelude` does not define any entities, but rather re-exports existing ones. Test Plan: validate passes Reviewers: ekmett, austin Reviewed By: ekmett, austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D209 GHC Trac Issues: #9586 >--------------------------------------------------------------- c0fa383d9109800a4e46a81b418f1794030ba1bd compiler/hsSyn/HsDecls.lhs | 7 ++-- compiler/utils/BooleanFormula.hs | 4 +++ libraries/base/Control/Applicative.hs | 17 +++++++--- libraries/base/Control/Arrow.hs | 6 ++-- libraries/base/Control/Category.hs | 7 ++-- libraries/base/Control/Monad/Fix.hs | 11 +++++-- libraries/base/Data/Data.hs | 19 +++++++---- libraries/base/Data/Foldable.hs | 37 ++++++++++++---------- libraries/base/Data/Function.hs | 5 +-- libraries/base/Data/Functor.hs | 3 +- libraries/base/Data/Traversable.hs | 18 +++++++---- libraries/base/Data/Version.hs | 20 +++++++----- libraries/base/Debug/Trace.hs | 6 ++-- libraries/base/GHC/Exts.hs | 6 ++-- libraries/base/GHC/Stack.hsc | 5 ++- libraries/base/Prelude.hs | 5 +++ testsuite/tests/ghci/scripts/T4175.stdout | 2 ++ testsuite/tests/ghci/scripts/T7627.stdout | 2 ++ testsuite/tests/ghci/scripts/ghci011.stdout | 4 +++ testsuite/tests/perf/compiler/all.T | 9 ++++-- .../tests/typecheck/should_compile/FD2.stderr | 4 +-- 21 files changed, 131 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 c0fa383d9109800a4e46a81b418f1794030ba1bd From git at git.haskell.org Mon Sep 15 10:04:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Sep 2014 10:04:46 +0000 (UTC) Subject: [commit: ghc] master: base: Remove bunk default impl of (>>=) (df2fa25) Message-ID: <20140915100446.45DA13A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/df2fa25aa6e8ccc2bf2f0b9085bbb0f63b23c9c3/ghc >--------------------------------------------------------------- commit df2fa25aa6e8ccc2bf2f0b9085bbb0f63b23c9c3 Author: Austin Seipp Date: Sun Sep 14 20:35:09 2014 -0500 base: Remove bunk default impl of (>>=) Without 'join' as a part of Monad, this default implementation is bogus, and is a leftover from d94de87252d0fe2ae9. Signed-off-by: Austin Seipp >--------------------------------------------------------------- df2fa25aa6e8ccc2bf2f0b9085bbb0f63b23c9c3 libraries/base/GHC/Base.lhs | 1 - 1 file changed, 1 deletion(-) diff --git a/libraries/base/GHC/Base.lhs b/libraries/base/GHC/Base.lhs index 9fe148e..94c9404 100644 --- a/libraries/base/GHC/Base.lhs +++ b/libraries/base/GHC/Base.lhs @@ -413,7 +413,6 @@ class Applicative m => Monad m where -- | Sequentially compose two actions, passing any value produced -- by the first as an argument to the second. (>>=) :: forall a b. m a -> (a -> m b) -> m b - m >>= f = join (fmap f m) -- | Sequentially compose two actions, discarding any value produced -- by the first, like sequencing operators (such as the semicolon) From git at git.haskell.org Mon Sep 15 10:04:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Sep 2014 10:04:49 +0000 (UTC) Subject: [commit: ghc] master: base: Add some notes about the default impl of '(>>)' (65f887e) Message-ID: <20140915100449.0265C3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/65f887e1a0d864526f6a2609a3afc2c151c25e38/ghc >--------------------------------------------------------------- commit 65f887e1a0d864526f6a2609a3afc2c151c25e38 Author: Austin Seipp Date: Mon Sep 15 05:02:21 2014 -0500 base: Add some notes about the default impl of '(>>)' See Note [Recursive bindings for Applicative/Monad]. This documents the tricky little details that kept me occupied for so long with this patch, and why exactly we deviate from the original proposal. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 65f887e1a0d864526f6a2609a3afc2c151c25e38 libraries/base/GHC/Base.lhs | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/Base.lhs b/libraries/base/GHC/Base.lhs index 94c9404..3267bbf 100644 --- a/libraries/base/GHC/Base.lhs +++ b/libraries/base/GHC/Base.lhs @@ -418,7 +418,7 @@ class Applicative m => Monad m where -- by the first, like sequencing operators (such as the semicolon) -- in imperative languages. (>>) :: forall a b. m a -> m b -> m b - m >> k = m >>= \_ -> k + m >> k = m >>= \_ -> k -- See Note [Recursive bindings for Applicative/Monad] {-# INLINE (>>) #-} -- | Inject a value into the monadic type. @@ -430,6 +430,28 @@ class Applicative m => Monad m where fail :: String -> m a fail s = error s +{- Note [Recursive bindings for Applicative/Monad] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The original Applicative/Monad proposal stated that after +implementation, the designated implementation of (>>) would become + + (>>) :: forall a b. m a -> m b -> m b + (>>) = (*>) + +by default. You might be inclined to change this to reflect the stated +proposal, but you really shouldn't! Why? Because people tend to define +such instances the /other/ way around: in particular, it is perfectly +legitimate to define an instance of Applicative (*>) in terms of (>>), +which would lead to an infinite loop for the default implementation of +Monad! And people do this in the wild. + +This turned into a nasty bug that was tricky to track down, and rather +than eliminate it everywhere upstream, it's easier to just retain the +original default. + +-} + -- | Promote a function to a monad. liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r liftM f m1 = do { x1 <- m1; return (f x1) } From git at git.haskell.org Mon Sep 15 20:15:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Sep 2014 20:15:23 +0000 (UTC) Subject: [commit: ghc] master: Don't offer hidden modules for autocomplete. (b72478f) Message-ID: <20140915201523.9C0863A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b72478f41b85337b84edab8f625d103e197f116c/ghc >--------------------------------------------------------------- commit b72478f41b85337b84edab8f625d103e197f116c Author: Edward Z. Yang Date: Mon Sep 15 13:14:30 2014 -0700 Don't offer hidden modules for autocomplete. It was annoying to test GHCi directly, so I added a ghc-api unit test of the function instead. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- b72478f41b85337b84edab8f625d103e197f116c compiler/main/Packages.lhs | 3 ++- testsuite/.gitignore | 1 + testsuite/tests/ghc-api/T9595.hs | 23 ++++++++++++++++++++++ .../cgrun056.stdout => ghc-api/T9595.stdout} | 0 testsuite/tests/ghc-api/all.T | 1 + 5 files changed, 27 insertions(+), 1 deletion(-) diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index c14c8cf..a6a61e9 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -1304,7 +1304,8 @@ lookupModuleWithSuggestions dflags m mb_pn listVisibleModuleNames :: DynFlags -> [ModuleName] listVisibleModuleNames dflags = - Map.keys (moduleToPkgConfAll (pkgState dflags)) + map fst (filter visible (Map.toList (moduleToPkgConfAll (pkgState dflags)))) + where visible (_, ms) = any originVisible (Map.elems ms) -- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of -- 'PackageConfig's diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 4f8ac87..e8b83e8 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -688,6 +688,7 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/ghc-api/T7478/T7478 /tests/ghc-api/T8628 /tests/ghc-api/T8639_api +/tests/ghc-api/T9595 /tests/ghc-api/apirecomp001/myghc /tests/ghc-api/dynCompileExpr/dynCompileExpr /tests/ghc-api/ghcApi diff --git a/testsuite/tests/ghc-api/T9595.hs b/testsuite/tests/ghc-api/T9595.hs new file mode 100644 index 0000000..b6c336a --- /dev/null +++ b/testsuite/tests/ghc-api/T9595.hs @@ -0,0 +1,23 @@ +module Main where + +import GHC +import Packages +import GhcMonad +import Outputable +import System.Environment +import DynFlags +import Module + +main = + do [libdir] <- getArgs + _ <- runGhc (Just libdir) $ do + dflags <- getSessionDynFlags + setSessionDynFlags dflags + dflags <- getSessionDynFlags + liftIO $ print (mkModuleName "Outputable" `elem` listVisibleModuleNames dflags) + _ <- runGhc (Just libdir) $ do + dflags <- getSessionDynFlags + setSessionDynFlags (dflags { packageFlags = [ExposePackage (PackageArg "ghc") Nothing]}) + dflags <- getSessionDynFlags + liftIO $ print (mkModuleName "Outputable" `elem` listVisibleModuleNames dflags) + return () diff --git a/testsuite/tests/codeGen/should_run/cgrun056.stdout b/testsuite/tests/ghc-api/T9595.stdout similarity index 100% copy from testsuite/tests/codeGen/should_run/cgrun056.stdout copy to testsuite/tests/ghc-api/T9595.stdout diff --git a/testsuite/tests/ghc-api/all.T b/testsuite/tests/ghc-api/all.T index 489b3ed..11e8c42 100644 --- a/testsuite/tests/ghc-api/all.T +++ b/testsuite/tests/ghc-api/all.T @@ -8,3 +8,4 @@ test('T8639_api', normal, test('T8628', normal, run_command, ['$MAKE -s --no-print-directory T8628']) +test('T9595', extra_run_opts('"' + config.libdir + '"'), compile_and_run, ['-package ghc']) From git at git.haskell.org Mon Sep 15 21:13:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Sep 2014 21:13:58 +0000 (UTC) Subject: [commit: ghc] master: Declare official GitHub home of libraries/filepath (f8ff637) Message-ID: <20140915211358.85C363A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f8ff637d6d68f72d32b1e7113bfaf943176df76a/ghc >--------------------------------------------------------------- commit f8ff637d6d68f72d32b1e7113bfaf943176df76a Author: Herbert Valerio Riedel Date: Mon Sep 15 23:11:36 2014 +0200 Declare official GitHub home of libraries/filepath Effective immediately, pushing to libraries/filepath requires pushing to ssh://git at github.com/haskell/filepath.git. >--------------------------------------------------------------- f8ff637d6d68f72d32b1e7113bfaf943176df76a packages | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/packages b/packages index be29ca3..e6db883 100644 --- a/packages +++ b/packages @@ -58,7 +58,7 @@ libraries/Cabal - - https:/ libraries/containers - - https://github.com/haskell/containers.git libraries/deepseq - - - libraries/directory - - ssh://git at github.com/haskell/directory.git -libraries/filepath - - - +libraries/filepath - - ssh://git at github.com/haskell/filepath.git libraries/haskeline - - https://github.com/judah/haskeline.git libraries/haskell98 - - - libraries/haskell2010 - - - From git at git.haskell.org Mon Sep 15 22:11:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Sep 2014 22:11:46 +0000 (UTC) Subject: [commit: ghc] branch 'ghc-validate' created Message-ID: <20140915221146.524EC3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : ghc-validate Referencing: cc749d2642a754c752e9f8c4543477c7abc9c2c8 From git at git.haskell.org Mon Sep 15 22:11:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Sep 2014 22:11:49 +0000 (UTC) Subject: [commit: ghc] ghc-validate: Mark T8639_api/T8628 as PHONY (cc749d2) Message-ID: <20140915221149.07CED3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-validate Link : http://ghc.haskell.org/trac/ghc/changeset/cc749d2642a754c752e9f8c4543477c7abc9c2c8/ghc >--------------------------------------------------------------- commit cc749d2642a754c752e9f8c4543477c7abc9c2c8 Author: Edward Z. Yang Date: Mon Sep 15 15:11:41 2014 -0700 Mark T8639_api/T8628 as PHONY Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- cc749d2642a754c752e9f8c4543477c7abc9c2c8 testsuite/tests/ghc-api/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/ghc-api/Makefile b/testsuite/tests/ghc-api/Makefile index 0900dee..8278f2b 100644 --- a/testsuite/tests/ghc-api/Makefile +++ b/testsuite/tests/ghc-api/Makefile @@ -20,6 +20,6 @@ T8628: '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc T8628 ./T8628 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" -.PHONY: clean T6145 +.PHONY: clean T6145 T8639_api T8628 From git at git.haskell.org Mon Sep 15 22:12:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Sep 2014 22:12:36 +0000 (UTC) Subject: [commit: ghc] master: Mark T8639_api/T8628 as PHONY (a9b5d99) Message-ID: <20140915221236.334BB3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a9b5d99fb1f5bd7c2d27fa12560a68b102ff380a/ghc >--------------------------------------------------------------- commit a9b5d99fb1f5bd7c2d27fa12560a68b102ff380a Author: Edward Z. Yang Date: Mon Sep 15 15:11:41 2014 -0700 Mark T8639_api/T8628 as PHONY Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- a9b5d99fb1f5bd7c2d27fa12560a68b102ff380a testsuite/tests/ghc-api/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/ghc-api/Makefile b/testsuite/tests/ghc-api/Makefile index 0900dee..8278f2b 100644 --- a/testsuite/tests/ghc-api/Makefile +++ b/testsuite/tests/ghc-api/Makefile @@ -20,6 +20,6 @@ T8628: '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc T8628 ./T8628 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" -.PHONY: clean T6145 +.PHONY: clean T6145 T8639_api T8628 From git at git.haskell.org Tue Sep 16 10:10:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 10:10:51 +0000 (UTC) Subject: [commit: packages/old-time] master: Update config.{guess, sub} to GNU automake 1.14.1 (12b029f) Message-ID: <20140916101051.0E52F3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/old-time On branch : master Link : http://git.haskell.org/packages/old-time.git/commitdiff/12b029fb767c1e25860aacdf0286ba81fd4cbbf5 >--------------------------------------------------------------- commit 12b029fb767c1e25860aacdf0286ba81fd4cbbf5 Author: Herbert Valerio Riedel Date: Tue Sep 16 12:05:25 2014 +0200 Update config.{guess,sub} to GNU automake 1.14.1 >--------------------------------------------------------------- 12b029fb767c1e25860aacdf0286ba81fd4cbbf5 config.guess | 192 +++++++++-------------------------------------------------- config.sub | 23 +++---- 2 files changed, 40 insertions(+), 175 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 12b029fb767c1e25860aacdf0286ba81fd4cbbf5 From git at git.haskell.org Tue Sep 16 10:19:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 10:19:54 +0000 (UTC) Subject: [commit: ghc] master: Update config.{guess, sub} to GNU automake 1.14.1 (72d6d0c) Message-ID: <20140916101954.902273A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/72d6d0c2704ee6d984df45f7393c399c0f62a9a9/ghc >--------------------------------------------------------------- commit 72d6d0c2704ee6d984df45f7393c399c0f62a9a9 Author: Herbert Valerio Riedel Date: Tue Sep 16 12:14:31 2014 +0200 Update config.{guess,sub} to GNU automake 1.14.1 The new versions should work better under MSYS2 A few submodules' `config.{guess,sub}` files were updated as well With this commit, all config.{guess,sub} files in the GHC tree have the md5sums 0fb81517303511f05a01b14f41cec2cf config.guess d2a165dceaa5ac1edba3c512f6ca7bd1 config.sub This addresses #9597 >--------------------------------------------------------------- 72d6d0c2704ee6d984df45f7393c399c0f62a9a9 config.guess | 192 ++++++------------------------------- config.sub | 23 +++-- libraries/base/config.guess | 192 ++++++------------------------------- libraries/base/config.sub | 23 +++-- libraries/integer-gmp/config.guess | 192 ++++++------------------------------- libraries/integer-gmp/config.sub | 23 +++-- 6 files changed, 120 insertions(+), 525 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 72d6d0c2704ee6d984df45f7393c399c0f62a9a9 From git at git.haskell.org Tue Sep 16 10:21:13 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 10:21:13 +0000 (UTC) Subject: [commit: ghc] master: Follow-up to 72d6d0c2704ee6d9 updating submodules for real (d24a618) Message-ID: <20140916102113.AD2063A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d24a618e4c1d78e5b8684e61d6518711f4e6408e/ghc >--------------------------------------------------------------- commit d24a618e4c1d78e5b8684e61d6518711f4e6408e Author: Herbert Valerio Riedel Date: Tue Sep 16 12:20:45 2014 +0200 Follow-up to 72d6d0c2704ee6d9 updating submodules for real >--------------------------------------------------------------- d24a618e4c1d78e5b8684e61d6518711f4e6408e libraries/directory | 2 +- libraries/old-time | 2 +- libraries/unix | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/directory b/libraries/directory index deb530a..3294737 160000 --- a/libraries/directory +++ b/libraries/directory @@ -1 +1 @@ -Subproject commit deb530aa8a80214af6cf06e9b1ecc3390a5413dd +Subproject commit 329473730c36827f06358e137b469c59b490aaa8 diff --git a/libraries/old-time b/libraries/old-time index 6a13541..12b029f 160000 --- a/libraries/old-time +++ b/libraries/old-time @@ -1 +1 @@ -Subproject commit 6a13541b3fff7ff59a17689efaed0818bf87a6e4 +Subproject commit 12b029fb767c1e25860aacdf0286ba81fd4cbbf5 diff --git a/libraries/unix b/libraries/unix index b2c8ae1..832ac1d 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit b2c8ae1cf231745c928fe51029d391681c1f0c20 +Subproject commit 832ac1d654762876c811ca5fd7e04c01badaa754 From git at git.haskell.org Tue Sep 16 12:32:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 12:32:29 +0000 (UTC) Subject: [commit: ghc] branch 'ghc-validate' deleted Message-ID: <20140916123229.C27C73A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: ghc-validate From git at git.haskell.org Tue Sep 16 12:50:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 12:50:47 +0000 (UTC) Subject: [commit: packages/haskeline] master: Derive Functor/Applicative for Win32/Draw backend (4a26c23) Message-ID: <20140916125047.AF88F3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/4a26c23c49583142648b4e60ad2fd450a70731e2 >--------------------------------------------------------------- commit 4a26c23c49583142648b4e60ad2fd450a70731e2 Author: Austin Seipp Date: Tue Sep 16 07:49:18 2014 -0500 Derive Functor/Applicative for Win32/Draw backend Signed-off-by: Austin Seipp >--------------------------------------------------------------- 4a26c23c49583142648b4e60ad2fd450a70731e2 System/Console/Haskeline/Backend/Win32.hsc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/System/Console/Haskeline/Backend/Win32.hsc b/System/Console/Haskeline/Backend/Win32.hsc index 4447519..8dd626f 100644 --- a/System/Console/Haskeline/Backend/Win32.hsc +++ b/System/Console/Haskeline/Backend/Win32.hsc @@ -260,7 +260,7 @@ closeHandles :: Handles -> IO () closeHandles hs = closeHandle (hIn hs) >> closeHandle (hOut hs) newtype Draw m a = Draw {runDraw :: ReaderT Handles m a} - deriving (Monad,MonadIO,MonadException, MonadReader Handles) + deriving (Functor, Applicative, Monad, MonadIO, MonadException, MonadReader Handles) type DrawM a = (MonadIO m, MonadReader Layout m) => Draw m a From git at git.haskell.org Tue Sep 16 12:51:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 12:51:52 +0000 (UTC) Subject: [commit: ghc] master: haskeline: update submodule to fix Windows breakage (628b21a) Message-ID: <20140916125152.4620A3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/628b21aa57bb4a96ac64559acebccb07fb3e67dd/ghc >--------------------------------------------------------------- commit 628b21aa57bb4a96ac64559acebccb07fb3e67dd Author: Austin Seipp Date: Tue Sep 16 07:51:38 2014 -0500 haskeline: update submodule to fix Windows breakage Signed-off-by: Austin Seipp >--------------------------------------------------------------- 628b21aa57bb4a96ac64559acebccb07fb3e67dd libraries/haskeline | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/haskeline b/libraries/haskeline index d62474e..4a26c23 160000 --- a/libraries/haskeline +++ b/libraries/haskeline @@ -1 +1 @@ -Subproject commit d62474efd5256a0668634f612f078a1c730a8d07 +Subproject commit 4a26c23c49583142648b4e60ad2fd450a70731e2 From git at git.haskell.org Tue Sep 16 12:59:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 12:59:25 +0000 (UTC) Subject: [commit: ghc] master: Add special stdout for hClose002 on x64 Solaris (cdf5a1c) Message-ID: <20140916125925.D8C713A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cdf5a1c953c439de9e64a9a8364a2184049b9369/ghc >--------------------------------------------------------------- commit cdf5a1c953c439de9e64a9a8364a2184049b9369 Author: Kjetil Limkj?r Date: Tue Sep 16 07:54:15 2014 -0500 Add special stdout for hClose002 on x64 Solaris Summary: This is identical to the x86 output from bug #4290, and fixes the hClose002 test when running under x86_64-unknown-solaris2. Test Plan: Re-run 'make TEST=hClose002' under x64 Solaris. Reviewers: ezyang, austin Reviewed By: ezyang, austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D205 >--------------------------------------------------------------- cdf5a1c953c439de9e64a9a8364a2184049b9369 ...out-i386-unknown-solaris2 => hClose002.stdout-x86_64-unknown-solaris2} | 0 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/libraries/base/tests/IO/hClose002.stdout-i386-unknown-solaris2 b/libraries/base/tests/IO/hClose002.stdout-x86_64-unknown-solaris2 similarity index 100% copy from libraries/base/tests/IO/hClose002.stdout-i386-unknown-solaris2 copy to libraries/base/tests/IO/hClose002.stdout-x86_64-unknown-solaris2 From git at git.haskell.org Tue Sep 16 12:59:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 12:59:28 +0000 (UTC) Subject: [commit: ghc] master: Find the target gcc when cross-compiling (cfd8c7d) Message-ID: <20140916125928.9D6633A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cfd8c7ddcdae47fc676d7b16ce8af7b5328a1041/ghc >--------------------------------------------------------------- commit cfd8c7ddcdae47fc676d7b16ce8af7b5328a1041 Author: Reid Barton Date: Tue Sep 16 07:54:43 2014 -0500 Find the target gcc when cross-compiling Summary: "./configure --target=TARGET" was broken; it would use the host gcc. (So you had to explicitly specify "--with-gcc=TARGET-gcc" also, as a workaround.) This was broken by commit fc4856f9e811d9a23ae9212f43a09ddf5ef12b26 for #8148. A comment claimed that FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL was the same as FP_ARG_WITH_PATH_GNU_PROG except for not raising an error when the program isn't found; but that wasn't true -- the former didn't prepend the target name when cross-compiling. We actually need three versions of FP_ARG_WITH_PATH_GNU_PROG since the LLVM tools are usually not prefixed with the target name even when cross-compiling. So I generalized the logic in a single macro. Test Plan: Built with "./configure --target=i386-unknown-linux" and BuildFlavour=quick, successfully Reviewers: ezyang, austin Reviewed By: ezyang, austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D204 >--------------------------------------------------------------- cfd8c7ddcdae47fc676d7b16ce8af7b5328a1041 aclocal.m4 | 61 ++++++++++++++++++++++--------------------------------------- 1 file changed, 22 insertions(+), 39 deletions(-) diff --git a/aclocal.m4 b/aclocal.m4 index 0dda8af..62cf6fe 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -640,19 +640,20 @@ AC_DEFUN([FPTOOLS_FLOAT_WORD_ORDER_BIGENDIAN], ]) -# FP_ARG_WITH_PATH_GNU_PROG +# FP_ARG_WITH_PATH_GNU_PROG_GENERAL # -------------------- # Find the specified command on the path or allow a user to set it manually -# with a --with- option. An error will be thrown if the command isn't -# found. +# with a --with- option. # # This is ignored on the mingw32 platform. # # $1 = the variable to set # $2 = the with option name # $3 = the command to look for +# $4 = prepend target to program name? if 'no', use the name unchanged +# $5 = optional? if 'no', then raise an error if the command isn't found # -AC_DEFUN([FP_ARG_WITH_PATH_GNU_PROG], +AC_DEFUN([FP_ARG_WITH_PATH_GNU_PROG_GENERAL], [ AC_ARG_WITH($2, [AC_HELP_STRING([--with-$2=ARG], @@ -672,58 +673,40 @@ AC_ARG_WITH($2, [ if test "$HostOS" != "mingw32" then - if test "$target_alias" = "" ; then + if test "$4" = "no" -o "$target_alias" = "" ; then AC_PATH_PROG([$1], [$3]) else AC_PATH_PROG([$1], [$target_alias-$3]) fi - if test -z "$$1" + if test "$5" = "no" -a -z "$$1" then AC_MSG_ERROR([cannot find $3 in your PATH]) fi fi ] ) -]) # FP_ARG_WITH_PATH_GNU_PROG +]) # FP_ARG_WITH_PATH_GNU_PROG_GENERAL +# FP_ARG_WITH_PATH_GNU_PROG +# -------------------- +# The usual case: prepend the target, and the program is not optional. +AC_DEFUN([FP_ARG_WITH_PATH_GNU_PROG], +[FP_ARG_WITH_PATH_GNU_PROG_GENERAL([$1], [$2], [$3], [yes], [no])]) + # FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL # -------------------- # Same as FP_ARG_WITH_PATH_GNU_PROG but no error will be thrown if the command # isn't found. -# -# This is ignored on the mingw32 platform. -# -# $1 = the variable to set -# $2 = the with option name -# $3 = the command to look for -# AC_DEFUN([FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL], -[ -AC_ARG_WITH($2, -[AC_HELP_STRING([--with-$2=ARG], - [Use ARG as the path to $2 [default=autodetect]])], -[ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - $1=$withval - fi - - # Remember that we set this manually. Used to override CC_STAGE0 - # and friends later, if we are not cross-compiling. - With_$2=$withval -], -[ - if test "$HostOS" != "mingw32" - then - AC_PATH_PROG([$1], [$3]) - fi -] -) -]) # FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL +[FP_ARG_WITH_PATH_GNU_PROG_GENERAL([$1], [$2], [$3], [yes], [yes])]) +# FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL_NOTARGET +# -------------------- +# Same as FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL but don't prepend the target name +# (used for LLVM). +AC_DEFUN([FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL_NOTARGET], +[FP_ARG_WITH_PATH_GNU_PROG_GENERAL([$1], [$2], [$3], [no], [yes])]) # FP_PROG_CONTEXT_DIFF @@ -2063,7 +2046,7 @@ AC_DEFUN([XCODE_VERSION],[ # $3 = the command to look for # AC_DEFUN([FIND_LLVM_PROG],[ - FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL([$1], [$2], [$3]) + FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL_NOTARGET([$1], [$2], [$3]) if test "$$1" == ""; then save_IFS=$IFS IFS=":;" From git at git.haskell.org Tue Sep 16 12:59:31 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 12:59:31 +0000 (UTC) Subject: [commit: ghc] master: Fix cppcheck warnings (3681c88) Message-ID: <20140916125931.5D5F53A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3681c885ad6f1103333aaa508a1cd26078914ef0/ghc >--------------------------------------------------------------- commit 3681c885ad6f1103333aaa508a1cd26078914ef0 Author: Boris Egorov Date: Tue Sep 16 07:55:06 2014 -0500 Fix cppcheck warnings Summary: Cppcheck found a few defects in win32 IOManager and a typo in rts testsuite. This commit fixes them. Cppcheck 1.54 founds three possible null pointer dereferences of ioMan pointer. It is dereferenced and checked for NULL after that. testheapalloced.c contains typo in printf statement, which should print percent sign but treated as parameter placement by compiler. To properly print percent sign one need to use "%%" string. FYI: Cppcheck 1.66 cannot find possible null pointer dereferences in mentioned places, mistakenly thinking that some memory leaking instead. I probably fill a regression bug to Cppcheck. Test Plan: Build project, run 'make fulltest'. It finished with 28 unexpected failures. I don't know if they are related to my fix. Unexpected results from: TEST="T3500b T7891 tc124 T7653 T5321FD T5030 T4801 T6048 T5631 T5837 T5642 T9020 T3064 parsing001 T1969 T5321Fun T783 T3294" OVERALL SUMMARY for test run started at Tue Sep 9 16:46:27 2014 NOVT 4:23:24 spent to go through 4101 total tests, which gave rise to 16075 test cases, of which 3430 were skipped 315 had missing libraries 12154 expected passes 145 expected failures 3 caused framework failures 0 unexpected passes 28 unexpected failures Unexpected failures: ../../libraries/base/tests T7653 [bad exit code] (ghci,threaded1,threaded2) perf/compiler T1969 [stat not good enough] (normal) perf/compiler T3064 [stat not good enough] (normal) perf/compiler T3294 [stat not good enough] (normal) perf/compiler T4801 [stat not good enough] (normal) perf/compiler T5030 [stat not good enough] (normal) perf/compiler T5321FD [stat not good enough] (normal) perf/compiler T5321Fun [stat not good enough] (normal) perf/compiler T5631 [stat not good enough] (normal) perf/compiler T5642 [stat not good enough] (normal) perf/compiler T5837 [stat not good enough] (normal) perf/compiler T6048 [stat not good enough] (optasm) perf/compiler T783 [stat not good enough] (normal) perf/compiler T9020 [stat not good enough] (optasm) perf/compiler parsing001 [stat not good enough] (normal) typecheck/should_compile T7891 [exit code non-0] (hpc,optasm,optllvm) typecheck/should_compile tc124 [exit code non-0] (hpc,optasm,optllvm) typecheck/should_run T3500b [exit code non-0] (hpc,optasm,threaded2,dyn,optllvm) Reviewers: austin Reviewed By: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D203 >--------------------------------------------------------------- 3681c885ad6f1103333aaa508a1cd26078914ef0 rts/win32/IOManager.c | 9 ++++++--- testsuite/tests/rts/testheapalloced.c | 2 +- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/rts/win32/IOManager.c b/rts/win32/IOManager.c index 2427687..7eaf489 100644 --- a/rts/win32/IOManager.c +++ b/rts/win32/IOManager.c @@ -436,8 +436,9 @@ AddIORequest ( int fd, CompletionProc onCompletion) { WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - unsigned int reqID = ioMan->requestID++; + unsigned int reqID; if (!ioMan || !wItem) return 0; + reqID = ioMan->requestID++; /* Fill in the blanks */ wItem->workKind = ( isSocket ? WORKER_FOR_SOCKET : 0 ) | @@ -464,8 +465,9 @@ AddDelayRequest ( unsigned int usecs, CompletionProc onCompletion) { WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - unsigned int reqID = ioMan->requestID++; + unsigned int reqID; if (!ioMan || !wItem) return FALSE; + reqID = ioMan->requestID++; /* Fill in the blanks */ wItem->workKind = WORKER_DELAY; @@ -488,8 +490,9 @@ AddProcRequest ( void* proc, CompletionProc onCompletion) { WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - unsigned int reqID = ioMan->requestID++; + unsigned int reqID; if (!ioMan || !wItem) return FALSE; + reqID = ioMan->requestID++; /* Fill in the blanks */ wItem->workKind = WORKER_DO_PROC; diff --git a/testsuite/tests/rts/testheapalloced.c b/testsuite/tests/rts/testheapalloced.c index cc4dad4..3d8fa05 100644 --- a/testsuite/tests/rts/testheapalloced.c +++ b/testsuite/tests/rts/testheapalloced.c @@ -85,7 +85,7 @@ int main (int argc, char *argv[]) printf("%d\n", j); } - printf("misses: %ld, %ld%\n", mpc_misses, mpc_misses / (LOOPS*20)); + printf("misses: %ld, %ld%%\n", mpc_misses, mpc_misses / (LOOPS*20)); for (i=0; i < ARRSIZE; i++) { From git at git.haskell.org Tue Sep 16 12:59:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 12:59:34 +0000 (UTC) Subject: [commit: ghc] master: Remove special casing of singleton strings, split all strings. (fe9f7e4) Message-ID: <20140916125934.B614B3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fe9f7e40844802443315ef2238c4cdefda756b62/ghc >--------------------------------------------------------------- commit fe9f7e40844802443315ef2238c4cdefda756b62 Author: Thijs Alkemade Date: Tue Sep 16 07:55:34 2014 -0500 Remove special casing of singleton strings, split all strings. Summary: exprIsConApp_maybe now detects string literals and correctly splits them. This means case-statemnts on string literals can now push the literal into the cases. fix trac issue #9400 Test Plan: validate Reviewers: austin, simonpj Reviewed By: austin, simonpj Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D199 GHC Trac Issues: #9400 >--------------------------------------------------------------- fe9f7e40844802443315ef2238c4cdefda756b62 compiler/coreSyn/CoreSubst.lhs | 58 +++++++++++++++++++++- compiler/coreSyn/MkCore.lhs | 4 -- testsuite/tests/simplCore/should_compile/T9400.hs | 18 +++++++ .../tests/simplCore/should_compile/T9400.stderr | 36 ++++++++++++++ testsuite/tests/simplCore/should_compile/all.T | 1 + 5 files changed, 111 insertions(+), 6 deletions(-) diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs index 1951252..76f42f4 100644 --- a/compiler/coreSyn/CoreSubst.lhs +++ b/compiler/coreSyn/CoreSubst.lhs @@ -42,7 +42,8 @@ module CoreSubst ( import CoreSyn import CoreFVs import CoreUtils -import Literal ( Literal ) +import Literal ( Literal(MachStr) ) +import qualified Data.ByteString as BS import OccurAnal( occurAnalyseExpr, occurAnalysePgm ) import qualified Type @@ -55,7 +56,8 @@ import Coercion hiding ( substTy, substCo, extendTvSubst, substTyVarBndr, substC import TyCon ( tyConArity ) import DataCon -import PrelNames ( eqBoxDataConKey, coercibleDataConKey ) +import PrelNames ( eqBoxDataConKey, coercibleDataConKey, unpackCStringIdKey + , unpackCStringUtf8IdKey ) import OptCoercion ( optCoercion ) import PprCore ( pprCoreBindings, pprRules ) import Module ( Module ) @@ -78,6 +80,8 @@ import PprCore () -- Instances import FastString import Data.List + +import TysWiredIn \end{code} @@ -1135,6 +1139,25 @@ a data constructor. However e might not *look* as if + +Note [exprIsConApp_maybe on literal strings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +See #9400. + +Conceptually, a string literal "abc" is just ('a':'b':'c':[]), but in Core +they are represented as unpackCString# "abc"# by MkCore.mkStringExprFS, or +unpackCStringUtf8# when the literal contains multi-byte UTF8 characters. + +For optimizations we want to be able to treat it as a list, so they can be +decomposed when used in a case-statement. exprIsConApp_maybe detects those +calls to unpackCString# and returns: + +Just (':', [Char], ['a', unpackCString# "bc"]). + +We need to be careful about UTF8 strings here. ""# contains a ByteString, so +we must parse it back into a FastString to split off the first character. +That way we can treat unpackCString# and unpackCStringUtf8# in the same way. + \begin{code} data ConCont = CC [CoreExpr] Coercion -- Substitution already applied @@ -1164,6 +1187,7 @@ exprIsConApp_maybe (in_scope, id_unf) expr cont go (Left in_scope) (Var fun) cont@(CC args co) + | Just con <- isDataConWorkId_maybe fun , count isValArg args == idArity fun = dealWithCoercion co con args @@ -1183,6 +1207,11 @@ exprIsConApp_maybe (in_scope, id_unf) expr , Just rhs <- expandUnfolding_maybe unfolding , let in_scope' = extendInScopeSetSet in_scope (exprFreeVars rhs) = go (Left in_scope') rhs cont + + | (fun `hasKey` unpackCStringIdKey) + || (fun `hasKey` unpackCStringUtf8IdKey) + , [Lit (MachStr str)] <- args + = dealWithStringLiteral fun str co where unfolding = id_unf fun @@ -1200,6 +1229,31 @@ exprIsConApp_maybe (in_scope, id_unf) expr extend (Left in_scope) v e = Right (extendSubst (mkEmptySubst in_scope) v e) extend (Right s) v e = Right (extendSubst s v e) +-- See Note [exprIsConApp_maybe on literal strings] +dealWithStringLiteral :: Var -> BS.ByteString -> Coercion + -> Maybe (DataCon, [Type], [CoreExpr]) + +-- This is not possible with user-supplied empty literals, MkCore.mkStringExprFS +-- turns those into [] automatically, but just in case something else in GHC +-- generates a string literal directly. +dealWithStringLiteral _ str co + | BS.null str + = dealWithCoercion co nilDataCon [Type charTy] + +dealWithStringLiteral fun str co + = let strFS = mkFastStringByteString str + + char = mkConApp charDataCon [mkCharLit (headFS strFS)] + charTail = fastStringToByteString (tailFS strFS) + + -- In singleton strings, just add [] instead of unpackCstring# ""#. + rest = if BS.null charTail + then mkConApp nilDataCon [Type charTy] + else App (Var fun) + (Lit (MachStr charTail)) + + in dealWithCoercion co consDataCon [Type charTy, char, rest] + dealWithCoercion :: Coercion -> DataCon -> [CoreExpr] -> Maybe (DataCon, [Type], [CoreExpr]) dealWithCoercion co dc dc_args diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs index 012306a..d749f82 100644 --- a/compiler/coreSyn/MkCore.lhs +++ b/compiler/coreSyn/MkCore.lhs @@ -283,10 +283,6 @@ mkStringExprFS str | nullFS str = return (mkNilExpr charTy) - | lengthFS str == 1 - = do let the_char = mkCharExpr (headFS str) - return (mkConsExpr charTy the_char (mkNilExpr charTy)) - | all safeChar chars = do unpack_id <- lookupId unpackCStringName return (App (Var unpack_id) (Lit (MachStr (fastStringToByteString str)))) diff --git a/testsuite/tests/simplCore/should_compile/T9400.hs b/testsuite/tests/simplCore/should_compile/T9400.hs new file mode 100644 index 0000000..4e9cb72 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9400.hs @@ -0,0 +1,18 @@ +module T9400 (main) where +import GHC.Base + +str = "defg" + +main :: IO () +main = do + case "abc" of + (x:y:xs) -> putStrLn xs + case "" of + [] -> putStrLn "x" + case "ab" of + [] -> putStrLn "y" + (x:y:[]) -> putStrLn "z" + case str of + (x:xs) -> putStrLn xs + case "ab" of + "" -> putStrLn "fail" diff --git a/testsuite/tests/simplCore/should_compile/T9400.stderr b/testsuite/tests/simplCore/should_compile/T9400.stderr new file mode 100644 index 0000000..e66eecf --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9400.stderr @@ -0,0 +1,36 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 23, types: 16, coercions: 0} + +T9400.main :: GHC.Types.IO () +[GblId, Str=DmdType] +T9400.main = + GHC.Base.>> + @ GHC.Types.IO + GHC.Base.$fMonadIO + @ () + @ () + (System.IO.putStrLn (GHC.CString.unpackCString# "c"#)) + (GHC.Base.>> + @ GHC.Types.IO + GHC.Base.$fMonadIO + @ () + @ () + (System.IO.putStrLn (GHC.CString.unpackCString# "x"#)) + (GHC.Base.>> + @ GHC.Types.IO + GHC.Base.$fMonadIO + @ () + @ () + (System.IO.putStrLn (GHC.CString.unpackCString# "z"#)) + (GHC.Base.>> + @ GHC.Types.IO + GHC.Base.$fMonadIO + @ () + @ () + (System.IO.putStrLn (GHC.CString.unpackCString# "efg"#)) + (Control.Exception.Base.patError + @ (GHC.Types.IO ()) "T9400.hs:(17,5)-(18,29)|case"#)))) + + + diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 88d1022..399498b 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -206,3 +206,4 @@ test('T8848', only_ways(['optasm']), compile, ['-ddump-rule-firings -dsuppress-u test('T8848a', only_ways(['optasm']), compile, ['-ddump-rules']) test('T8331', only_ways(['optasm']), compile, ['-ddump-rules']) test('T6056', only_ways(['optasm']), multimod_compile, ['T6056', '-v0 -ddump-rule-firings']) +test('T9400', only_ways(['optasm']), compile, ['-O0 -ddump-simpl -dsuppress-uniques']) From git at git.haskell.org Tue Sep 16 12:59:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 12:59:37 +0000 (UTC) Subject: [commit: ghc] master: Add the ability to :set -l{foo} in ghci, fix #1407. (52eab67) Message-ID: <20140916125937.DE60D3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/52eab67a99dd928204b730355245233fa96fa24d/ghc >--------------------------------------------------------------- commit 52eab67a99dd928204b730355245233fa96fa24d Author: archblob Date: Tue Sep 16 07:56:09 2014 -0500 Add the ability to :set -l{foo} in ghci, fix #1407. Summary: The dynamic linking code was already there but it was not called on flag changes in ghci. Test Plan: validate Reviewers: hvr, simonmar, austin Reviewed By: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D194 GHC Trac Issues: #1407 >--------------------------------------------------------------- 52eab67a99dd928204b730355245233fa96fa24d compiler/ghci/Linker.lhs | 29 ++++++++++++++++++++--------- ghc/InteractiveUI.hs | 11 +++++++++++ testsuite/tests/ghci/linking/T1407.script | 4 ++++ testsuite/tests/ghci/linking/all.T | 2 ++ 4 files changed, 37 insertions(+), 9 deletions(-) diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 3169858..5b0251c 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -17,6 +17,7 @@ module Linker ( getHValue, showLinkerState, extendLinkEnv, deleteFromLinkEnv, extendLoadedPkgs, linkPackages,initDynLinker,linkModule, + linkCmdLineLibs, -- Saving/restoring globals PersistentLinkerState, saveLinkerGlobals, restoreLinkerGlobals @@ -283,10 +284,21 @@ reallyInitDynLinker dflags = -- (b) Load packages from the command-line (Note [preload packages]) ; pls <- linkPackages' dflags (preloadPackages (pkgState dflags)) pls0 - -- (c) Link libraries from the command-line - ; let cmdline_ld_inputs = ldInputs dflags + -- steps (c), (d) and (e) + ; linkCmdLineLibs' dflags pls + } + +linkCmdLineLibs :: DynFlags -> IO () +linkCmdLineLibs dflags = do + initDynLinker dflags + modifyPLS_ $ \pls -> do + linkCmdLineLibs' dflags pls + +linkCmdLineLibs' :: DynFlags -> PersistentLinkerState -> IO PersistentLinkerState +linkCmdLineLibs' dflags@(DynFlags { ldInputs = cmdline_ld_inputs + , libraryPaths = lib_paths}) pls = + do { -- (c) Link libraries from the command-line ; let minus_ls = [ lib | Option ('-':'l':lib) <- cmdline_ld_inputs ] - ; let lib_paths = libraryPaths dflags ; libspecs <- mapM (locateLib dflags False lib_paths) minus_ls -- (d) Link .o files from the command-line @@ -295,12 +307,11 @@ reallyInitDynLinker dflags = -- (e) Link any MacOS frameworks ; let platform = targetPlatform dflags - ; let framework_paths = if platformUsesFrameworks platform - then frameworkPaths dflags - else [] - ; let frameworks = if platformUsesFrameworks platform - then cmdlineFrameworks dflags - else [] + ; let (framework_paths, frameworks) = + if platformUsesFrameworks platform + then (frameworkPaths dflags, cmdlineFrameworks dflags) + else ([],[]) + -- Finally do (c),(d),(e) ; let cmdline_lib_specs = [ l | Just l <- classified_ld_inputs ] ++ libspecs diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index ea90280..0bcecd3 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -2146,6 +2146,17 @@ newDynFlags interactive_only minus_opts = do , pkgDatabase = pkgDatabase dflags2 , packageFlags = packageFlags dflags2 } + let ld0length = length $ ldInputs dflags0 + fmrk0length = length $ cmdlineFrameworks dflags0 + + newLdInputs = drop ld0length (ldInputs dflags2) + newCLFrameworks = drop fmrk0length (cmdlineFrameworks dflags2) + + when (not (null newLdInputs && null newCLFrameworks)) $ + liftIO $ linkCmdLineLibs $ + dflags2 { ldInputs = newLdInputs + , cmdlineFrameworks = newCLFrameworks } + return () diff --git a/testsuite/tests/ghci/linking/T1407.script b/testsuite/tests/ghci/linking/T1407.script new file mode 100644 index 0000000..9716435 --- /dev/null +++ b/testsuite/tests/ghci/linking/T1407.script @@ -0,0 +1,4 @@ +:set -ldl +import Foreign +import Foreign.C.String +foreign import ccall "dlerror" dle :: IO CString diff --git a/testsuite/tests/ghci/linking/all.T b/testsuite/tests/ghci/linking/all.T index eba2b8a..6675a53 100644 --- a/testsuite/tests/ghci/linking/all.T +++ b/testsuite/tests/ghci/linking/all.T @@ -47,3 +47,5 @@ test('T3333', unless(opsys('linux') or ghci_dynamic(), expect_broken(3333))], run_command, ['$MAKE -s --no-print-directory T3333']) + +test('T1407', normal, ghci_script, ['T1407.script']) From git at git.haskell.org Tue Sep 16 12:59:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 12:59:40 +0000 (UTC) Subject: [commit: ghc] master: Return nBytes instead of nextAddr from utf8DecodeChar (caf449e) Message-ID: <20140916125940.B4AB83A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/caf449e39f5e7545eeabd567349661450aa8c6e5/ghc >--------------------------------------------------------------- commit caf449e39f5e7545eeabd567349661450aa8c6e5 Author: Thomas Miedema Date: Tue Sep 16 07:56:35 2014 -0500 Return nBytes instead of nextAddr from utf8DecodeChar Summary: While researching D176, I came across the following simplification opportunity: Not all functions that call utf8DecodeChar actually need the address of the next char. And some need the 'number of bytes' read. So returning nBytes instead of nextAddr should save a few addition and subtraction operations, and makes the code a bit simpler. Test Plan: it validates Reviewers: simonmar, ezyang, austin Reviewed By: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D179 >--------------------------------------------------------------- caf449e39f5e7545eeabd567349661450aa8c6e5 compiler/utils/Encoding.hs | 50 +++++++++++++++++++++-------------------- compiler/utils/FastString.lhs | 3 +-- compiler/utils/StringBuffer.lhs | 4 ++-- 3 files changed, 29 insertions(+), 28 deletions(-) diff --git a/compiler/utils/Encoding.hs b/compiler/utils/Encoding.hs index 115703f..5c8619b 100644 --- a/compiler/utils/Encoding.hs +++ b/compiler/utils/Encoding.hs @@ -47,18 +47,18 @@ import ExtsCompat46 -- before decoding them (see StringBuffer.hs). {-# INLINE utf8DecodeChar# #-} -utf8DecodeChar# :: Addr# -> (# Char#, Addr# #) +utf8DecodeChar# :: Addr# -> (# Char#, Int# #) utf8DecodeChar# a# = let !ch0 = word2Int# (indexWord8OffAddr# a# 0#) in case () of - _ | ch0 <=# 0x7F# -> (# chr# ch0, a# `plusAddr#` 1# #) + _ | ch0 <=# 0x7F# -> (# chr# ch0, 1# #) | ch0 >=# 0xC0# && ch0 <=# 0xDF# -> let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in if ch1 <# 0x80# || ch1 >=# 0xC0# then fail 1# else (# chr# (((ch0 -# 0xC0#) `uncheckedIShiftL#` 6#) +# (ch1 -# 0x80#)), - a# `plusAddr#` 2# #) + 2# #) | ch0 >=# 0xE0# && ch0 <=# 0xEF# -> let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in @@ -68,7 +68,7 @@ utf8DecodeChar# a# = (# chr# (((ch0 -# 0xE0#) `uncheckedIShiftL#` 12#) +# ((ch1 -# 0x80#) `uncheckedIShiftL#` 6#) +# (ch2 -# 0x80#)), - a# `plusAddr#` 3# #) + 3# #) | ch0 >=# 0xF0# && ch0 <=# 0xF8# -> let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in @@ -81,20 +81,21 @@ utf8DecodeChar# a# = ((ch1 -# 0x80#) `uncheckedIShiftL#` 12#) +# ((ch2 -# 0x80#) `uncheckedIShiftL#` 6#) +# (ch3 -# 0x80#)), - a# `plusAddr#` 4# #) + 4# #) | otherwise -> fail 1# where -- all invalid sequences end up here: - fail n = (# '\0'#, a# `plusAddr#` n #) + fail :: Int# -> (# Char#, Int# #) + fail nBytes# = (# '\0'#, nBytes# #) -- '\xFFFD' would be the usual replacement character, but -- that's a valid symbol in Haskell, so will result in a -- confusing parse error later on. Instead we use '\0' which -- will signal a lexer error immediately. -utf8DecodeChar :: Ptr Word8 -> (Char, Ptr Word8) +utf8DecodeChar :: Ptr Word8 -> (Char, Int) utf8DecodeChar (Ptr a#) = - case utf8DecodeChar# a# of (# c#, b# #) -> ( C# c#, Ptr b# ) + case utf8DecodeChar# a# of (# c#, nBytes# #) -> ( C# c#, I# nBytes# ) -- UTF-8 is cleverly designed so that we can always figure out where -- the start of the current character is, given any position in a @@ -111,35 +112,36 @@ utf8CharStart p = go p else return p utf8DecodeString :: Ptr Word8 -> Int -> IO [Char] -STRICT2(utf8DecodeString) -utf8DecodeString (Ptr a#) (I# len#) - = unpack a# +utf8DecodeString ptr len + = unpack ptr where - !end# = addr2Int# (a# `plusAddr#` len#) + !end = ptr `plusPtr` len - unpack p# - | addr2Int# p# >=# end# = return [] + unpack p + | p >= end = return [] | otherwise = - case utf8DecodeChar# p# of - (# c#, q# #) -> do - chs <- unpack q# + case utf8DecodeChar# (unPtr p) of + (# c#, nBytes# #) -> do + chs <- unpack (p `plusPtr#` nBytes#) return (C# c# : chs) countUTF8Chars :: Ptr Word8 -> Int -> IO Int -countUTF8Chars ptr bytes = go ptr 0 +countUTF8Chars ptr len = go ptr 0 where - end = ptr `plusPtr` bytes + !end = ptr `plusPtr` len - STRICT2(go) - go ptr n - | ptr >= end = return n + go p !n + | p >= end = return n | otherwise = do - case utf8DecodeChar# (unPtr ptr) of - (# _, a #) -> go (Ptr a) (n+1) + case utf8DecodeChar# (unPtr p) of + (# _, nBytes# #) -> go (p `plusPtr#` nBytes#) (n+1) unPtr :: Ptr a -> Addr# unPtr (Ptr a) = a +plusPtr# :: Ptr a -> Int# -> Ptr a +plusPtr# ptr nBytes# = ptr `plusPtr` (I# nBytes#) + utf8EncodeChar :: Char -> Ptr Word8 -> IO (Ptr Word8) utf8EncodeChar c ptr = let x = ord c in diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs index a38d87e..91236cc 100644 --- a/compiler/utils/FastString.lhs +++ b/compiler/utils/FastString.lhs @@ -529,8 +529,7 @@ tailFS :: FastString -> FastString tailFS (FastString _ 0 _ _) = panic "tailFS: Empty FastString" tailFS (FastString _ _ bs _) = inlinePerformIO $ BS.unsafeUseAsCString bs $ \ptr -> - do let (_, ptr') = utf8DecodeChar (castPtr ptr) - n = ptr' `minusPtr` ptr + do let (_, n) = utf8DecodeChar (castPtr ptr) return $! mkFastStringByteString (BS.drop n bs) consFS :: Char -> FastString -> FastString diff --git a/compiler/utils/StringBuffer.lhs b/compiler/utils/StringBuffer.lhs index 50d8443..d298457 100644 --- a/compiler/utils/StringBuffer.lhs +++ b/compiler/utils/StringBuffer.lhs @@ -179,8 +179,8 @@ nextChar (StringBuffer buf len (I# cur#)) = inlinePerformIO $ do withForeignPtr buf $ \(Ptr a#) -> do case utf8DecodeChar# (a# `plusAddr#` cur#) of - (# c#, b# #) -> - let cur' = I# (b# `minusAddr#` a#) in + (# c#, nBytes# #) -> + let cur' = I# (cur# +# nBytes#) in return (C# c#, StringBuffer buf len cur') currentChar :: StringBuffer -> Char From git at git.haskell.org Tue Sep 16 12:59:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 12:59:43 +0000 (UTC) Subject: [commit: ghc] master: Revert "Revert "rts/base: Fix #9423"" and resolve issue that caused the revert. (7e658bc) Message-ID: <20140916125943.86FF93A35C@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7e658bc14e2dd6baf208deebbdab9e1285ce4c72/ghc >--------------------------------------------------------------- commit 7e658bc14e2dd6baf208deebbdab9e1285ce4c72 Author: Andreas Voellmy Date: Tue Sep 16 07:56:54 2014 -0500 Revert "Revert "rts/base: Fix #9423"" and resolve issue that caused the revert. Summary: This reverts commit 4748f5936fe72d96edfa17b153dbfd84f2c4c053. The fix for #9423 was reverted because this commit introduced a C function setIOManagerControlFd() (defined in Schedule.c) defined for all OS types, while the prototype (in includes/rts/IOManager.h) was only included when mingw32_HOST_OS is not defined. This broke Windows builds. This commit reverts the original commit and resolves the problem by only defining setIOManagerControlFd() when mingw32_HOST_OS is defined. Hence the missing prototype error should not occur on Windows. In addition, since the io_manager_control_wr_fd field of the Capability struct is only usd by the setIOManagerControlFd, this commit includes the io_manager_control_wr_fd field in the Capability struct only when mingw32_HOST_OS is not defined. Test Plan: Try to compile successfully on all platforms. Reviewers: austin Reviewed By: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D174 >--------------------------------------------------------------- 7e658bc14e2dd6baf208deebbdab9e1285ce4c72 includes/rts/IOManager.h | 3 +- libraries/base/GHC/Event/Control.hs | 8 +--- libraries/base/GHC/Event/Manager.hs | 1 + libraries/base/GHC/Event/Thread.hs | 35 ++++++++------ libraries/base/GHC/Event/TimerManager.hs | 1 + rts/Capability.c | 19 ++++++++ rts/Capability.h | 4 ++ rts/Linker.c | 1 + rts/posix/Signals.c | 80 ++++++++++++++++++++------------ 9 files changed, 101 insertions(+), 51 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7e658bc14e2dd6baf208deebbdab9e1285ce4c72 From git at git.haskell.org Tue Sep 16 17:11:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 17:11:46 +0000 (UTC) Subject: [commit: ghc] master: Fix typo "Rrestriction" in user's guide (lspitzner, #9528) (e7a0f5b) Message-ID: <20140916171146.5B3C33A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e7a0f5b66ced8d56d770375e4d35d38c70067559/ghc >--------------------------------------------------------------- commit e7a0f5b66ced8d56d770375e4d35d38c70067559 Author: Reid Barton Date: Tue Sep 16 12:57:50 2014 -0400 Fix typo "Rrestriction" in user's guide (lspitzner, #9528) >--------------------------------------------------------------- e7a0f5b66ced8d56d770375e4d35d38c70067559 docs/users_guide/flags.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index f138c18..086157b 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -1026,7 +1026,7 @@ Disable the monomorphism restriction. dynamic - + From git at git.haskell.org Tue Sep 16 20:44:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 20:44:30 +0000 (UTC) Subject: [commit: ghc] master: Move `Maybe`-typedef into GHC.Base (b475219) Message-ID: <20140916204430.B1ADC3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b47521991a7574f4f3554f7c5444a8c60cfe9efd/ghc >--------------------------------------------------------------- commit b47521991a7574f4f3554f7c5444a8c60cfe9efd Author: Herbert Valerio Riedel Date: Tue Sep 16 19:19:25 2014 +0200 Move `Maybe`-typedef into GHC.Base This is preparatory work for reintroducing SPECIALISEs that were lost in d94de87252d0fe2ae97341d186b03a2fbe136b04 Differential Revision: https://phabricator.haskell.org/D214 >--------------------------------------------------------------- b47521991a7574f4f3554f7c5444a8c60cfe9efd libraries/base/Control/Exception.hs | 1 - libraries/base/Control/Exception/Base.hs | 1 - libraries/base/Data/Maybe.hs | 46 ------------------ libraries/base/Data/Monoid.hs | 1 - libraries/base/Data/OldTypeable/Internal.hs | 1 - libraries/base/Data/Typeable/Internal.hs | 1 - libraries/base/GHC/Base.lhs | 54 ++++++++++++++++++++++ libraries/base/GHC/Conc/Signal.hs | 1 - libraries/base/GHC/Event/EPoll.hsc | 1 - libraries/base/GHC/Event/Internal.hs | 1 - libraries/base/GHC/Event/Manager.hs | 2 +- libraries/base/GHC/Event/PSQ.hs | 1 - libraries/base/GHC/Event/Poll.hsc | 1 - libraries/base/GHC/Event/Thread.hs | 1 - libraries/base/GHC/Event/TimerManager.hs | 1 - libraries/base/GHC/IO.hs | 1 - libraries/base/GHC/IO/BufferedIO.hs | 1 - libraries/base/GHC/IO/Device.hs | 1 - libraries/base/GHC/IO/Encoding.hs | 1 - libraries/base/GHC/IO/Encoding/Failure.hs | 3 -- libraries/base/GHC/IO/Encoding/UTF16.hs | 1 - libraries/base/GHC/IO/Encoding/UTF32.hs | 1 - libraries/base/GHC/IO/Exception.hs | 1 - libraries/base/GHC/IO/FD.hs | 1 - libraries/base/GHC/IO/Handle/Types.hs | 1 - libraries/base/GHC/MVar.hs | 1 - libraries/base/GHC/Show.lhs | 1 - libraries/base/GHC/Weak.lhs | 1 - libraries/base/Numeric.hs | 1 - libraries/base/Text/Read.hs | 1 - .../template-haskell/Language/Haskell/TH/Syntax.hs | 4 +- testsuite/tests/ghci/scripts/T4175.stdout | 12 ++--- testsuite/tests/ghci/scripts/ghci023.stdout | 2 +- testsuite/tests/ghci/scripts/ghci026.stdout | 2 +- .../simplCore/should_compile/spec-inline.stderr | 38 +++++++-------- testsuite/tests/th/ClosedFam1TH.stderr | 2 +- testsuite/tests/th/T4135.stderr | 4 +- testsuite/tests/th/T5037.stderr | 6 +-- testsuite/tests/th/TH_RichKinds2.stderr | 6 +-- testsuite/tests/th/TH_reifyDecl2.stderr | 3 +- testsuite/tests/th/TH_repGuard.stderr | 4 +- testsuite/tests/typecheck/should_fail/T5095.stderr | 1 + .../tests/typecheck/should_fail/tcfail072.stderr | 5 +- .../tests/typecheck/should_fail/tcfail181.stderr | 3 +- .../tests/typecheck/should_fail/tcfail182.stderr | 2 +- 45 files changed, 102 insertions(+), 123 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 b47521991a7574f4f3554f7c5444a8c60cfe9efd From git at git.haskell.org Tue Sep 16 22:35:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Sep 2014 22:35:43 +0000 (UTC) Subject: [commit: ghc] master: Re-add SPECIALISE liftM* pragmas dropped in d94de87252d0fe (1574871) Message-ID: <20140916223543.4AC233A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/15748717d427ab8b6576b392226c4802420bd5c0/ghc >--------------------------------------------------------------- commit 15748717d427ab8b6576b392226c4802420bd5c0 Author: Herbert Valerio Riedel Date: Tue Sep 16 19:33:54 2014 +0200 Re-add SPECIALISE liftM* pragmas dropped in d94de87252d0fe They were dropped because `Maybe` wasn't available in GHC.Base, but now it is thanks to b47521991a7574f4f3554f7c5444a8c60cfe9efd. Differential Revision: https://phabricator.haskell.org/D215 >--------------------------------------------------------------- 15748717d427ab8b6576b392226c4802420bd5c0 libraries/base/GHC/Base.lhs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/libraries/base/GHC/Base.lhs b/libraries/base/GHC/Base.lhs index 73bfb28..54ba348 100644 --- a/libraries/base/GHC/Base.lhs +++ b/libraries/base/GHC/Base.lhs @@ -517,14 +517,19 @@ liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; {-# INLINEABLE liftM #-} {-# SPECIALISE liftM :: (a1->r) -> IO a1 -> IO r #-} +{-# SPECIALISE liftM :: (a1->r) -> Maybe a1 -> Maybe r #-} {-# INLINEABLE liftM2 #-} {-# SPECIALISE liftM2 :: (a1->a2->r) -> IO a1 -> IO a2 -> IO r #-} +{-# SPECIALISE liftM2 :: (a1->a2->r) -> Maybe a1 -> Maybe a2 -> Maybe r #-} {-# INLINEABLE liftM3 #-} {-# SPECIALISE liftM3 :: (a1->a2->a3->r) -> IO a1 -> IO a2 -> IO a3 -> IO r #-} +{-# SPECIALISE liftM3 :: (a1->a2->a3->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe r #-} {-# INLINEABLE liftM4 #-} {-# SPECIALISE liftM4 :: (a1->a2->a3->a4->r) -> IO a1 -> IO a2 -> IO a3 -> IO a4 -> IO r #-} +{-# SPECIALISE liftM4 :: (a1->a2->a3->a4->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe r #-} {-# INLINEABLE liftM5 #-} {-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> IO a1 -> IO a2 -> IO a3 -> IO a4 -> IO a5 -> IO r #-} +{-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe a5 -> Maybe r #-} {- | In many situations, the 'liftM' operations can be replaced by uses of 'ap', which promotes function application. From git at git.haskell.org Wed Sep 17 09:34:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Sep 2014 09:34:09 +0000 (UTC) Subject: [commit: ghc] master: Typo (9b8e24a) Message-ID: <20140917093409.30E8F3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9b8e24afbd7dfdce8febb893c70f7650a314910b/ghc >--------------------------------------------------------------- commit 9b8e24afbd7dfdce8febb893c70f7650a314910b Author: Gabor Greif Date: Tue Sep 16 06:56:31 2014 +0200 Typo >--------------------------------------------------------------- 9b8e24afbd7dfdce8febb893c70f7650a314910b compiler/types/Type.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index ad9e8b5..6c59450 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -512,7 +512,7 @@ funArgTy ty = pprPanic "funArgTy" (ppr ty) ~~~~~~~~ \begin{code} --- | A key function: builds a 'TyConApp' or 'FunTy' as apppropriate to +-- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to -- its arguments. Applies its arguments to the constructor from left to right. mkTyConApp :: TyCon -> [Type] -> Type mkTyConApp tycon tys From git at git.haskell.org Wed Sep 17 09:35:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Sep 2014 09:35:08 +0000 (UTC) Subject: [commit: ghc] master: Simplify (74f0e15) Message-ID: <20140917093508.14BCA3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/74f0e1515b1031eb116aad2b74ee8dece8bfc4c0/ghc >--------------------------------------------------------------- commit 74f0e1515b1031eb116aad2b74ee8dece8bfc4c0 Author: Gabor Greif Date: Wed Sep 17 06:40:32 2014 +0200 Simplify >--------------------------------------------------------------- 74f0e1515b1031eb116aad2b74ee8dece8bfc4c0 compiler/prelude/TysWiredIn.lhs | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs index 4586b90..b4ada73 100644 --- a/compiler/prelude/TysWiredIn.lhs +++ b/compiler/prelude/TysWiredIn.lhs @@ -261,18 +261,16 @@ pcNonRecDataTyCon = pcTyCon False NonRecursive False -- Representational role! pcTyCon :: Bool -> RecFlag -> Bool -> Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon pcTyCon is_enum is_rec is_prom name cType tyvars cons - = tycon - where - tycon = buildAlgTyCon name - tyvars - (map (const Representational) tyvars) - cType - [] -- No stupid theta - (DataTyCon cons is_enum) - is_rec - is_prom - False -- Not in GADT syntax - NoParentTyCon + = buildAlgTyCon name + tyvars + (map (const Representational) tyvars) + cType + [] -- No stupid theta + (DataTyCon cons is_enum) + is_rec + is_prom + False -- Not in GADT syntax + NoParentTyCon pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon pcDataCon = pcDataConWithFixity False From git at git.haskell.org Wed Sep 17 09:38:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Sep 2014 09:38:11 +0000 (UTC) Subject: [commit: ghc] master: Typo in comment (3c28290) Message-ID: <20140917093811.B46CF3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3c2829017943522a946e7ae0560034c7d28d96ce/ghc >--------------------------------------------------------------- commit 3c2829017943522a946e7ae0560034c7d28d96ce Author: Gabor Greif Date: Wed Sep 17 07:48:42 2014 +0200 Typo in comment >--------------------------------------------------------------- 3c2829017943522a946e7ae0560034c7d28d96ce compiler/basicTypes/Name.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs index 7651c7c..0647c60 100644 --- a/compiler/basicTypes/Name.lhs +++ b/compiler/basicTypes/Name.lhs @@ -363,7 +363,7 @@ stableNameCmp :: Name -> Name -> Ordering stableNameCmp (Name { n_sort = s1, n_occ = occ1 }) (Name { n_sort = s2, n_occ = occ2 }) = (s1 `sort_cmp` s2) `thenCmp` (occ1 `compare` occ2) - -- The ordinary compare on OccNames is lexicogrpahic + -- The ordinary compare on OccNames is lexicographic where -- Later constructors are bigger sort_cmp (External m1) (External m2) = m1 `stableModuleCmp` m2 From git at git.haskell.org Wed Sep 17 15:58:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Sep 2014 15:58:34 +0000 (UTC) Subject: [commit: ghc] master: Implement `decodeDouble_Int64#` primop (b62bd5e) Message-ID: <20140917155834.67DCA3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b62bd5ecf3be421778e4835010b6b334e95c5a56/ghc >--------------------------------------------------------------- commit b62bd5ecf3be421778e4835010b6b334e95c5a56 Author: Herbert Valerio Riedel Date: Wed Sep 17 17:54:20 2014 +0200 Implement `decodeDouble_Int64#` primop The existing `decodeDouble_2Int#` primop is rather inconvenient to use (and in fact is not even used by `integer-gmp`) as the mantissa is split into 3 components which would actually fit in an `Int64#` value. However, `decodeDouble_Int64#` is to be used by the new `integer-gmp2` re-implementation (see #9281). Moreover, `decodeDouble_2Int#` performs direct bit-wise operations on the IEEE representation which can be replaced by a combination of the portable standard C99 `scalbn(3)` and `frexp(3)` functions. Differential Revision: https://phabricator.haskell.org/D160 >--------------------------------------------------------------- b62bd5ecf3be421778e4835010b6b334e95c5a56 compiler/prelude/primops.txt.pp | 5 +++++ includes/stg/MiscClosures.h | 1 + rts/Linker.c | 1 + rts/PrimOps.cmm | 17 +++++++++++++++++ rts/StgPrimFloat.c | 18 ++++++++++++++++++ rts/StgPrimFloat.h | 1 + 6 files changed, 43 insertions(+) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index b78bc95..a3c15a9 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -606,6 +606,11 @@ primop DoubleDecode_2IntOp "decodeDouble_2Int#" GenPrimOp respectively, and the last is the exponent.} with out_of_line = True +primop DoubleDecode_Int64Op "decodeDouble_Int64#" GenPrimOp + Double# -> (# INT64, Int# #) + {Decode {\tt Double\#} into mantissa and base-2 exponent.} + with out_of_line = True + ------------------------------------------------------------------------ section "Float#" {Operations on single-precision (32-bit) floating-point numbers.} diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index d2b933d..0d323e2 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -341,6 +341,7 @@ RTS_FUN_DECL(StgReturn); RTS_FUN_DECL(stg_decodeFloatzuIntzh); RTS_FUN_DECL(stg_decodeDoublezu2Intzh); +RTS_FUN_DECL(stg_decodeDoublezuInt64zh); RTS_FUN_DECL(stg_unsafeThawArrayzh); RTS_FUN_DECL(stg_casArrayzh); diff --git a/rts/Linker.c b/rts/Linker.c index dba346e..63cf981 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1108,6 +1108,7 @@ typedef struct _RtsSymbolVal { SymI_HasProto(cmp_thread) \ SymI_HasProto(createAdjustor) \ SymI_HasProto(stg_decodeDoublezu2Intzh) \ + SymI_HasProto(stg_decodeDoublezuInt64zh) \ SymI_HasProto(stg_decodeFloatzuIntzh) \ SymI_HasProto(defaultsHook) \ SymI_HasProto(stg_delayzh) \ diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index ee50f7f..cb4cd5e 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -22,6 +22,7 @@ * ---------------------------------------------------------------------------*/ #include "Cmm.h" +#include "MachDeps.h" #ifdef __PIC__ import pthread_mutex_lock; @@ -807,6 +808,22 @@ stg_decodeDoublezu2Intzh ( D_ arg ) return (r1, r2, r3, r4); } +/* Double# -> (# Int64#, Int# #) */ +stg_decodeDoublezuInt64zh ( D_ arg ) +{ + CInt exp; + I64 mant; + W_ mant_ptr; + + STK_CHK_GEN_N (SIZEOF_INT64); + reserve BYTES_TO_WDS(SIZEOF_INT64) = mant_ptr { + (exp) = ccall __decodeDouble_Int64(mant_ptr "ptr", arg); + mant = I64[mant_ptr]; + } + + return (mant, TO_W_(exp)); +} + /* ----------------------------------------------------------------------------- * Concurrency primitives * -------------------------------------------------------------------------- */ diff --git a/rts/StgPrimFloat.c b/rts/StgPrimFloat.c index 123e77b..6e78546 100644 --- a/rts/StgPrimFloat.c +++ b/rts/StgPrimFloat.c @@ -17,6 +17,10 @@ #define IEEE_FLOATING_POINT 1 +#if FLT_RADIX != 2 +# error FLT_RADIX != 2 not supported +#endif + /* * Encoding and decoding Doubles. Code based on the HBC code * (lib/fltcode.c). @@ -158,6 +162,20 @@ __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble } } +/* This is expected to replace uses of __decodeDouble_2Int() in the long run */ +StgInt +__decodeDouble_Int64 (StgInt64 *const mantissa, const StgDouble dbl) +{ + if (dbl) { + int exp = 0; + *mantissa = (StgInt64)scalbn(frexp(dbl, &exp), DBL_MANT_DIG); + return exp-DBL_MANT_DIG; + } else { + *mantissa = 0; + return 0; + } +} + /* Convenient union types for checking the layout of IEEE 754 types - based on defs in GNU libc */ diff --git a/rts/StgPrimFloat.h b/rts/StgPrimFloat.h index 57e9db1..d3911a1 100644 --- a/rts/StgPrimFloat.h +++ b/rts/StgPrimFloat.h @@ -12,6 +12,7 @@ #include "BeginPrivate.h" /* grimy low-level support functions defined in StgPrimFloat.c */ +StgInt __decodeDouble_Int64 (StgInt64 *mantissa, StgDouble dbl); void __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble dbl); void __decodeFloat_Int (I_ *man, I_ *exp, StgFloat flt); From git at git.haskell.org Wed Sep 17 19:18:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Sep 2014 19:18:46 +0000 (UTC) Subject: [commit: ghc] master: Remove unnecessary imports in GHC.Event.KQueue to fix compiler warnings. (2622eae) Message-ID: <20140917191846.3DEDA3A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2622eae34aa58341e4df2a7d2d8aa7a0ee3c39eb/ghc >--------------------------------------------------------------- commit 2622eae34aa58341e4df2a7d2d8aa7a0ee3c39eb Author: Andreas Voellmy Date: Wed Sep 17 08:26:41 2014 -0400 Remove unnecessary imports in GHC.Event.KQueue to fix compiler warnings. Summary: The imports of Data.Monoid and Data.Maybe in GHC.Event.KQueue are unnecessary and cause validate to fail. Test Plan: Validate successfully (though I get some unrelated failures). Reviewers: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D217 >--------------------------------------------------------------- 2622eae34aa58341e4df2a7d2d8aa7a0ee3c39eb libraries/base/GHC/Event/KQueue.hsc | 2 -- 1 file changed, 2 deletions(-) diff --git a/libraries/base/GHC/Event/KQueue.hsc b/libraries/base/GHC/Event/KQueue.hsc index bc88855..439765c 100644 --- a/libraries/base/GHC/Event/KQueue.hsc +++ b/libraries/base/GHC/Event/KQueue.hsc @@ -28,8 +28,6 @@ available = False import Control.Monad (when) import Data.Bits (Bits(..), FiniteBits(..)) -import Data.Maybe (Maybe(..)) -import Data.Monoid (Monoid(..)) import Data.Word (Word16, Word32) import Foreign.C.Error (throwErrnoIfMinus1, eINTR, eINVAL, eNOTSUP, getErrno, throwErrno) From git at git.haskell.org Wed Sep 17 20:36:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Sep 2014 20:36:58 +0000 (UTC) Subject: [commit: ghc] context-quantification-4426: Add -fwarn-context-quantification (#4426) (c8e39e7) Message-ID: <20140917203658.657783A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : context-quantification-4426 Link : http://ghc.haskell.org/trac/ghc/changeset/c8e39e7f974e44fdea261db26c3a75bd8717852c/ghc >--------------------------------------------------------------- commit c8e39e7f974e44fdea261db26c3a75bd8717852c Author: Krzysztof Gogolewski Date: Sun Sep 14 16:34:01 2014 +0200 Add -fwarn-context-quantification (#4426) Summary: This warning (enabled by default) reports places where a context implicitly binds a type variable, for example type T a = {-forall m.-} Monad m => a -> m a Also update Haddock submodule. Test Plan: validate Reviewers: hvr, simonpj, goldfire, austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D211 GHC Trac Issues: #4426 >--------------------------------------------------------------- c8e39e7f974e44fdea261db26c3a75bd8717852c utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index c3a7d47..4023817 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit c3a7d4701ee64f6c29b95a6bed519f6c16b9bffd +Subproject commit 4023817d7c0e46db012ba2eea28022626841ca9b From git at git.haskell.org Wed Sep 17 20:37:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Sep 2014 20:37:01 +0000 (UTC) Subject: [commit: ghc] context-quantification-4426: Note context quantification becomes an error in 7.12; add release notes (39f62a2) Message-ID: <20140917203701.042843A35B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : context-quantification-4426 Link : http://ghc.haskell.org/trac/ghc/changeset/39f62a28beb71d5a7c7bec67af75a079a4dea092/ghc >--------------------------------------------------------------- commit 39f62a28beb71d5a7c7bec67af75a079a4dea092 Author: Krzysztof Gogolewski Date: Wed Sep 17 22:35:43 2014 +0200 Note context quantification becomes an error in 7.12; add release notes >--------------------------------------------------------------- 39f62a28beb71d5a7c7bec67af75a079a4dea092 compiler/hsSyn/HsTypes.lhs | 7 +++++-- compiler/rename/RnTypes.lhs | 3 ++- docs/users_guide/7.10.1-notes.xml | 24 ++++++++++++++++++++++ docs/users_guide/glasgow_exts.xml | 3 ++- testsuite/tests/rename/should_compile/T4426.stderr | 15 +++++++++----- 5 files changed, 43 insertions(+), 9 deletions(-) diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index 104ffe7..9bd5845 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -303,8 +303,11 @@ After renaming Explicit => the variables the user wrote (renamed) Qualified currently behaves exactly as Implicit, -but gives an additional warning if there are -implicitly quantified variables. +but it is deprecated to use it for implicit quantification. +In this case, GHC 7.10 gives a warning; see +Note [Context quantification] and Trac #4426. +In GHC 7.12, Qualified will no longer bind variables +and this will become an error. The kind variables bound in the hsq_kvs field come both a) from the kind signatures on the kind vars (eg k1) diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs index 1826f91..5537526 100644 --- a/compiler/rename/RnTypes.lhs +++ b/compiler/rename/RnTypes.lhs @@ -868,7 +868,8 @@ warnContextQuantification in_doc tvs = addWarnAt loc $ vcat [ ptext (sLit "Variable") <+> quotes (ppr tv) <+> ptext (sLit "is implicitly quantified due to a context") $$ - ptext (sLit "Use explicit forall syntax instead") + ptext (sLit "Use explicit forall syntax instead.") $$ + ptext (sLit "This will become an error in GHC 7.12.") , in_doc ] opTyErr :: RdrName -> HsType RdrName -> SDoc diff --git a/docs/users_guide/7.10.1-notes.xml b/docs/users_guide/7.10.1-notes.xml index 404d239..d319cc5 100644 --- a/docs/users_guide/7.10.1-notes.xml +++ b/docs/users_guide/7.10.1-notes.xml @@ -34,6 +34,30 @@ Added support for binary integer literals + + + Simplified rules for implicit quantification. In previous versions of GHC, + it was possible to use the => arrow + to quantify over type variables in data and + type declarations without a + forall quantifier. For example, + data Fun = Fun (Ord a => a -> b) was identical to + data Fun = Fun (forall a b. Ord a => a -> b), while + data Fun = Fun (a -> b) caused a not-in-scope error. + This implicit quantification is now deprecated, and variables + in higher-rank constructors should be quantified with forall + regardless of whether a class context is present or not. + GHC 7.10 raises a warning (controlled by + , enabled by default) + and GHC 7.12 will raise an error. See examples + in GHC documentation. + + + The change also applies to Template Haskell splices such as + [t|Ord a => a|], which should be written as + [t|forall a. Ord a => a|]. + + diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 2c314fa..13090c6 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -7732,7 +7732,8 @@ newtype Swizzle' = MkSwizzle' (Ord a => [a] -> [a]) As of GHC 7.10, this is deprecated. The -fwarn-context-quantification -flag detects this situation and issues a warning. +flag detects this situation and issues a warning. In GHC 7.12, declarations +such as MkSwizzle' will cause an out-of-scope error. diff --git a/testsuite/tests/rename/should_compile/T4426.stderr b/testsuite/tests/rename/should_compile/T4426.stderr index a68f5ed..3cce305 100644 --- a/testsuite/tests/rename/should_compile/T4426.stderr +++ b/testsuite/tests/rename/should_compile/T4426.stderr @@ -1,30 +1,35 @@ T4426.hs:6:12: Warning: Variable ?m? is implicitly quantified due to a context - Use explicit forall syntax instead + Use explicit forall syntax instead. + This will become an error in GHC 7.12. In the type ?a -> m a? In the declaration for type synonym ?F? T4426.hs:8:15: Warning: Variable ?b? is implicitly quantified due to a context - Use explicit forall syntax instead + Use explicit forall syntax instead. + This will become an error in GHC 7.12. In the type ?a -> b? In the definition of data constructor ?X? T4426.hs:10:21: Warning: Variable ?b? is implicitly quantified due to a context - Use explicit forall syntax instead + Use explicit forall syntax instead. + This will become an error in GHC 7.12. In the type ?a -> b -> c? In the definition of data constructor ?Y? T4426.hs:10:21: Warning: Variable ?c? is implicitly quantified due to a context - Use explicit forall syntax instead + Use explicit forall syntax instead. + This will become an error in GHC 7.12. In the type ?a -> b -> c? In the definition of data constructor ?Y? T4426.hs:12:17: Warning: Variable ?m? is implicitly quantified due to a context - Use explicit forall syntax instead + Use explicit forall syntax instead. + This will become an error in GHC 7.12. In the type ?m b? In the type signature for ?f? From git at git.haskell.org Wed Sep 17 21:19:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Sep 2014 21:19:29 +0000 (UTC) Subject: [commit: ghc] context-quantification-4426: Improve the error message with -fwarn-context-quantification (a3d98f9) Message-ID: <20140917211929.2275B3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : context-quantification-4426 Link : http://ghc.haskell.org/trac/ghc/changeset/a3d98f92ae46eedb8be02fb31b745de951148fb3/ghc >--------------------------------------------------------------- commit a3d98f92ae46eedb8be02fb31b745de951148fb3 Author: Krzysztof Gogolewski Date: Wed Sep 17 23:19:10 2014 +0200 Improve the error message with -fwarn-context-quantification >--------------------------------------------------------------- a3d98f92ae46eedb8be02fb31b745de951148fb3 compiler/rename/RnTypes.lhs | 4 ++-- testsuite/tests/rename/should_compile/T4426.stderr | 10 +++++----- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs index 5537526..c719191 100644 --- a/compiler/rename/RnTypes.lhs +++ b/compiler/rename/RnTypes.lhs @@ -156,7 +156,7 @@ rnHsTyKi isType doc (HsForAllTy Implicit _ lctxt@(L _ ctxt) ty) rnForAll doc Implicit forall_kvs (mkHsQTvs tyvar_bndrs) lctxt ty -rnHsTyKi isType doc (HsForAllTy Qualified _ lctxt@(L _ ctxt) ty) +rnHsTyKi isType doc fulltype@(HsForAllTy Qualified _ lctxt@(L _ ctxt) ty) = ASSERT( isType ) do rdr_env <- getLocalRdrEnv loc <- getSrcSpanM @@ -164,7 +164,7 @@ rnHsTyKi isType doc (HsForAllTy Qualified _ lctxt@(L _ ctxt) ty) (forall_kvs, forall_tvs) = filterInScope rdr_env $ extractHsTysRdrTyVars (ty:ctxt) tyvar_bndrs = userHsTyVarBndrs loc forall_tvs - in_type_doc = ptext (sLit "In the type") <+> quotes (ppr ty) + in_type_doc = ptext (sLit "In the type") <+> quotes (ppr fulltype) -- See Note [Context quantification] warnContextQuantification (in_type_doc $$ docOfHsDocContext doc) tyvar_bndrs diff --git a/testsuite/tests/rename/should_compile/T4426.stderr b/testsuite/tests/rename/should_compile/T4426.stderr index 3cce305..f4e0c47 100644 --- a/testsuite/tests/rename/should_compile/T4426.stderr +++ b/testsuite/tests/rename/should_compile/T4426.stderr @@ -3,33 +3,33 @@ T4426.hs:6:12: Warning: Variable ?m? is implicitly quantified due to a context Use explicit forall syntax instead. This will become an error in GHC 7.12. - In the type ?a -> m a? + In the type ?Monad m => a -> m a? In the declaration for type synonym ?F? T4426.hs:8:15: Warning: Variable ?b? is implicitly quantified due to a context Use explicit forall syntax instead. This will become an error in GHC 7.12. - In the type ?a -> b? + In the type ?Eq b => a -> b? In the definition of data constructor ?X? T4426.hs:10:21: Warning: Variable ?b? is implicitly quantified due to a context Use explicit forall syntax instead. This will become an error in GHC 7.12. - In the type ?a -> b -> c? + In the type ?Eq b => a -> b -> c? In the definition of data constructor ?Y? T4426.hs:10:21: Warning: Variable ?c? is implicitly quantified due to a context Use explicit forall syntax instead. This will become an error in GHC 7.12. - In the type ?a -> b -> c? + In the type ?Eq b => a -> b -> c? In the definition of data constructor ?Y? T4426.hs:12:17: Warning: Variable ?m? is implicitly quantified due to a context Use explicit forall syntax instead. This will become an error in GHC 7.12. - In the type ?m b? + In the type ?Monad m => m b? In the type signature for ?f? From git at git.haskell.org Wed Sep 17 22:05:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Sep 2014 22:05:49 +0000 (UTC) Subject: [commit: packages/binary] branch 'ghc-head' created Message-ID: <20140917220549.302C63A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary New branch : ghc-head Referencing: f5f6fe72bd069a2b56dd52e645aad406c6195526 From git at git.haskell.org Wed Sep 17 22:05:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Sep 2014 22:05:51 +0000 (UTC) Subject: [commit: packages/binary] ghc-head: Use explicit import-list for `GHC.Base` import (f5f6fe7) Message-ID: <20140917220551.39CE43A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : ghc-head Link : http://git.haskell.org/packages/binary.git/commitdiff/f5f6fe72bd069a2b56dd52e645aad406c6195526 >--------------------------------------------------------------- commit f5f6fe72bd069a2b56dd52e645aad406c6195526 Author: Herbert Valerio Riedel Date: Thu Sep 18 00:02:54 2014 +0200 Use explicit import-list for `GHC.Base` import submitted upstream as https://github.com/kolmodin/binary/pull/59 >--------------------------------------------------------------- f5f6fe72bd069a2b56dd52e645aad406c6195526 src/Data/Binary/Builder/Base.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Binary/Builder/Base.hs b/src/Data/Binary/Builder/Base.hs index d6bb32a..cc40272 100644 --- a/src/Data/Binary/Builder/Base.hs +++ b/src/Data/Binary/Builder/Base.hs @@ -81,7 +81,7 @@ import qualified Data.ByteString.Lazy.Internal as L #endif #if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) -import GHC.Base +import GHC.Base (ord,Int(..),uncheckedShiftRL#) import GHC.Word (Word32(..),Word16(..),Word64(..)) # if WORD_SIZE_IN_BITS < 64 import GHC.Word (uncheckedShiftRL64#) From git at git.haskell.org Thu Sep 18 09:43:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 09:43:48 +0000 (UTC) Subject: [commit: packages/haskeline] master: Merge pull request #10 from hvr/pr-base48 (9295332) Message-ID: <20140918094348.C11113A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/9295332344b4883f95fefd25b670f9986c038836 >--------------------------------------------------------------- commit 9295332344b4883f95fefd25b670f9986c038836 Merge: 0f4ba2c 4a26c23 Author: Judah Jacobson Date: Wed Sep 17 23:43:04 2014 -0700 Merge pull request #10 from hvr/pr-base48 Changes to accomodate GHC HEAD/7.10 >--------------------------------------------------------------- 9295332344b4883f95fefd25b670f9986c038836 System/Console/Haskeline/Backend/Win32.hsc | 2 +- haskeline.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) From git at git.haskell.org Thu Sep 18 09:44:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 09:44:01 +0000 (UTC) Subject: [commit: packages/terminfo] master: Merge pull request #3 from hvr/pr-base48 (8cc0a59) Message-ID: <20140918094401.4C93B3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/terminfo On branch : master Link : http://git.haskell.org/packages/terminfo.git/commitdiff/8cc0a5902b7e40eb01b05d165bc013f64bf6c05d >--------------------------------------------------------------- commit 8cc0a5902b7e40eb01b05d165bc013f64bf6c05d Merge: 1ce8379 de93eba Author: Judah Jacobson Date: Wed Sep 17 23:43:48 2014 -0700 Merge pull request #3 from hvr/pr-base48 Bump upper bound on `base` to accomodate GHC HEAD-to-become-7.10 >--------------------------------------------------------------- 8cc0a5902b7e40eb01b05d165bc013f64bf6c05d terminfo.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) From git at git.haskell.org Thu Sep 18 17:41:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 17:41:03 +0000 (UTC) Subject: [commit: ghc] master: Comments only: explain checkAxInstCo in OptCoercion (393f0bb) Message-ID: <20140918174103.E1B1F3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/393f0bbf9a36b4137457efee79e6562675cf1902/ghc >--------------------------------------------------------------- commit 393f0bbf9a36b4137457efee79e6562675cf1902 Author: Richard Eisenberg Date: Thu Sep 18 13:40:47 2014 -0400 Comments only: explain checkAxInstCo in OptCoercion >--------------------------------------------------------------- 393f0bbf9a36b4137457efee79e6562675cf1902 compiler/types/OptCoercion.lhs | 61 +++++++++++++++++++++++++++++++++--------- 1 file changed, 48 insertions(+), 13 deletions(-) diff --git a/compiler/types/OptCoercion.lhs b/compiler/types/OptCoercion.lhs index 6eccf42..5cc2e64 100644 --- a/compiler/types/OptCoercion.lhs +++ b/compiler/types/OptCoercion.lhs @@ -455,6 +455,7 @@ opt_trans_rule is co1 co2 -- Push transitivity inside axioms opt_trans_rule is co1 co2 + -- See Note [Why call checkAxInstCo during optimisation] -- TrPushSymAxR | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe , Just cos2 <- matchAxiom sym con ind co2 @@ -537,13 +538,47 @@ Equal :: forall k::BOX. k -> k -> Bool axEqual :: { forall k::BOX. forall a::k. Equal k a a ~ True ; forall k::BOX. forall a::k. forall b::k. Equal k a b ~ False } -We wish to disallow (axEqual[1] <*> ) :: (Equal * Int Int ~ False) and that all is -OK. But, all is not OK: we want to use the first branch of the axiom in this case, -not the second. The problem is that the parameters of the first branch can unify with -the supplied coercions, thus meaning that the first branch should be taken. See also -Note [Branched instance checking] in types/FamInstEnv.lhs. +We wish to disallow (axEqual[1] <*> ) :: (Equal * Int Int ~ +False) and that all is OK. But, all is not OK: we want to use the first branch +of the axiom in this case, not the second. The problem is that the parameters +of the first branch can unify with the supplied coercions, thus meaning that +the first branch should be taken. See also Note [Branched instance checking] +in types/FamInstEnv.lhs. + +Note [Why call checkAxInstCo during optimisation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It is possible that otherwise-good-looking optimisations meet with disaster +in the presence of axioms with multiple equations. Consider + +type family Equal (a :: *) (b :: *) :: Bool where + Equal a a = True + Equal a b = False +type family Id (a :: *) :: * where + Id a = a + +axEq :: { [a::*]. Equal a a ~ True + ; [a::*, b::*]. Equal a b ~ False } +axId :: [a::*]. Id a ~ a + +co1 = Equal (axId[0] Int) (axId[0] Bool) + :: Equal (Id Int) (Id Bool) ~ Equal Int Bool +co2 = axEq[1] + :: Equal Int Bool ~ False + +We wish to optimise (co1 ; co2). We end up in rule TrPushAxL, noting that +co2 is an axiom and that matchAxiom succeeds when looking at co1. But, what +happens when we push the coercions inside? We get + +co3 = axEq[1] (axId[0] Int) (axId[0] Bool) + :: Equal (Id Int) (Id Bool) ~ False + +which is bogus! This is because the type system isn't smart enough to know +that (Id Int) and (Id Bool) are Surely Apart, as they're headed by type +families. At the time of writing, I (Richard Eisenberg) couldn't think of +a way of detecting this any more efficient than just building the optimised +coercion and checking. \begin{code} -- | Check to make sure that an AxInstCo is internally consistent. @@ -554,12 +589,12 @@ checkAxInstCo :: Coercion -> Maybe CoAxBranch -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] in CoreLint checkAxInstCo (AxiomInstCo ax ind cos) - = let branch = coAxiomNthBranch ax ind - tvs = coAxBranchTyVars branch - incomps = coAxBranchIncomps branch - tys = map (pFst . coercionKind) cos - subst = zipOpenTvSubst tvs tys - target = Type.substTys subst (coAxBranchLHS branch) + = let branch = coAxiomNthBranch ax ind + tvs = coAxBranchTyVars branch + incomps = coAxBranchIncomps branch + tys = map (pFst . coercionKind) cos + subst = zipOpenTvSubst tvs tys + target = Type.substTys subst (coAxBranchLHS branch) in_scope = mkInScopeSet $ unionVarSets (map (tyVarsOfTypes . coAxBranchLHS) incomps) flattened_target = flattenTys in_scope target in From git at git.haskell.org Thu Sep 18 20:48:02 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 20:48:02 +0000 (UTC) Subject: [commit: ghc] master: Update haddock submodule for package key fix. (a8d7f81) Message-ID: <20140918204802.041EF3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a8d7f81d1f6a9ea658c6f1a965bb3e7717b11e40/ghc >--------------------------------------------------------------- commit a8d7f81d1f6a9ea658c6f1a965bb3e7717b11e40 Author: Edward Z. Yang Date: Thu Sep 18 13:47:49 2014 -0700 Update haddock submodule for package key fix. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- a8d7f81d1f6a9ea658c6f1a965bb3e7717b11e40 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index c3a7d47..ee47a1a 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit c3a7d4701ee64f6c29b95a6bed519f6c16b9bffd +Subproject commit ee47a1ab37699db0573c9cf0aa6461e1f8865197 From git at git.haskell.org Thu Sep 18 21:01:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 21:01:20 +0000 (UTC) Subject: [commit: ghc] master: Fix formatting bug in core-spec. (c4c8924) Message-ID: <20140918210120.1CF1D3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c4c892456d29740118ca80cbc565ef4750885e13/ghc >--------------------------------------------------------------- commit c4c892456d29740118ca80cbc565ef4750885e13 Author: Richard Eisenberg Date: Thu Sep 18 17:00:37 2014 -0400 Fix formatting bug in core-spec. >--------------------------------------------------------------- c4c892456d29740118ca80cbc565ef4750885e13 docs/core-spec/CoreLint.ott | 2 +- docs/core-spec/CoreSyn.ott | 2 ++ docs/core-spec/core-spec.pdf | Bin 339274 -> 339243 bytes 3 files changed, 3 insertions(+), 1 deletion(-) diff --git a/docs/core-spec/CoreLint.ott b/docs/core-spec/CoreLint.ott index 4c51a05..56b4b99 100644 --- a/docs/core-spec/CoreLint.ott +++ b/docs/core-spec/CoreLint.ott @@ -247,7 +247,7 @@ G |-co g t0 : s[m |-> t0] ~R k t[n |-> t0] C = T_R0 0 <= ind < length -forall . ( ~> t1) = ()[ind] +forall . ( ~> t1) = ()[ind] = inits( s'i ] // i />) diff --git a/docs/core-spec/CoreSyn.ott b/docs/core-spec/CoreSyn.ott index 56594ec..0c5b304 100644 --- a/docs/core-spec/CoreSyn.ott +++ b/docs/core-spec/CoreSyn.ott @@ -235,6 +235,8 @@ type_list :: 'TypeList_' ::= {{ com List of types }} RA {{ tex {\!\!\!{}_{\rho} } }} :: 'RoleAnnot_' ::= {{ com Role annotation }} | _ R :: M :: annotation {{ tex {\!\!\!{}_{[[R]]} } }} + | _ ^^ R :: M :: spaced_annotation + {{ tex {}_{[[R]]} }} role_list {{ tex {\overline{\rho_j} }^j }} :: 'RoleList_' ::= {{ com List of roles }} | :: :: List diff --git a/docs/core-spec/core-spec.pdf b/docs/core-spec/core-spec.pdf index 5d9f29c..52f2e39 100644 Binary files a/docs/core-spec/core-spec.pdf and b/docs/core-spec/core-spec.pdf differ From git at git.haskell.org Thu Sep 18 21:13:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 21:13:18 +0000 (UTC) Subject: [commit: ghc] master: Move `when` to GHC.Base (eae1911) Message-ID: <20140918211318.37FFC3A003@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eae19112462fe77a3f1298bff12b409b205a581d/ghc >--------------------------------------------------------------- commit eae19112462fe77a3f1298bff12b409b205a581d Author: Herbert Valerio Riedel Date: Thu Sep 18 23:05:35 2014 +0200 Move `when` to GHC.Base This allows several modules to avoid importing Control.Monad and thus break import cycles that manifest themselves when implementing #9586 Reviewed By: austin, ekmett Differential Revision: https://phabricator.haskell.org/D222 >--------------------------------------------------------------- eae19112462fe77a3f1298bff12b409b205a581d libraries/base/Control/Concurrent.hs | 1 - libraries/base/Control/Monad.hs | 15 --------------- libraries/base/Data/Data.hs | 2 +- libraries/base/Data/Functor.hs | 2 +- libraries/base/Data/Traversable.hs | 3 +-- libraries/base/Data/Version.hs | 3 +-- libraries/base/Debug/Trace.hs | 1 - libraries/base/Foreign/C/Error.hs | 2 +- libraries/base/Foreign/C/String.hs | 2 -- libraries/base/Foreign/Marshal/Pool.hs | 3 +-- libraries/base/GHC/Base.lhs | 12 ++++++++++++ libraries/base/GHC/Event/Array.hs | 1 - libraries/base/GHC/Event/Control.hs | 1 - libraries/base/GHC/Event/EPoll.hsc | 1 - libraries/base/GHC/Event/IntTable.hs | 7 +++---- libraries/base/GHC/Event/Manager.hs | 2 +- libraries/base/GHC/Event/Poll.hsc | 3 +-- libraries/base/GHC/Event/Thread.hs | 2 +- libraries/base/GHC/Event/TimerManager.hs | 2 +- libraries/base/GHC/Fingerprint.hs | 1 - libraries/base/GHC/Foreign.hs | 1 - libraries/base/GHC/IO/FD.hs | 1 - libraries/base/GHC/IO/Handle.hs | 2 +- libraries/base/GHC/IO/Handle/Internals.hs | 1 - libraries/base/GHC/IO/Handle/Text.hs | 1 - libraries/base/System/Posix/Internals.hs | 5 +---- 26 files changed, 27 insertions(+), 50 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc eae19112462fe77a3f1298bff12b409b205a581d From git at git.haskell.org Thu Sep 18 21:13:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 21:13:15 +0000 (UTC) Subject: [commit: ghc] master: Move (=<<) to GHC.Base (8b90836) Message-ID: <20140918211315.8E3823A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8b9083655f34120b47fe407123272e0687e0bd60/ghc >--------------------------------------------------------------- commit 8b9083655f34120b47fe407123272e0687e0bd60 Author: Herbert Valerio Riedel Date: Thu Sep 18 23:05:31 2014 +0200 Move (=<<) to GHC.Base This allows GHC.Stack to avoid importing Control.Monad, and is preparatory work for implementing #9586 Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D221 >--------------------------------------------------------------- 8b9083655f34120b47fe407123272e0687e0bd60 libraries/base/Control/Monad.hs | 6 ------ libraries/base/GHC/Base.lhs | 6 ++++++ libraries/base/GHC/Event/Manager.hs | 2 +- libraries/base/GHC/Event/Poll.hsc | 2 +- libraries/base/GHC/Event/TimerManager.hs | 2 +- libraries/base/GHC/Stack.hsc | 2 -- 6 files changed, 9 insertions(+), 11 deletions(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 532c42c..089e996 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -81,17 +81,11 @@ import Data.Maybe import GHC.List import GHC.Base -infixr 1 =<< infixl 3 <|> -- ----------------------------------------------------------------------------- -- Prelude monad functions --- | Same as '>>=', but with the arguments interchanged. -{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-} -(=<<) :: Monad m => (a -> m b) -> m a -> m b -f =<< x = x >>= f - -- | Evaluate each action in the sequence from left to right, -- and collect the results. sequence :: Monad m => [m a] -> m [a] diff --git a/libraries/base/GHC/Base.lhs b/libraries/base/GHC/Base.lhs index 54ba348..14a6957 100644 --- a/libraries/base/GHC/Base.lhs +++ b/libraries/base/GHC/Base.lhs @@ -121,6 +121,7 @@ infixr 9 . infixr 5 ++ infixl 4 <$ infixl 1 >>, >>= +infixr 1 =<< infixr 0 $, $! infixl 4 <*>, <*, *>, <**> @@ -487,6 +488,11 @@ original default. -} +-- | Same as '>>=', but with the arguments interchanged. +{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-} +(=<<) :: Monad m => (a -> m b) -> m a -> m b +f =<< x = x >>= f + -- | Promote a function to a monad. liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r liftM f m1 = do { x1 <- m1; return (f x1) } diff --git a/libraries/base/GHC/Event/Manager.hs b/libraries/base/GHC/Event/Manager.hs index 9f12ecd..b6c028a 100644 --- a/libraries/base/GHC/Event/Manager.hs +++ b/libraries/base/GHC/Event/Manager.hs @@ -52,7 +52,7 @@ module GHC.Event.Manager import Control.Concurrent.MVar (MVar, newMVar, readMVar, putMVar, tryPutMVar, takeMVar, withMVar) import Control.Exception (onException) -import Control.Monad ((=<<), forM_, when, replicateM, void) +import Control.Monad (forM_, when, replicateM, void) import Data.Bits ((.&.)) import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef, writeIORef) diff --git a/libraries/base/GHC/Event/Poll.hsc b/libraries/base/GHC/Event/Poll.hsc index fd05a13..686bc71 100644 --- a/libraries/base/GHC/Event/Poll.hsc +++ b/libraries/base/GHC/Event/Poll.hsc @@ -26,7 +26,7 @@ available = False #include import Control.Concurrent.MVar (MVar, newMVar, swapMVar) -import Control.Monad ((=<<), unless) +import Control.Monad (unless) import Data.Bits (Bits, FiniteBits, (.|.), (.&.)) import Data.Word import Foreign.C.Types (CInt(..), CShort(..)) diff --git a/libraries/base/GHC/Event/TimerManager.hs b/libraries/base/GHC/Event/TimerManager.hs index 435693a..e55dddf 100644 --- a/libraries/base/GHC/Event/TimerManager.hs +++ b/libraries/base/GHC/Event/TimerManager.hs @@ -39,7 +39,7 @@ module GHC.Event.TimerManager -- Imports import Control.Exception (finally) -import Control.Monad ((=<<), sequence_, when) +import Control.Monad (sequence_, when) import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef, writeIORef) import GHC.Base diff --git a/libraries/base/GHC/Stack.hsc b/libraries/base/GHC/Stack.hsc index 0b30391..91fddfb 100644 --- a/libraries/base/GHC/Stack.hsc +++ b/libraries/base/GHC/Stack.hsc @@ -34,8 +34,6 @@ module GHC.Stack ( renderStack ) where -import Control.Monad ( (=<<) ) - import Foreign import Foreign.C From git at git.haskell.org Thu Sep 18 21:13:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 21:13:20 +0000 (UTC) Subject: [commit: ghc] master: Move Applicative/MonadPlus into GHC.Base (a94dc4c) Message-ID: <20140918211320.CAED83A003@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a94dc4c3067c6a0925e2e39f35ef0930771535f1/ghc >--------------------------------------------------------------- commit a94dc4c3067c6a0925e2e39f35ef0930771535f1 Author: Herbert Valerio Riedel Date: Thu Sep 18 23:05:40 2014 +0200 Move Applicative/MonadPlus into GHC.Base This is necessary in order to invert the import-dependency between Data.Foldable and Control.Monad (for addressing #9586) This also updates the `binary` submodule to qualify a GHC.Base import Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D223 >--------------------------------------------------------------- a94dc4c3067c6a0925e2e39f35ef0930771535f1 libraries/base/Control/Applicative.hs | 9 +-- libraries/base/Control/Monad.hs | 72 ---------------------- libraries/base/Data/Data.hs | 1 - libraries/base/Data/Foldable.hs | 6 +- libraries/base/Data/Typeable/Internal.hs | 5 +- libraries/base/GHC/Base.lhs | 71 +++++++++++++++++++++ libraries/base/GHC/Conc/Sync.lhs | 1 - libraries/base/GHC/Enum.lhs | 2 +- libraries/base/GHC/Event/Array.hs | 2 +- libraries/base/GHC/Event/PSQ.hs | 2 +- libraries/base/System/IO/Error.hs | 4 -- libraries/base/Text/ParserCombinators/ReadP.hs | 4 +- libraries/base/Text/ParserCombinators/ReadPrec.hs | 1 - libraries/binary | 2 +- testsuite/tests/ghci/scripts/ghci025.stdout | 2 +- testsuite/tests/ghci/scripts/ghci027.stdout | 8 +-- testsuite/tests/simplCore/should_compile/T5359a.hs | 2 +- 17 files changed, 91 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 a94dc4c3067c6a0925e2e39f35ef0930771535f1 From git at git.haskell.org Thu Sep 18 21:13:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 21:13:23 +0000 (UTC) Subject: [commit: ghc] master: Invert module-dep between Control.Monad and Data.Foldable (af22696) Message-ID: <20140918211323.5C7BE3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/af22696b8f6d8b677c33f70537a5999ad94266cd/ghc >--------------------------------------------------------------- commit af22696b8f6d8b677c33f70537a5999ad94266cd Author: Herbert Valerio Riedel Date: Thu Sep 18 23:05:47 2014 +0200 Invert module-dep between Control.Monad and Data.Foldable This is the last preparation needed before generalizing entities in Control.Monad conflicting with those from Data.Foldable (re #9586) Reviewed By: ekmett, austin Differential Revision: https://phabricator.haskell.org/D225 >--------------------------------------------------------------- af22696b8f6d8b677c33f70537a5999ad94266cd libraries/base/Control/Applicative.hs | 4 ++++ libraries/base/Control/Monad.hs | 1 + libraries/base/Data/Foldable.hs | 4 ---- libraries/base/Text/ParserCombinators/ReadP.hs | 5 ++++- libraries/base/Text/Read/Lex.hs | 8 +++++++- 5 files changed, 16 insertions(+), 6 deletions(-) diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs index accf58f..d6157b3 100644 --- a/libraries/base/Control/Applicative.hs +++ b/libraries/base/Control/Applicative.hs @@ -53,6 +53,7 @@ import Data.Maybe import Data.Tuple import Data.Eq import Data.Ord +import Data.Foldable (Foldable(..)) import Data.Functor ((<$>)) import GHC.Base hiding ((.), id) @@ -64,6 +65,9 @@ import GHC.Show (Show) newtype Const a b = Const { getConst :: a } deriving (Generic, Generic1) +instance Foldable (Const m) where + foldMap _ _ = mempty + instance Functor (Const m) where fmap _ (Const v) = Const v diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 0597055..3487a09 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -76,6 +76,7 @@ module Control.Monad , (<$!>) ) where +import Data.Foldable () import Data.Functor ( void ) import Data.Maybe diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index 0e655de..f6f787b 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -58,7 +58,6 @@ module Data.Foldable ( find ) where -import Control.Applicative ( Const ) import Data.Bool import Data.Either import Data.Eq @@ -202,9 +201,6 @@ instance Foldable Proxy where foldr1 _ _ = error "foldr1: Proxy" {-# INLINE foldr1 #-} -instance Foldable (Const m) where - foldMap _ _ = mempty - -- | Monadic fold over the elements of a structure, -- associating to the right, i.e. from right to left. foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b diff --git a/libraries/base/Text/ParserCombinators/ReadP.hs b/libraries/base/Text/ParserCombinators/ReadP.hs index 3d2b39c..0139e77 100644 --- a/libraries/base/Text/ParserCombinators/ReadP.hs +++ b/libraries/base/Text/ParserCombinators/ReadP.hs @@ -72,7 +72,6 @@ module Text.ParserCombinators.ReadP ) where -import Control.Monad ( sequence ) import {-# SOURCE #-} GHC.Unicode ( isSpace ) import GHC.List ( replicate, null ) import GHC.Base hiding ( many ) @@ -311,6 +310,10 @@ count :: Int -> ReadP a -> ReadP [a] -- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of -- results is returned. count n p = sequence (replicate n p) + where -- local 'sequence' to avoid import-cycle + sequence ms = foldr k (return []) ms + where + k m m' = do { x <- m; xs <- m'; return (x:xs) } between :: ReadP open -> ReadP close -> ReadP a -> ReadP a -- ^ @between open close p@ parses @open@, followed by @p@ and finally diff --git a/libraries/base/Text/Read/Lex.hs b/libraries/base/Text/Read/Lex.hs index 557637d..39ca46a 100644 --- a/libraries/base/Text/Read/Lex.hs +++ b/libraries/base/Text/Read/Lex.hs @@ -45,7 +45,13 @@ import GHC.Real( Rational, (%), fromIntegral, import GHC.List import GHC.Enum( minBound, maxBound ) import Data.Maybe -import Control.Monad + +-- local copy to break import-cycle +-- | @'guard' b@ is @'return' ()@ if @b@ is 'True', +-- and 'mzero' if @b@ is 'False'. +guard :: (MonadPlus m) => Bool -> m () +guard True = return () +guard False = mzero -- ----------------------------------------------------------------------------- -- Lexing types From git at git.haskell.org Thu Sep 18 21:13:25 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 21:13:25 +0000 (UTC) Subject: [commit: ghc] master: Move Control.Monad.void into Data.Functor (fbf1e30) Message-ID: <20140918211325.E02053A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fbf1e3065bf32317db8e87afe8a58ceee2c02241/ghc >--------------------------------------------------------------- commit fbf1e3065bf32317db8e87afe8a58ceee2c02241 Author: Herbert Valerio Riedel Date: Thu Sep 18 23:05:43 2014 +0200 Move Control.Monad.void into Data.Functor Both modules still export `void`, but `void`'s implementation now lives in Data.Functor where it actually belongs in (as it doesn't need a Monad context) The desired side-effect of this is to invert the import-dep between Control.Monad and Data.Functor. Reviewed By: ekmett, austin Differential Revision: https://phabricator.haskell.org/D224 >--------------------------------------------------------------- fbf1e3065bf32317db8e87afe8a58ceee2c02241 libraries/base/Control/Monad.hs | 5 +---- libraries/base/Data/Functor.hs | 7 +++++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 534e652..0597055 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -76,6 +76,7 @@ module Control.Monad , (<$!>) ) where +import Data.Functor ( void ) import Data.Maybe import GHC.List @@ -159,10 +160,6 @@ forever a = let a' = a >> a' in a' -- Use explicit sharing here, as it is prevents a space leak regardless of -- optimizations. --- | @'void' value@ discards or ignores the result of evaluation, such as the return value of an 'IO' action. -void :: Functor f => f a -> f () -void = fmap (const ()) - -- ----------------------------------------------------------------------------- -- Other monad functions diff --git a/libraries/base/Data/Functor.hs b/libraries/base/Data/Functor.hs index 00cc254..43ca821 100644 --- a/libraries/base/Data/Functor.hs +++ b/libraries/base/Data/Functor.hs @@ -23,8 +23,7 @@ module Data.Functor void, ) where -import Control.Monad ( void ) -import GHC.Base ( Functor(..), flip ) +import GHC.Base ( Functor(..), const, flip ) infixl 4 <$> @@ -40,3 +39,7 @@ infixl 4 $> ($>) :: Functor f => f a -> b -> f b ($>) = flip (<$) +-- | @'void' value@ discards or ignores the result of evaluation, such as the +-- return value of an 'IO' action. +void :: Functor f => f a -> f () +void = fmap (const ()) From git at git.haskell.org Thu Sep 18 21:13:28 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 21:13:28 +0000 (UTC) Subject: [commit: ghc] master: Generalise Control.Monad.{sequence_, msum, mapM_, forM_} (b406085) Message-ID: <20140918211328.6ABDC3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b4060858f5201489e11ab57063e72380c03c3b55/ghc >--------------------------------------------------------------- commit b4060858f5201489e11ab57063e72380c03c3b55 Author: Herbert Valerio Riedel Date: Thu Sep 18 23:05:57 2014 +0200 Generalise Control.Monad.{sequence_,msum,mapM_,forM_} This finally takes the gloves off, and performs the first actual generalization in order to implement #9586. This re-exports the respective definitions for the 4 combinators defined in Data.Foldable. This way, importing Data.Foldable and Control.Monad unqualified won't bring conflicting definitions of those 4 entities into scope anymore. This change seems to have some minor effect on rule-firing, which causes some wibble in the test-case T4007 Reviewed By: ekmett, austin Differential Revision: https://phabricator.haskell.org/D226 >--------------------------------------------------------------- b4060858f5201489e11ab57063e72380c03c3b55 libraries/base/Control/Monad.hs | 27 ++------------------------- testsuite/tests/perf/compiler/T4007.stdout | 5 ++++- 2 files changed, 6 insertions(+), 26 deletions(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 3487a09..eb00939 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -76,12 +76,11 @@ module Control.Monad , (<$!>) ) where -import Data.Foldable () +import Data.Foldable ( sequence_, msum, mapM_, forM_ ) import Data.Functor ( void ) -import Data.Maybe -import GHC.List import GHC.Base +import GHC.List ( zipWith, unzip, replicate ) -- ----------------------------------------------------------------------------- -- Prelude monad functions @@ -94,22 +93,11 @@ sequence ms = foldr k (return []) ms where k m m' = do { x <- m; xs <- m'; return (x:xs) } --- | Evaluate each action in the sequence from left to right, --- and ignore the results. -sequence_ :: Monad m => [m a] -> m () -{-# INLINE sequence_ #-} -sequence_ ms = foldr (>>) (return ()) ms - -- | @'mapM' f@ is equivalent to @'sequence' . 'map' f at . mapM :: Monad m => (a -> m b) -> [a] -> m [b] {-# INLINE mapM #-} mapM f as = sequence (map f as) --- | @'mapM_' f@ is equivalent to @'sequence_' . 'map' f at . -mapM_ :: Monad m => (a -> m b) -> [a] -> m () -{-# INLINE mapM_ #-} -mapM_ f as = sequence_ (map f as) - -- ----------------------------------------------------------------------------- -- Functions mandated by the Prelude @@ -133,17 +121,6 @@ forM :: Monad m => [a] -> (a -> m b) -> m [b] {-# INLINE forM #-} forM = flip mapM --- | 'forM_' is 'mapM_' with its arguments flipped -forM_ :: Monad m => [a] -> (a -> m b) -> m () -{-# INLINE forM_ #-} -forM_ = flip mapM_ - --- | This generalizes the list-based 'concat' function. - -msum :: MonadPlus m => [m a] -> m a -{-# INLINE msum #-} -msum = foldr mplus mzero - infixr 1 <=<, >=> -- | Left-to-right Kleisli composition of monads. diff --git a/testsuite/tests/perf/compiler/T4007.stdout b/testsuite/tests/perf/compiler/T4007.stdout index 83a1f16..aabd610 100644 --- a/testsuite/tests/perf/compiler/T4007.stdout +++ b/testsuite/tests/perf/compiler/T4007.stdout @@ -1,11 +1,14 @@ Rule fired: unpack -Rule fired: Class op return Rule fired: Class op >> +Rule fired: Class op return +Rule fired: Class op foldr Rule fired: Class op >> Rule fired: Class op return +Rule fired: Class op foldr Rule fired: Class op >> Rule fired: Class op return Rule fired: <=# Rule fired: tagToEnum# +Rule fired: Class op foldr Rule fired: fold/build Rule fired: unpack-list From git at git.haskell.org Thu Sep 18 21:17:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 21:17:14 +0000 (UTC) Subject: [commit: ghc] master: Revert "Update haddock submodule for package key fix." (ed58ec0) Message-ID: <20140918211714.2344F3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ed58ec059c3a3d6f550f42b2707e59f851b8f90d/ghc >--------------------------------------------------------------- commit ed58ec059c3a3d6f550f42b2707e59f851b8f90d Author: Edward Z. Yang Date: Thu Sep 18 14:17:08 2014 -0700 Revert "Update haddock submodule for package key fix." This reverts commit a8d7f81d1f6a9ea658c6f1a965bb3e7717b11e40. >--------------------------------------------------------------- ed58ec059c3a3d6f550f42b2707e59f851b8f90d utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index ee47a1a..c3a7d47 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit ee47a1ab37699db0573c9cf0aa6461e1f8865197 +Subproject commit c3a7d4701ee64f6c29b95a6bed519f6c16b9bffd From git at git.haskell.org Thu Sep 18 22:20:41 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 22:20:41 +0000 (UTC) Subject: [commit: ghc] master: Add -fwarn-context-quantification (#4426) (275dcaf) Message-ID: <20140918222041.05D453A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/275dcafbfb6b371dd5d8943fa4df9c23e68f6165/ghc >--------------------------------------------------------------- commit 275dcafbfb6b371dd5d8943fa4df9c23e68f6165 Author: Krzysztof Gogolewski Date: Thu Sep 18 14:52:50 2014 -0700 Add -fwarn-context-quantification (#4426) Summary: This warning (enabled by default) reports places where a context implicitly binds a type variable, for example type T a = {-forall m.-} Monad m => a -> m a Also update Haddock submodule. Test Plan: validate Reviewers: hvr, goldfire, simonpj, austin Reviewed By: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D211 GHC Trac Issues: #4426 >--------------------------------------------------------------- 275dcafbfb6b371dd5d8943fa4df9c23e68f6165 compiler/hsSyn/HsDecls.lhs | 8 +++- compiler/hsSyn/HsTypes.lhs | 30 +++++++++---- compiler/main/DynFlags.hs | 5 ++- compiler/main/GhcMonad.hs | 2 +- compiler/parser/Parser.y.pp | 6 +-- compiler/parser/RdrHsSyn.lhs | 4 +- compiler/rename/RnSource.lhs | 13 ++++-- compiler/rename/RnTypes.lhs | 49 +++++++++++++++++++++- docs/users_guide/7.10.1-notes.xml | 24 +++++++++++ docs/users_guide/glasgow_exts.xml | 22 +++++----- docs/users_guide/using.xml | 26 +++++++++++- testsuite/tests/rename/should_compile/T4426.hs | 22 ++++++++++ testsuite/tests/rename/should_compile/T4426.stderr | 35 ++++++++++++++++ testsuite/tests/rename/should_compile/all.T | 1 + testsuite/tests/th/T7021a.hs | 4 +- testsuite/tests/th/T8807.hs | 4 +- testsuite/tests/typecheck/should_compile/T3018.hs | 2 +- testsuite/tests/typecheck/should_compile/tc092.hs | 2 +- utils/haddock | 2 +- 19 files changed, 217 insertions(+), 44 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 275dcafbfb6b371dd5d8943fa4df9c23e68f6165 From git at git.haskell.org Thu Sep 18 22:47:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 22:47:45 +0000 (UTC) Subject: [commit: packages/array] master: Adapt to Data.List/Foldable generalisation (f795552) Message-ID: <20140918224745.80E6A3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/array On branch : master Link : http://git.haskell.org/packages/array.git/commitdiff/f7955522c45a6b7da352349381d93be7c38dff35 >--------------------------------------------------------------- commit f7955522c45a6b7da352349381d93be7c38dff35 Author: Herbert Valerio Riedel Date: Fri Sep 19 00:42:13 2014 +0200 Adapt to Data.List/Foldable generalisation >--------------------------------------------------------------- f7955522c45a6b7da352349381d93be7c38dff35 Data/Array/Base.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs index c1a2afe..b57ae4a 100644 --- a/Data/Array/Base.hs +++ b/Data/Array/Base.hs @@ -461,7 +461,7 @@ cmpIntUArray arr1@(UArray l1 u1 n1 _) arr2@(UArray l2 u2 n2 _) = if n1 == 0 then if n2 == 0 then EQ else LT else if n2 == 0 then GT else case compare l1 l2 of - EQ -> foldr cmp (compare u1 u2) [0 .. (n1 `min` n2) - 1] + EQ -> GHC.Base.foldr cmp (compare u1 u2) [0 .. (n1 `min` n2) - 1] other -> other where cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of From git at git.haskell.org Thu Sep 18 22:48:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 22:48:35 +0000 (UTC) Subject: [commit: packages/haskell2010] branch 'wip/T9586' created Message-ID: <20140918224835.B349E3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell2010 New branch : wip/T9586 Referencing: 8ab509b674c73df2298d0f356b438d7db52896e6 From git at git.haskell.org Thu Sep 18 22:48:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 22:48:37 +0000 (UTC) Subject: [commit: packages/haskell2010] wip/T9586: Adapt to Data.List/Foldable generalisation (8ab509b) Message-ID: <20140918224837.B90EE3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell2010 On branch : wip/T9586 Link : http://git.haskell.org/packages/haskell2010.git/commitdiff/8ab509b674c73df2298d0f356b438d7db52896e6 >--------------------------------------------------------------- commit 8ab509b674c73df2298d0f356b438d7db52896e6 Author: Herbert Valerio Riedel Date: Fri Sep 19 00:20:50 2014 +0200 Adapt to Data.List/Foldable generalisation >--------------------------------------------------------------- 8ab509b674c73df2298d0f356b438d7db52896e6 Data/List.hs | 2 +- Prelude.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Data/List.hs b/Data/List.hs index b498db8..54ee601 100644 --- a/Data/List.hs +++ b/Data/List.hs @@ -186,4 +186,4 @@ module Data.List ( , genericReplicate -- :: (Integral a) => a -> b -> [b] ) where -import "base" Data.List hiding ( splitAt ) +import "base" Data.OldList hiding ( splitAt ) diff --git a/Prelude.hs b/Prelude.hs index a0f0700..71d36a5 100644 --- a/Prelude.hs +++ b/Prelude.hs @@ -125,7 +125,7 @@ import qualified "base" Control.Exception.Base as New (catch) import "base" Control.Monad import "base" System.IO import "base" System.IO.Error (IOError, ioError, userError) -import "base" Data.List hiding ( splitAt ) +import "base" Data.OldList hiding ( splitAt ) import "base" Data.Either import "base" Data.Maybe import "base" Data.Tuple From git at git.haskell.org Thu Sep 18 22:48:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 22:48:48 +0000 (UTC) Subject: [commit: packages/haskell98] branch 'wip/T9586' created Message-ID: <20140918224848.500693A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell98 New branch : wip/T9586 Referencing: 51ac61ffff22ad23b5c7edc3fcc503af1d88c745 From git at git.haskell.org Thu Sep 18 22:48:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 22:48:50 +0000 (UTC) Subject: [commit: packages/haskell98] wip/T9586: Adapt to Data.List/Foldable generalisation (51ac61f) Message-ID: <20140918224850.5619E3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell98 On branch : wip/T9586 Link : http://git.haskell.org/packages/haskell98.git/commitdiff/51ac61ffff22ad23b5c7edc3fcc503af1d88c745 >--------------------------------------------------------------- commit 51ac61ffff22ad23b5c7edc3fcc503af1d88c745 Author: Herbert Valerio Riedel Date: Fri Sep 19 00:41:35 2014 +0200 Adapt to Data.List/Foldable generalisation >--------------------------------------------------------------- 51ac61ffff22ad23b5c7edc3fcc503af1d88c745 List.hs | 2 +- Prelude.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/List.hs b/List.hs index b9383c4..eb87353 100644 --- a/List.hs +++ b/List.hs @@ -31,4 +31,4 @@ module List ( zip, zip3, zipWith, zipWith3, unzip, unzip3 ) where -import Data.List hiding (foldl', splitAt) +import Data.OldList hiding (foldl', splitAt) diff --git a/Prelude.hs b/Prelude.hs index f947e7e..bed225f 100644 --- a/Prelude.hs +++ b/Prelude.hs @@ -134,7 +134,7 @@ import qualified "base" Control.Exception.Base as New (catch) import "base" Control.Monad import "base" System.IO import "base" System.IO.Error (IOError, ioError, userError) -import "base" Data.List hiding ( splitAt ) +import "base" Data.OldList hiding ( splitAt ) import "base" Data.Either import "base" Data.Maybe import "base" Data.Tuple From git at git.haskell.org Thu Sep 18 22:50:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 22:50:07 +0000 (UTC) Subject: [commit: ghc] branch 'ghc-validate' created Message-ID: <20140918225007.9026D3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : ghc-validate Referencing: 8c79dcb4dc2c6b8b663fa0c2e61d40d0ac0e9996 From git at git.haskell.org Thu Sep 18 22:50:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 22:50:10 +0000 (UTC) Subject: [commit: ghc] ghc-validate: Update haddock submodule (miscellaneous fixes) (8c79dcb) Message-ID: <20140918225010.3958F3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-validate Link : http://ghc.haskell.org/trac/ghc/changeset/8c79dcb4dc2c6b8b663fa0c2e61d40d0ac0e9996/ghc >--------------------------------------------------------------- commit 8c79dcb4dc2c6b8b663fa0c2e61d40d0ac0e9996 Author: Edward Z. Yang Date: Thu Sep 18 15:49:50 2014 -0700 Update haddock submodule (miscellaneous fixes) Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 8c79dcb4dc2c6b8b663fa0c2e61d40d0ac0e9996 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 4023817..12dc730 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 4023817d7c0e46db012ba2eea28022626841ca9b +Subproject commit 12dc730e62236e15f1194ddc8260affc24928bd1 From git at git.haskell.org Thu Sep 18 23:01:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Sep 2014 23:01:58 +0000 (UTC) Subject: [commit: ghc] master's head updated: Update haddock submodule (miscellaneous fixes) (8c79dcb) Message-ID: <20140918230158.ED6FC3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'master' now includes: 8c79dcb Update haddock submodule (miscellaneous fixes) From git at git.haskell.org Fri Sep 19 01:51:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 01:51:16 +0000 (UTC) Subject: [commit: ghc] branch 'wip/generics-propeq-conservative' created Message-ID: <20140919015116.BA86B3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/generics-propeq-conservative Referencing: e12a6a83851633722e8293e51e09a9c760be84f1 From git at git.haskell.org Fri Sep 19 01:51:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 01:51:19 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq-conservative: Propositional equality for Datatype meta-information (e12a6a8) Message-ID: <20140919015119.62DAE3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq-conservative Link : http://ghc.haskell.org/trac/ghc/changeset/e12a6a83851633722e8293e51e09a9c760be84f1/ghc >--------------------------------------------------------------- commit e12a6a83851633722e8293e51e09a9c760be84f1 Author: Gabor Greif Date: Fri Aug 29 15:57:45 2014 +0200 Propositional equality for Datatype meta-information >--------------------------------------------------------------- e12a6a83851633722e8293e51e09a9c760be84f1 libraries/base/GHC/Generics.hs | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 1c81858..c732a65 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -555,6 +555,9 @@ module GHC.Generics ( , Datatype(..), Constructor(..), Selector(..), NoSelector , Fixity(..), Associativity(..), Arity(..), prec + -- * Propositional equality for meta-information + , sameDatatype + -- * Generic type classes , Generic(..), Generic1(..) @@ -562,11 +565,14 @@ module GHC.Generics ( -- We use some base types import GHC.Types +import Unsafe.Coerce import Data.Maybe ( Maybe(..) ) import Data.Either ( Either(..) ) +import Data.Type.Equality +import GHC.Base ( (&&), undefined ) -- Needed for instances -import GHC.Classes ( Eq, Ord ) +import GHC.Classes ( Eq((==)), Ord ) import GHC.Read ( Read ) import GHC.Show ( Show ) import Data.Proxy @@ -652,6 +658,17 @@ class Datatype d where isNewtype :: t d (f :: * -> *) a -> Bool isNewtype _ = False +-- | Propositional equality predicate for datatypes +sameDatatype :: (Datatype l, Datatype r) => Proxy l -> Proxy r -> Maybe (l :~: r) +sameDatatype l r | moduleName dl == moduleName dr + && datatypeName dl == datatypeName dr + = Just (unsafeCoerce Refl) + where dummy :: Proxy m -> D1 m a p + dummy Proxy = undefined + dl = dummy l + dr = dummy r +sameDatatype _ _ = Nothing + -- | Class for datatypes that represent records class Selector s where From git at git.haskell.org Fri Sep 19 01:55:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 01:55:27 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq-conservative: Make constructor metadata parametrized (with intended parameter <- datatype) (0a8e6fc) Message-ID: <20140919015527.2730E3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq-conservative Link : http://ghc.haskell.org/trac/ghc/changeset/0a8e6fc97b2f7a944bc1723b2041cea4880dd5c2/ghc >--------------------------------------------------------------- commit 0a8e6fc97b2f7a944bc1723b2041cea4880dd5c2 Author: Gabor Greif Date: Mon Sep 1 23:52:01 2014 +0200 Make constructor metadata parametrized (with intended parameter <- datatype) >--------------------------------------------------------------- 0a8e6fc97b2f7a944bc1723b2041cea4880dd5c2 libraries/base/GHC/Generics.hs | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index c732a65..c8a69d6 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -7,6 +7,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | @@ -768,68 +769,68 @@ deriving instance Generic1 ((,,,,,,) a b c d e f) -- Int data D_Int -data C_Int +data C_Int d instance Datatype D_Int where datatypeName _ = "Int" moduleName _ = "GHC.Int" -instance Constructor C_Int where +instance Constructor (C_Int D_Int) where conName _ = "" -- JPM: I'm not sure this is the right implementation... instance Generic Int where - type Rep Int = D1 D_Int (C1 C_Int (S1 NoSelector (Rec0 Int))) + type Rep Int = D1 D_Int (C1 (C_Int D_Int) (S1 NoSelector (Rec0 Int))) from x = M1 (M1 (M1 (K1 x))) to (M1 (M1 (M1 (K1 x)))) = x -- Float data D_Float -data C_Float +data C_Float d instance Datatype D_Float where datatypeName _ = "Float" moduleName _ = "GHC.Float" -instance Constructor C_Float where +instance Constructor (C_Float D_Float) where conName _ = "" -- JPM: I'm not sure this is the right implementation... instance Generic Float where - type Rep Float = D1 D_Float (C1 C_Float (S1 NoSelector (Rec0 Float))) + type Rep Float = D1 D_Float (C1 (C_Float D_Float) (S1 NoSelector (Rec0 Float))) from x = M1 (M1 (M1 (K1 x))) to (M1 (M1 (M1 (K1 x)))) = x -- Double data D_Double -data C_Double +data C_Double d instance Datatype D_Double where datatypeName _ = "Double" moduleName _ = "GHC.Float" -instance Constructor C_Double where +instance Constructor (C_Double D_Double) where conName _ = "" -- JPM: I'm not sure this is the right implementation... instance Generic Double where - type Rep Double = D1 D_Double (C1 C_Double (S1 NoSelector (Rec0 Double))) + type Rep Double = D1 D_Double (C1 (C_Double D_Double) (S1 NoSelector (Rec0 Double))) from x = M1 (M1 (M1 (K1 x))) to (M1 (M1 (M1 (K1 x)))) = x -- Char data D_Char -data C_Char +data C_Char d instance Datatype D_Char where datatypeName _ = "Char" moduleName _ = "GHC.Base" -instance Constructor C_Char where +instance Constructor (C_Char D_Char) where conName _ = "" -- JPM: I'm not sure this is the right implementation... instance Generic Char where - type Rep Char = D1 D_Char (C1 C_Char (S1 NoSelector (Rec0 Char))) + type Rep Char = D1 D_Char (C1 (C_Char D_Char) (S1 NoSelector (Rec0 Char))) from x = M1 (M1 (M1 (K1 x))) to (M1 (M1 (M1 (K1 x)))) = x From git at git.haskell.org Fri Sep 19 01:56:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 01:56:19 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq-conservative: Implement sameConstructor (f097b77) Message-ID: <20140919015619.A90FC3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq-conservative Link : http://ghc.haskell.org/trac/ghc/changeset/f097b779e215900f4746d3911094f7e599e51b1f/ghc >--------------------------------------------------------------- commit f097b779e215900f4746d3911094f7e599e51b1f Author: Gabor Greif Date: Tue Sep 2 12:44:09 2014 +0200 Implement sameConstructor >--------------------------------------------------------------- f097b779e215900f4746d3911094f7e599e51b1f libraries/base/GHC/Generics.hs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index c8a69d6..3d75c68 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -557,7 +557,7 @@ module GHC.Generics ( , Fixity(..), Associativity(..), Arity(..), prec -- * Propositional equality for meta-information - , sameDatatype + , sameDatatype, sameConstructor -- * Generic type classes , Generic(..), Generic1(..) @@ -694,6 +694,19 @@ class Constructor c where conIsRecord :: t c (f :: * -> *) a -> Bool conIsRecord _ = False +-- | Propositional equality predicate for constructors +sameConstructor :: (Datatype l, Datatype r, Constructor (cl l), Constructor (cr r)) + => Proxy (cl l) -> Proxy (cr r) -> Maybe (cl l :~: cr r) +sameConstructor l r | Just Refl <- pd l ` sameDatatype` pd r + , True <- conName cl == conName cr + = Just (unsafeCoerce Refl) + where pd :: Proxy (cm m) -> Proxy m + pd Proxy = Proxy + dummyC :: Proxy (cm m) -> C1 (cm m) a p + dummyC Proxy = undefined + cl = dummyC l + cr = dummyC r + -- | Datatype to represent the arity of a tuple. data Arity = NoArity | Arity Int From git at git.haskell.org Fri Sep 19 01:56:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 01:56:51 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq-conservative: get roles right and fix a FIXME (cc618e6) Message-ID: <20140919015651.34BB23A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq-conservative Link : http://ghc.haskell.org/trac/ghc/changeset/cc618e6de25fda149b7153141895ca942e5f8935/ghc >--------------------------------------------------------------- commit cc618e6de25fda149b7153141895ca942e5f8935 Author: Gabor Greif Date: Tue Sep 16 07:22:52 2014 +0200 get roles right and fix a FIXME >--------------------------------------------------------------- cc618e6de25fda149b7153141895ca942e5f8935 compiler/typecheck/TcGenGenerics.lhs | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index 158a1e7..1d0739e 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -17,6 +17,7 @@ module TcGenGenerics (canDoGenerics, canDoGenerics1, import DynFlags import HsSyn import Type +import TypeRep ( Type( TyConApp ) ) import Kind ( isKind ) import TcType import TcGenDeriv @@ -83,12 +84,13 @@ genGenericMetaTyCons tc mod = c_occ m = mkGenC tc_occ m s_occ m n = mkGenS tc_occ m n - mkTyCon name = ASSERT( isExternalName name ) - buildAlgTyCon name [] [] Nothing [] distinctAbstractTyConRhs + mkTyCon tyvars name = ASSERT( isExternalName name ) + buildAlgTyCon name tyvars roles Nothing [] distinctAbstractTyConRhs NonRecursive False -- Not promotable False -- Not GADT syntax NoParentTyCon + where roles = map (const Nominal) tyvars d_name <- newGlobalBinder mod d_occ loc c_names <- forM (zip [0..] tc_cons) $ \(m,_) -> @@ -96,13 +98,12 @@ genGenericMetaTyCons tc mod = s_names <- forM (zip [0..] tc_arits) $ \(m,a) -> forM [0..a-1] $ \n -> newGlobalBinder mod (s_occ m n) loc - let metaDTyCon = mkTyCon d_name - metaCTyCons = map mkTyCon c_names - metaSTyCons = map (map mkTyCon) s_names + let metaDTyCon = mkTyCon [] d_name + metaCTyCons = map (\c_name -> mkTyConApp (mkTyCon [] c_name) [mkTyConTy metaDTyCon]) c_names + metaSTyCons = map (map $ mkTyCon []) s_names metaDts = MetaTyCons metaDTyCon metaCTyCons metaSTyCons - -- pprTrace "rep0" (ppr rep0_tycon) $ (,) metaDts `fmap` metaTyConsToDerivStuff tc metaDts -- both the tycon declarations and related instances @@ -111,7 +112,7 @@ metaTyConsToDerivStuff tc metaDts = do loc <- getSrcSpanM dflags <- getDynFlags dClas <- tcLookupClass datatypeClassName - let new_dfun_name clas tycon = newDFunName clas [mkTyConApp tycon []] loc + let new_dfun_name clas tycon = newDFunName clas [mkTyConTy tycon] loc d_dfun_name <- new_dfun_name dClas tc cClas <- tcLookupClass constructorClassName c_dfun_names <- sequence [ new_dfun_name cClas tc | _ <- metaC metaDts ] @@ -123,13 +124,12 @@ metaTyConsToDerivStuff tc metaDts = let (dBinds,cBinds,sBinds) = mkBindsMetaD fix_env tc - mk_inst clas tc dfun_name - = mkLocalInstance (mkDictFunId dfun_name [] [] clas tys) + mk_inst' clas ty dfun_name + = mkLocalInstance (mkDictFunId dfun_name [] [] clas [ty]) OverlapFlag { overlapMode = NoOverlap , isSafeOverlap = safeLanguageOn dflags } - [] clas tys - where - tys = [mkTyConTy tc] + [] clas [ty] + mk_inst clas tc dfun_name = mk_inst' clas (mkTyConTy tc) dfun_name -- Datatype d_metaTycon = metaD metaDts @@ -142,7 +142,7 @@ metaTyConsToDerivStuff tc metaDts = -- Constructor c_metaTycons = metaC metaDts - c_insts = [ mk_inst cClas c ds + c_insts = [ mk_inst' cClas c ds | (c, ds) <- myZip1 c_metaTycons c_dfun_names ] c_binds = [ InstBindings { ib_binds = c , ib_pragmas = [] @@ -644,7 +644,7 @@ tc_mkRepTy gk_ tycon metaDts = metaDTyCon = mkTyConTy (metaD metaDts) - metaCTyCons = map mkTyConTy (metaC metaDts) + metaCTyCons = metaC metaDts metaSTyCons = map (map mkTyConTy) (metaS metaDts) return (mkD tycon) @@ -656,7 +656,7 @@ tc_mkRepTy gk_ tycon metaDts = data MetaTyCons = MetaTyCons { -- One meta datatype per datatype metaD :: TyCon -- One meta datatype per constructor - , metaC :: [TyCon] + , metaC :: [Type] -- One meta datatype per selector per constructor , metaS :: [[TyCon]] } @@ -664,7 +664,8 @@ instance Outputable MetaTyCons where ppr (MetaTyCons d c s) = ppr d $$ vcat (map ppr c) $$ vcat (map ppr (concat s)) metaTyCons2TyCons :: MetaTyCons -> Bag TyCon -metaTyCons2TyCons (MetaTyCons d c s) = listToBag (d : c ++ concat s) +metaTyCons2TyCons (MetaTyCons d cty s) = listToBag (d : c ++ concat s) + where c = map (\(TyConApp c []) -> c) cty -- Bindings for Datatype, Constructor, and Selector instances From git at git.haskell.org Fri Sep 19 01:56:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 01:56:53 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq-conservative: Actually parametrize the Constructor with the Datatype (79c7125) Message-ID: <20140919015653.BB80D3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq-conservative Link : http://ghc.haskell.org/trac/ghc/changeset/79c712528390bb170ea546fa8192cb6c9a0877ea/ghc >--------------------------------------------------------------- commit 79c712528390bb170ea546fa8192cb6c9a0877ea Author: Gabor Greif Date: Wed Sep 17 06:43:21 2014 +0200 Actually parametrize the Constructor with the Datatype >--------------------------------------------------------------- 79c712528390bb170ea546fa8192cb6c9a0877ea compiler/typecheck/TcGenGenerics.lhs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index 1d0739e..0a71293 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -42,6 +42,7 @@ import BuildTyCl import SrcLoc import Bag import VarSet (elemVarSet) +import Var (mkTyVar) import Outputable import FastString import Util @@ -99,7 +100,7 @@ genGenericMetaTyCons tc mod = newGlobalBinder mod (s_occ m n) loc let metaDTyCon = mkTyCon [] d_name - metaCTyCons = map (\c_name -> mkTyConApp (mkTyCon [] c_name) [mkTyConTy metaDTyCon]) c_names + metaCTyCons = map (\c_name -> mkTyConApp (mkTyCon [mkTyVar undefined openTypeKind] c_name) [mkTyConTy metaDTyCon]) c_names metaSTyCons = map (map $ mkTyCon []) s_names metaDts = MetaTyCons metaDTyCon metaCTyCons metaSTyCons @@ -665,7 +666,7 @@ instance Outputable MetaTyCons where metaTyCons2TyCons :: MetaTyCons -> Bag TyCon metaTyCons2TyCons (MetaTyCons d cty s) = listToBag (d : c ++ concat s) - where c = map (\(TyConApp c []) -> c) cty + where c = map (\(TyConApp c [_]) -> c) cty -- Bindings for Datatype, Constructor, and Selector instances From git at git.haskell.org Fri Sep 19 01:57:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 01:57:45 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq-conservative: Supply a reasonable name (should be derived from d_name tho) (7bd4bab) Message-ID: <20140919015745.A55A53A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq-conservative Link : http://ghc.haskell.org/trac/ghc/changeset/7bd4babb933dbd52d26e40fdd6b2c572207bbc64/ghc >--------------------------------------------------------------- commit 7bd4babb933dbd52d26e40fdd6b2c572207bbc64 Author: Gabor Greif Date: Wed Sep 17 07:46:39 2014 +0200 Supply a reasonable name (should be derived from d_name tho) >--------------------------------------------------------------- 7bd4babb933dbd52d26e40fdd6b2c572207bbc64 compiler/typecheck/TcGenGenerics.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index 0a71293..0998141 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -100,7 +100,7 @@ genGenericMetaTyCons tc mod = newGlobalBinder mod (s_occ m n) loc let metaDTyCon = mkTyCon [] d_name - metaCTyCons = map (\c_name -> mkTyConApp (mkTyCon [mkTyVar undefined openTypeKind] c_name) [mkTyConTy metaDTyCon]) c_names + metaCTyCons = map (\c_name -> mkTyConApp (mkTyCon [mkTyVar c_name openTypeKind] c_name) [mkTyConTy metaDTyCon]) c_names metaSTyCons = map (map $ mkTyCon []) s_names metaDts = MetaTyCons metaDTyCon metaCTyCons metaSTyCons From git at git.haskell.org Fri Sep 19 01:57:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 01:57:48 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq-conservative: Use 'd_name' as the name (should be derived from d_name tho) (09fcd70) Message-ID: <20140919015748.416ED3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/generics-propeq-conservative Link : http://ghc.haskell.org/trac/ghc/changeset/09fcd700cfe891ea83aab8f5e1e25f13c193e05c/ghc >--------------------------------------------------------------- commit 09fcd700cfe891ea83aab8f5e1e25f13c193e05c Author: Gabor Greif Date: Wed Sep 17 10:56:20 2014 +0200 Use 'd_name' as the name (should be derived from d_name tho) >--------------------------------------------------------------- 09fcd700cfe891ea83aab8f5e1e25f13c193e05c compiler/typecheck/TcGenGenerics.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index 0998141..dde339d 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -100,7 +100,7 @@ genGenericMetaTyCons tc mod = newGlobalBinder mod (s_occ m n) loc let metaDTyCon = mkTyCon [] d_name - metaCTyCons = map (\c_name -> mkTyConApp (mkTyCon [mkTyVar c_name openTypeKind] c_name) [mkTyConTy metaDTyCon]) c_names + metaCTyCons = map (\c_name -> mkTyConApp (mkTyCon [mkTyVar d_name openTypeKind] c_name) [mkTyConTy metaDTyCon]) c_names metaSTyCons = map (map $ mkTyCon []) s_names metaDts = MetaTyCons metaDTyCon metaCTyCons metaSTyCons From git at git.haskell.org Fri Sep 19 04:27:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 04:27:08 +0000 (UTC) Subject: [commit: ghc] master: Add default case (fixes -Werror) (4d90e44) Message-ID: <20140919042708.0D9083A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4d90e44101559800947ce3cd7fd8704dc520b332/ghc >--------------------------------------------------------------- commit 4d90e44101559800947ce3cd7fd8704dc520b332 Author: Gabor Greif Date: Fri Sep 19 06:23:58 2014 +0200 Add default case (fixes -Werror) >--------------------------------------------------------------- 4d90e44101559800947ce3cd7fd8704dc520b332 libraries/base/GHC/Generics.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 3d75c68..b3f6de7 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -706,7 +706,7 @@ sameConstructor l r | Just Refl <- pd l ` sameDatatype` pd r dummyC Proxy = undefined cl = dummyC l cr = dummyC r - +sameConstructor _ _ = Nothing -- | Datatype to represent the arity of a tuple. data Arity = NoArity | Arity Int From git at git.haskell.org Fri Sep 19 04:27:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 04:27:10 +0000 (UTC) Subject: [commit: ghc] master's head updated: Add default case (fixes -Werror) (4d90e44) Message-ID: <20140919042710.1E3043A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'master' now includes: e12a6a8 Propositional equality for Datatype meta-information 0a8e6fc Make constructor metadata parametrized (with intended parameter <- datatype) f097b77 Implement sameConstructor cc618e6 get roles right and fix a FIXME 79c7125 Actually parametrize the Constructor with the Datatype 7bd4bab Supply a reasonable name (should be derived from d_name tho) 09fcd70 Use 'd_name' as the name (should be derived from d_name tho) 4d90e44 Add default case (fixes -Werror) From git at git.haskell.org Fri Sep 19 04:31:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 04:31:09 +0000 (UTC) Subject: [commit: ghc] wip/generics-propeq-conservative's head updated: Add default case (fixes -Werror) (4d90e44) Message-ID: <20140919043109.522CF3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/generics-propeq-conservative' now includes: 4d90e44 Add default case (fixes -Werror) From git at git.haskell.org Fri Sep 19 08:10:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 08:10:08 +0000 (UTC) Subject: [commit: ghc] branch 'ghc-validate' deleted Message-ID: <20140919081008.755BC3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: ghc-validate From git at git.haskell.org Fri Sep 19 08:18:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 08:18:59 +0000 (UTC) Subject: [commit: ghc] master: Revert accidental wip/generics-propeq-conservative merge (6d84b66) Message-ID: <20140919081859.B5D493A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6d84b66285a376c0d052c20a90ad88da5ac02026/ghc >--------------------------------------------------------------- commit 6d84b66285a376c0d052c20a90ad88da5ac02026 Author: Herbert Valerio Riedel Date: Fri Sep 19 10:13:16 2014 +0200 Revert accidental wip/generics-propeq-conservative merge This commit reverts the commits e12a6a8 Propositional equality for Datatype meta-information 0a8e6fc Make constructor metadata parametrized (with intended parameter <- datatype) f097b77 Implement sameConstructor cc618e6 get roles right and fix a FIXME 79c7125 Actually parametrize the Constructor with the Datatype 7bd4bab Supply a reasonable name (should be derived from d_name tho) 09fcd70 Use 'd_name' as the name (should be derived from d_name tho) 4d90e44 Add default case (fixes -Werror) and effectively resets ghc.git to the state it was at commit 8c79dcb4dc2c6b8b663fa0c2e61d40d0ac0e9996 >--------------------------------------------------------------- 6d84b66285a376c0d052c20a90ad88da5ac02026 compiler/typecheck/TcGenGenerics.lhs | 34 ++++++++++----------- libraries/base/GHC/Generics.hs | 57 ++++++++---------------------------- 2 files changed, 29 insertions(+), 62 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6d84b66285a376c0d052c20a90ad88da5ac02026 From git at git.haskell.org Fri Sep 19 09:37:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 09:37:33 +0000 (UTC) Subject: [commit: ghc] master: Auto-derive a few manually coded Show instances (fdc03a7) Message-ID: <20140919093733.D2AC73A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fdc03a78ab1b3c03e4d1757fca062eaf7a47834a/ghc >--------------------------------------------------------------- commit fdc03a78ab1b3c03e4d1757fca062eaf7a47834a Author: Herbert Valerio Riedel Date: Fri Sep 19 10:25:34 2014 +0200 Auto-derive a few manually coded Show instances In `base`, the instances instance Show () instance Show Bool instance Show Ordering instance Show a => Show (Maybe a) where defined manually, even though we can leverage GHC's auto-deriver which is perfectly capable by standalone derivation to avoid boiler-plate code such as this. Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D219 >--------------------------------------------------------------- fdc03a78ab1b3c03e4d1757fca062eaf7a47834a libraries/base/GHC/Show.lhs | 20 ++++---------------- testsuite/tests/perf/compiler/all.T | 2 +- 2 files changed, 5 insertions(+), 17 deletions(-) diff --git a/libraries/base/GHC/Show.lhs b/libraries/base/GHC/Show.lhs index 93320ee..2834817 100644 --- a/libraries/base/GHC/Show.lhs +++ b/libraries/base/GHC/Show.lhs @@ -179,8 +179,7 @@ appPrec1 = I# 11# -- appPrec + 1 \begin{code} -instance Show () where - showsPrec _ () = showString "()" +deriving instance Show () instance Show a => Show [a] where {-# SPECIALISE instance Show [String] #-} @@ -188,14 +187,8 @@ instance Show a => Show [a] where {-# SPECIALISE instance Show [Int] #-} showsPrec _ = showList -instance Show Bool where - showsPrec _ True = showString "True" - showsPrec _ False = showString "False" - -instance Show Ordering where - showsPrec _ LT = showString "LT" - showsPrec _ EQ = showString "EQ" - showsPrec _ GT = showString "GT" +deriving instance Show Bool +deriving instance Show Ordering instance Show Char where showsPrec _ '\'' = showString "'\\''" @@ -216,12 +209,7 @@ showWord w# cs c# -> showWord (w# `quotWord#` 10##) (C# c# : cs) -instance Show a => Show (Maybe a) where - showsPrec _p Nothing s = showString "Nothing" s - showsPrec p (Just x) s - = (showParen (p > appPrec) $ - showString "Just " . - showsPrec appPrec1 x) s +deriving instance Show a => Show (Maybe a) \end{code} diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index be09a1c..96e2e11 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -229,7 +229,7 @@ test('T3064', # expected value: 14 (x86/Linux 28-06-2012): # 2013-11-13: 18 (x86/Windows, 64bit machine) # 2014-01-22: 23 (x86/Linux) - (wordsize(64), 52, 20)]), + (wordsize(64), 42, 20)]), # (amd64/Linux): 18 # (amd64/Linux) 2012-02-07: 26 # (amd64/Linux) 2013-02-12: 23; increased range to 10% From git at git.haskell.org Fri Sep 19 11:30:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 11:30:37 +0000 (UTC) Subject: [commit: ghc] master: Increase -fcontext-stack=N default to 100 (c96c64f) Message-ID: <20140919113037.8B78F3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c96c64fae0152bc53f48634d0ddd310ef4bc0105/ghc >--------------------------------------------------------------- commit c96c64fae0152bc53f48634d0ddd310ef4bc0105 Author: Simon Peyton Jones Date: Tue Sep 9 12:52:18 2014 +0100 Increase -fcontext-stack=N default to 100 This addresses Trac #5395 >--------------------------------------------------------------- c96c64fae0152bc53f48634d0ddd310ef4bc0105 compiler/main/Constants.lhs | 3 ++- docs/users_guide/flags.xml | 2 +- .../typecheck/should_fail/TcCoercibleFail.stderr | 20 +++++++++++++------- 3 files changed, 16 insertions(+), 9 deletions(-) diff --git a/compiler/main/Constants.lhs b/compiler/main/Constants.lhs index a891336..ee126f5 100644 --- a/compiler/main/Constants.lhs +++ b/compiler/main/Constants.lhs @@ -18,7 +18,8 @@ mAX_TUPLE_SIZE = 62 -- Should really match the number -- of decls in Data.Tuple mAX_CONTEXT_REDUCTION_DEPTH :: Int -mAX_CONTEXT_REDUCTION_DEPTH = 20 +mAX_CONTEXT_REDUCTION_DEPTH = 100 + -- Trac #5395 reports at least one library that needs depth 37 here mAX_TYPE_FUNCTION_REDUCTION_DEPTH :: Int mAX_TYPE_FUNCTION_REDUCTION_DEPTH = 200 diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index 086157b..bd2a84c 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -706,7 +706,7 @@ n - set the limit for context reduction. Default is 20. + set the limit for type-class context reduction. Default is 100. dynamic diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr index 2851bcd..5bb9210 100644 --- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr +++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr @@ -1,7 +1,9 @@ TcCoercibleFail.hs:11:8: Could not coerce from ?Int? to ?()? - because ?Int? and ?()? are different types. + because ?Int? + and ?()? + are different types. arising from a use of ?coerce? In the expression: coerce In the expression: coerce $ one :: () @@ -9,7 +11,9 @@ TcCoercibleFail.hs:11:8: TcCoercibleFail.hs:14:8: Could not coerce from ?m Int? to ?m Age? - because ?m Int? and ?m Age? are different types. + because ?m Int? + and ?m Age? + are different types. arising from a use of ?coerce? from the context (Monad m) bound by the type signature for foo2 :: Monad m => m Age @@ -36,24 +40,26 @@ TcCoercibleFail.hs:18:8: In an equation for ?foo4?: foo4 = coerce $ one :: Down Int TcCoercibleFail.hs:21:8: - Context reduction stack overflow; size = 21 + Context reduction stack overflow; size = 101 Use -fcontext-stack=N to increase stack size to N Coercible Void () In the expression: coerce :: Void -> () In an equation for ?foo5?: foo5 = coerce :: Void -> () TcCoercibleFail.hs:30:8: - Context reduction stack overflow; size = 21 + Context reduction stack overflow; size = 101 Use -fcontext-stack=N to increase stack size to N - Coercible Int Age + Coercible + (Either Int (Fix (Either Int))) (Either Age (Fix (Either Age))) In the expression: coerce :: Fix (Either Int) -> Fix (Either Age) In an equation for ?foo6?: foo6 = coerce :: Fix (Either Int) -> Fix (Either Age) TcCoercibleFail.hs:31:8: Could not coerce from ?Either Int (Fix (Either Int))? to ?()? - because ?Either - Int (Fix (Either Int))? and ?()? are different types. + because ?Either Int (Fix (Either Int))? + and ?()? + are different types. arising from a use of ?coerce? In the expression: coerce :: Fix (Either Int) -> () In an equation for ?foo7?: foo7 = coerce :: Fix (Either Int) -> () From git at git.haskell.org Fri Sep 19 11:30:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 11:30:40 +0000 (UTC) Subject: [commit: ghc] master: Spelling error in flags.xml (ebb7334) Message-ID: <20140919113040.183553A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ebb7334c02c3014283f5f997f239b3cf58476cbc/ghc >--------------------------------------------------------------- commit ebb7334c02c3014283f5f997f239b3cf58476cbc Author: Simon Peyton Jones Date: Tue Sep 9 12:56:31 2014 +0100 Spelling error in flags.xml Fixes Trac #9528 >--------------------------------------------------------------- ebb7334c02c3014283f5f997f239b3cf58476cbc docs/users_guide/flags.xml | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Fri Sep 19 11:30:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 11:30:42 +0000 (UTC) Subject: [commit: ghc] master: Use mapAccumL (refactoring only) (48f17f1) Message-ID: <20140919113042.96DC93A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/48f17f156c3bb608603575ade2788140fadab192/ghc >--------------------------------------------------------------- commit 48f17f156c3bb608603575ade2788140fadab192 Author: Simon Peyton Jones Date: Tue Sep 9 12:57:04 2014 +0100 Use mapAccumL (refactoring only) Fixes Trac #9529 >--------------------------------------------------------------- 48f17f156c3bb608603575ade2788140fadab192 compiler/simplCore/CSE.lhs | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs index 740aa5f..289388a 100644 --- a/compiler/simplCore/CSE.lhs +++ b/compiler/simplCore/CSE.lhs @@ -153,14 +153,7 @@ let-binding, and we can use cseRhs for dealing with the scrutinee. \begin{code} cseProgram :: CoreProgram -> CoreProgram -cseProgram binds = cseBinds emptyCSEnv binds - -cseBinds :: CSEnv -> [CoreBind] -> [CoreBind] -cseBinds _ [] = [] -cseBinds env (b:bs) = (b':bs') - where - (env1, b') = cseBind env b - bs' = cseBinds env1 bs +cseProgram binds = snd (mapAccumL cseBind emptyCSEnv binds) cseBind :: CSEnv -> CoreBind -> (CSEnv, CoreBind) cseBind env (NonRec b e) From git at git.haskell.org Fri Sep 19 11:30:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 11:30:45 +0000 (UTC) Subject: [commit: ghc] master: Typo in comment in GHC.Generics (2a5eb83) Message-ID: <20140919113045.249AD3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2a5eb838f7aac048d71436acd6e9d32f1d7490e8/ghc >--------------------------------------------------------------- commit 2a5eb838f7aac048d71436acd6e9d32f1d7490e8 Author: Simon Peyton Jones Date: Tue Sep 9 12:58:25 2014 +0100 Typo in comment in GHC.Generics Fixes Trac #9523 >--------------------------------------------------------------- 2a5eb838f7aac048d71436acd6e9d32f1d7490e8 libraries/base/GHC/Generics.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 1c81858..594b631 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -163,7 +163,7 @@ module GHC.Generics ( -- type 'D1' = 'M1' 'D' -- @ -- --- The types 'S', 'C' and 'R' are once again type-level proxies, just used to create +-- The types 'S', 'C' and 'D' are once again type-level proxies, just used to create -- several variants of 'M1'. -- *** Additional generic representation type constructors From git at git.haskell.org Fri Sep 19 11:30:47 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 11:30:47 +0000 (UTC) Subject: [commit: ghc] master: Define Util.leLength :: [a] -> [b] -> Bool (28059ba) Message-ID: <20140919113047.A9A9F3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/28059ba7c490c035f125ec5ef26026467b5171ac/ghc >--------------------------------------------------------------- commit 28059ba7c490c035f125ec5ef26026467b5171ac Author: Simon Peyton Jones Date: Thu Sep 18 16:04:41 2014 +0100 Define Util.leLength :: [a] -> [b] -> Bool >--------------------------------------------------------------- 28059ba7c490c035f125ec5ef26026467b5171ac compiler/utils/Util.lhs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index dfac0ae..97bafe6 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -26,7 +26,8 @@ module Util ( foldl1', foldl2, count, all2, lengthExceeds, lengthIs, lengthAtLeast, - listLengthCmp, atLength, equalLength, compareLength, + listLengthCmp, atLength, + equalLength, compareLength, leLength, isSingleton, only, singleton, notNull, snocView, @@ -423,6 +424,13 @@ compareLength (_:xs) (_:ys) = compareLength xs ys compareLength [] _ = LT compareLength _ [] = GT +leLength :: [a] -> [b] -> Bool +-- ^ True if length xs <= length ys +leLength xs ys = case compareLength xs ys of + LT -> True + EQ -> True + GT -> False + ---------------------------- singleton :: a -> [a] singleton x = [x] From git at git.haskell.org Fri Sep 19 11:30:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 11:30:50 +0000 (UTC) Subject: [commit: ghc] master: Fix garbled comment wording (1378ba3) Message-ID: <20140919113050.3E29D3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1378ba3ecf200176bb4932ef4f17471632eeea40/ghc >--------------------------------------------------------------- commit 1378ba3ecf200176bb4932ef4f17471632eeea40 Author: Simon Peyton Jones Date: Tue Sep 9 13:00:18 2014 +0100 Fix garbled comment wording Thanks to Gabor for pointing this out >--------------------------------------------------------------- 1378ba3ecf200176bb4932ef4f17471632eeea40 compiler/simplCore/CSE.lhs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs index 289388a..ccd4b2e 100644 --- a/compiler/simplCore/CSE.lhs +++ b/compiler/simplCore/CSE.lhs @@ -90,8 +90,9 @@ to the substitution Note [CSE for INLINE and NOINLINE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We are careful to with CSE inside functions that the user has marked as -INLINE or NOINLINE. (Examples from Roman Leshchinskiy.) Consider +There are some subtle interactions of CSE with functions that the user +has marked as INLINE or NOINLINE. (Examples from Roman Leshchinskiy.) +Consider yes :: Int {-# NOINLINE yes #-} yes = undefined From git at git.haskell.org Fri Sep 19 11:30:52 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 11:30:52 +0000 (UTC) Subject: [commit: ghc] master: White space only (24e51b0) Message-ID: <20140919113052.BD7463A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/24e51b01cf66ffb12ce0b609c81ef9f9617e4629/ghc >--------------------------------------------------------------- commit 24e51b01cf66ffb12ce0b609c81ef9f9617e4629 Author: Simon Peyton Jones Date: Thu Sep 18 16:05:14 2014 +0100 White space only >--------------------------------------------------------------- 24e51b01cf66ffb12ce0b609c81ef9f9617e4629 compiler/coreSyn/CoreUtils.lhs | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Fri Sep 19 11:30:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 11:30:56 +0000 (UTC) Subject: [commit: ghc] master: Clean up Coercible handling, and interaction of data families with newtypes (0aaf812) Message-ID: <20140919113056.326E13A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0aaf812ed0a4a4be9528b2e2f6b72bee7cd8002d/ghc >--------------------------------------------------------------- commit 0aaf812ed0a4a4be9528b2e2f6b72bee7cd8002d Author: Simon Peyton Jones Date: Thu Sep 18 16:19:55 2014 +0100 Clean up Coercible handling, and interaction of data families with newtypes This patch fixes Trac #9580, in which the Coercible machinery succeeded even though the relevant data constructor was not in scope. As usual I got dragged into a raft of refactoring changes, all for the better. * Delete TcEvidence.coercionToTcCoercion (now unused) * Move instNewTyConTF_maybe, instNewTyCon_maybe to FamInst, and rename them to tcInstNewTyConTF_maybe, tcInstNewTyCon (They both return TcCoercions.) * tcInstNewTyConTF_maybe also gets more convenient type, which improves TcInteract.getCoercibleInst * Define FamInst.tcLookupDataFamInst, and use it in TcDeriv, (as well as in tcInstNewTyConTF_maybe) * Improve error report for Coercible errors, when data familes are involved Another use of tcLookupDataFamInst * In TcExpr.tcTagToEnum, use tcLookupDataFamInst to replace local hacky code * Fix Coercion.instNewTyCon_maybe and Type.newTyConInstRhs to deal with eta-reduced newtypes, using (new) Type.unwrapNewTyConEtad_maybe and (new) Type.applyTysX Some small refactoring of TcSMonad.matchFam. >--------------------------------------------------------------- 0aaf812ed0a4a4be9528b2e2f6b72bee7cd8002d compiler/hsSyn/HsUtils.lhs | 15 +++- compiler/typecheck/FamInst.lhs | 74 +++++++++++++----- compiler/typecheck/TcDeriv.lhs | 28 ++----- compiler/typecheck/TcErrors.lhs | 45 +++++------ compiler/typecheck/TcEvidence.lhs | 21 +----- compiler/typecheck/TcExpr.lhs | 46 ++++------- compiler/typecheck/TcInteract.lhs | 88 ++++++++++------------ compiler/typecheck/TcSMonad.lhs | 17 +++-- compiler/types/Coercion.lhs | 6 +- compiler/types/FamInstEnv.lhs | 29 +------ compiler/types/TyCon.lhs | 9 ++- compiler/types/Type.lhs | 22 ++++-- testsuite/tests/indexed-types/should_fail/T9580.hs | 7 ++ .../tests/indexed-types/should_fail/T9580.stderr | 10 +++ .../tests/indexed-types/should_fail/T9580a.hs | 5 ++ testsuite/tests/indexed-types/should_fail/all.T | 1 + .../typecheck/should_fail/TcCoercibleFail.stderr | 3 +- 17 files changed, 214 insertions(+), 212 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 0aaf812ed0a4a4be9528b2e2f6b72bee7cd8002d From git at git.haskell.org Fri Sep 19 14:50:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 14:50:01 +0000 (UTC) Subject: [commit: ghc] master: Fixup overlooked `unless` occurence (e1c6352) Message-ID: <20140919145001.EFFC73A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e1c6352ad3c45f7d03655e1f3fe1595c2a9b7796/ghc >--------------------------------------------------------------- commit e1c6352ad3c45f7d03655e1f3fe1595c2a9b7796 Author: Herbert Valerio Riedel Date: Fri Sep 19 16:49:20 2014 +0200 Fixup overlooked `unless` occurence This was broken in eae19112462fe77a3f1298bff12b409b205a581d >--------------------------------------------------------------- e1c6352ad3c45f7d03655e1f3fe1595c2a9b7796 libraries/base/GHC/IO/FD.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs index 80030b2..fcc314e 100644 --- a/libraries/base/GHC/IO/FD.hs +++ b/libraries/base/GHC/IO/FD.hs @@ -259,7 +259,7 @@ mkFD fd iomode mb_stat is_socket is_nonblock = do _other_type -> return () #ifdef mingw32_HOST_OS - unless is_socket $ setmode fd True >> return () + when (not is_socket) $ setmode fd True >> return () #endif return (FD{ fdFD = fd, From git at git.haskell.org Fri Sep 19 15:54:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 15:54:51 +0000 (UTC) Subject: [commit: ghc] master: Define fixity for `Data.Foldable.{elem, notElem}` (d48fed4) Message-ID: <20140919155451.0530A3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d48fed4e61afc2b51ac3a513290a66d89c929059/ghc >--------------------------------------------------------------- commit d48fed4e61afc2b51ac3a513290a66d89c929059 Author: Herbert Valerio Riedel Date: Fri Sep 19 17:53:33 2014 +0200 Define fixity for `Data.Foldable.{elem,notElem}` This was probably just an oversight. With this change the fixity matches that from `Data.List.{elem,notElem`}`. Addresses #9610 Reviewed By: austin, ekmett Differential Revision: https://phabricator.haskell.org/D227 >--------------------------------------------------------------- d48fed4e61afc2b51ac3a513290a66d89c929059 libraries/base/Data/Foldable.hs | 2 ++ libraries/base/changelog.md | 3 +++ 2 files changed, 5 insertions(+) diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index f6f787b..b839106 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -71,6 +71,8 @@ import GHC.Arr ( Array(..), Ix(..), elems ) import GHC.Base hiding ( foldr ) import GHC.Num ( Num(..) ) +infix 4 `elem`, `notElem` + -- | Data structures that can be folded. -- -- Minimal complete definition: 'foldMap' or 'foldr'. diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 6f3c8cc..1dbada0 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -29,6 +29,9 @@ * Add `Data.List.uncons` list destructor (#9550) + * Set fixity for `Data.Foldable.{elem,notElem}` to match the + conventional one set for `Data.List.{elem,notElem}` (#9610) + ## 4.7.0.1 *Jul 2014* * Bundled with GHC 7.8.3 From git at git.haskell.org Fri Sep 19 17:27:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Sep 2014 17:27:54 +0000 (UTC) Subject: [commit: ghc] master: Typos (5e300d5) Message-ID: <20140919172754.ADE743A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5e300d58f69ec79c647f8a97b0e8fa0f588d2662/ghc >--------------------------------------------------------------- commit 5e300d58f69ec79c647f8a97b0e8fa0f588d2662 Author: Krzysztof Gogolewski Date: Fri Sep 19 19:27:34 2014 +0200 Typos >--------------------------------------------------------------- 5e300d58f69ec79c647f8a97b0e8fa0f588d2662 compiler/stranal/WwLib.lhs | 2 +- compiler/typecheck/TcDeriv.lhs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs index 82c3107..11f97ea 100644 --- a/compiler/stranal/WwLib.lhs +++ b/compiler/stranal/WwLib.lhs @@ -679,7 +679,7 @@ There are a few cases where the W/W transformation is told that something returns a constructor, but the type at hand doesn't really match this. One real-world example involves unsafeCoerce: foo = IO a - foo = unsafeCoere c_exit + foo = unsafeCoerce c_exit foreign import ccall "c_exit" c_exit :: IO () Here CPR will tell you that `foo` returns a () constructor for sure, but trying to create a worker/wrapper for type `a` obviously fails. diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index af05e80..17a84e2 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -827,8 +827,8 @@ C's kind args. Consider (Trac #8865): where Category :: forall k. (k -> k -> *) -> Constraint We need to generate the instance - insatnce Category * (Either a) where ... -Notice the '*' argument to Cagegory. + instance Category * (Either a) where ... +Notice the '*' argument to Category. So we need to * drop arguments from (T a b) to match the number of From git at git.haskell.org Sat Sep 20 15:38:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 15:38:42 +0000 (UTC) Subject: [commit: ghc] master: Fix potential `mingw32_HOST_OS` breakage from eae19112462fe77 (e76fafa) Message-ID: <20140920153842.052283A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e76fafaaeec65d2b4a98556561a96f40d81391ab/ghc >--------------------------------------------------------------- commit e76fafaaeec65d2b4a98556561a96f40d81391ab Author: Herbert Valerio Riedel Date: Sat Sep 20 17:37:24 2014 +0200 Fix potential `mingw32_HOST_OS` breakage from eae19112462fe77 >--------------------------------------------------------------- e76fafaaeec65d2b4a98556561a96f40d81391ab libraries/base/Control/Concurrent.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Control/Concurrent.hs b/libraries/base/Control/Concurrent.hs index 9ab209e..eaf1e66 100644 --- a/libraries/base/Control/Concurrent.hs +++ b/libraries/base/Control/Concurrent.hs @@ -123,7 +123,7 @@ import Foreign.C.Types #ifdef mingw32_HOST_OS import Foreign.C import System.IO -import Data.Maybe (Maybe(..)) +import Data.Functor ( void ) #endif import Control.Concurrent.MVar From git at git.haskell.org Sat Sep 20 17:12:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 17:12:30 +0000 (UTC) Subject: [commit: ghc] master: Fix potential `mingw32_HOST_OS` -Werror failure (83c5821) Message-ID: <20140920171230.32A243A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/83c5821f851f7c7084eb8b7b6fa482915915a503/ghc >--------------------------------------------------------------- commit 83c5821f851f7c7084eb8b7b6fa482915915a503 Author: Herbert Valerio Riedel Date: Sat Sep 20 19:11:48 2014 +0200 Fix potential `mingw32_HOST_OS` -Werror failure >--------------------------------------------------------------- 83c5821f851f7c7084eb8b7b6fa482915915a503 libraries/base/GHC/Conc/Windows.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/libraries/base/GHC/Conc/Windows.hs b/libraries/base/GHC/Conc/Windows.hs index c01281a..aef7fbf 100644 --- a/libraries/base/GHC/Conc/Windows.hs +++ b/libraries/base/GHC/Conc/Windows.hs @@ -38,9 +38,8 @@ module GHC.Conc.Windows , toWin32ConsoleEvent ) where -import Control.Monad +import Control.Monad (unless) import Data.Bits (shiftR) -import Data.Maybe (Maybe(..)) import Data.Typeable import GHC.Base import GHC.Conc.Sync From git at git.haskell.org Sat Sep 20 19:22:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 19:22:10 +0000 (UTC) Subject: [commit: ghc] master: Deactive T4801 `max_bytes_used`-check & bump T3064 numbers (4805abf) Message-ID: <20140920192210.576D43A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4805abf413c02a2ed1af4fbeca2476590e984e37/ghc >--------------------------------------------------------------- commit 4805abf413c02a2ed1af4fbeca2476590e984e37 Author: Herbert Valerio Riedel Date: Sat Sep 20 21:19:28 2014 +0200 Deactive T4801 `max_bytes_used`-check & bump T3064 numbers T4801 is deactived for now because it's currently too volatile and causes too much noise in Phabricator's CI Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D230 >--------------------------------------------------------------- 4805abf413c02a2ed1af4fbeca2476590e984e37 testsuite/tests/perf/compiler/all.T | 49 ++++++++++++++++++++----------------- 1 file changed, 27 insertions(+), 22 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 96e2e11..a7783a4 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -195,27 +195,30 @@ test('T4801', # 19/10/2012: 392409984 (amd64/Linux) (-fPIC turned off) # 2014-04-08: 362939272 (amd64/Linux) cumulation of various smaller improvements over recent commits - compiler_stats_num_field('max_bytes_used', - [(platform('x86_64-apple-darwin'), 25145320, 5), - (wordsize(32), 11829000, 15), - # 9651948 (x86/OSX) - # 10290952 (windows) - # 2013-02-10 11071060 (x86/Windows) - # 2013-02-10: 11207828 (x86/OSX) - # (some date): 11139444 - # 2013-11-13: 11829000 (x86/Windows, 64bit machine) - (wordsize(64), 19296544, 15)]), - # prev: 20486256 (amd64/OS X) - # 30/08/2012: 17305600--20391920 (varies a lot) - # 19/10/2012: 26882576 (-fPIC turned on) - # 19/10/2012: 18619912 (-fPIC turned off) - # 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) - # 12/05/2014: 25002136 (specialisation and inlining changes) - # 10/09/2014: 19296544, 10 (post-AMP-cleanup) - # 14/09/2014: 19585456, 15 (adapt to Phab CI env) +################################### +# deactivated for now, as this metric became to volatile recently +# +# compiler_stats_num_field('max_bytes_used', +# [(platform('x86_64-apple-darwin'), 25145320, 5), +# (wordsize(32), 11829000, 15), +# # 9651948 (x86/OSX) +# # 10290952 (windows) +# # 2013-02-10 11071060 (x86/Windows) +# # 2013-02-10: 11207828 (x86/OSX) +# # (some date): 11139444 +# # 2013-11-13: 11829000 (x86/Windows, 64bit machine) +# (wordsize(64), 19296544, 15)]), +# # prev: 20486256 (amd64/OS X) +# # 30/08/2012: 17305600--20391920 (varies a lot) +# # 19/10/2012: 26882576 (-fPIC turned on) +# # 19/10/2012: 18619912 (-fPIC turned off) +# # 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) +# # 12/05/2014: 25002136 (specialisation and inlining changes) +# # 10/09/2014: 19296544, 10 (post-AMP-cleanup) +# # 14/09/2014: 19585456, 15 (adapt to Phab CI env) only_ways(['normal']), extra_hc_opts('-static') ], @@ -266,7 +269,7 @@ test('T3064', #(some date): 5511604 # 2013-11-13: 7218200 (x86/Windows, 64bit machine) # 2014-04-04: 11202304 (x86/Windows, 64bit machine) - (wordsize(64), 16053888, 20)]), + (wordsize(64), 18744992, 20)]), # (amd64/Linux, intree) (28/06/2011): 4032024 # (amd64/Linux, intree) (07/02/2013): 9819288 # (amd64/Linux) (14/02/2013): 8687360 @@ -279,6 +282,8 @@ test('T3064', # (amd64/Linux) (12/12/2013): 19821544, better One shot analysis # (amd64/Linux) (09/09/2014): 24357392, AMP changes (larger interfaces, more loading) # (amd64/Linux) (14/09/2014): 16053888, BPP changes (more NoImplicitPrelude in base) + # (amd64/Linux) (19/09/2014): 18744992, unknown + only_ways(['normal']) ], compile, From git at git.haskell.org Sat Sep 20 19:24:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 19:24:30 +0000 (UTC) Subject: [commit: ghc] master: Change linker message verbosity to `-v2` (re #7863) (9f7e363) Message-ID: <20140920192430.0A0783A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9f7e3633c692dce75c27607131bd386178fb0fcf/ghc >--------------------------------------------------------------- commit 9f7e3633c692dce75c27607131bd386178fb0fcf Author: Herbert Valerio Riedel Date: Sat Sep 20 21:23:28 2014 +0200 Change linker message verbosity to `-v2` (re #7863) With this change, the linker status logging output such as Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. is suppressed unless verbosity level is `-v2` or higher. This is done to reduce the compiler message noise when TH is involved, which can reduce the visibiliy of compile warnings. Reviewed By: ekmett, austin Differential Revision: https://phabricator.haskell.org/D232 >--------------------------------------------------------------- 9f7e3633c692dce75c27607131bd386178fb0fcf compiler/ghci/Linker.lhs | 2 +- testsuite/tests/indexed-types/should_fail/T9160.stderr | 5 ----- testsuite/tests/simplCore/should_compile/T5550.stderr | 3 --- 3 files changed, 1 insertion(+), 9 deletions(-) diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 5b0251c..ecba45b 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -1292,7 +1292,7 @@ findFile mk_file_path (dir : dirs) \begin{code} maybePutStr :: DynFlags -> String -> IO () maybePutStr dflags s - = when (verbosity dflags > 0) $ + = when (verbosity dflags > 1) $ do let act = log_action dflags act dflags SevInteractive noSrcSpan defaultUserStyle (text s) diff --git a/testsuite/tests/indexed-types/should_fail/T9160.stderr b/testsuite/tests/indexed-types/should_fail/T9160.stderr index 11c6cd3..e356f80 100644 --- a/testsuite/tests/indexed-types/should_fail/T9160.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9160.stderr @@ -1,8 +1,3 @@ -Loading package ghc-prim-0.3.1.0 ... linking ... done. -Loading package integer-gmp-0.5.1.0 ... linking ... done. -Loading package base-4.8.0.0 ... linking ... done. -Loading package pretty-1.1.1.1 ... linking ... done. -Loading package template-haskell-2.10.0.0 ... linking ... done. T9160.hs:18:8: Type indexes must match class instance head diff --git a/testsuite/tests/simplCore/should_compile/T5550.stderr b/testsuite/tests/simplCore/should_compile/T5550.stderr index c2fa315..e69de29 100644 --- a/testsuite/tests/simplCore/should_compile/T5550.stderr +++ b/testsuite/tests/simplCore/should_compile/T5550.stderr @@ -1,3 +0,0 @@ -Loading package ghc-prim-0.3.1.0 ... linking ... done. -Loading package integer-gmp-0.5.1.0 ... linking ... done. -Loading package base-4.8.0.0 ... linking ... done. From git at git.haskell.org Sat Sep 20 21:40:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 21:40:15 +0000 (UTC) Subject: [commit: packages/haskell2010] master's head updated: Adapt to Data.List/Foldable generalisation (8ab509b) Message-ID: <20140920214015.2D4463A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell2010 Branch 'master' now includes: 8ab509b Adapt to Data.List/Foldable generalisation From git at git.haskell.org Sat Sep 20 21:40:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 21:40:27 +0000 (UTC) Subject: [commit: packages/haskell98] master's head updated: Adapt to Data.List/Foldable generalisation (51ac61f) Message-ID: <20140920214027.093F83A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell98 Branch 'master' now includes: 51ac61f Adapt to Data.List/Foldable generalisation From git at git.haskell.org Sat Sep 20 21:40:50 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 21:40:50 +0000 (UTC) Subject: [commit: ghc] master: Set up framework for generalising Data.List to Foldables (3daf002) Message-ID: <20140920214050.106493A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3daf0023d2dcf7caf85d61f2dc177f8e9421b2fd/ghc >--------------------------------------------------------------- commit 3daf0023d2dcf7caf85d61f2dc177f8e9421b2fd Author: Herbert Valerio Riedel Date: Sat Sep 20 23:32:06 2014 +0200 Set up framework for generalising Data.List to Foldables This renames the Data.List module to Data.OldList, and puts a new Data.List module into its place re-exporting all list functions. The plan is to leave the monomorphic versions of the list functions in Data.OldList to help smooth the transition. The new Data.List module then will simply re-export entities from Data.OldList and Data.Foldable. This refactoring has been placed in a separate commit to be able to better isolate any regressions caused by the actual list function generalisations when implementing #9586 This also updates the haskell2010, haskell98, and array submodules Reviewed By: austin, ekmett Differential Revision: https://phabricator.haskell.org/D228 >--------------------------------------------------------------- 3daf0023d2dcf7caf85d61f2dc177f8e9421b2fd libraries/array | 2 +- libraries/base/Data/Foldable.hs | 2 +- libraries/base/Data/List.hs | 910 +-------------------- libraries/base/Data/{List.hs => OldList.hs} | 2 +- libraries/base/Data/OldTypeable/Internal.hs | 2 +- libraries/base/GHC/Event/Internal.hs | 3 +- libraries/base/GHC/Exts.hs | 2 +- libraries/base/Prelude.hs | 2 +- libraries/base/base.cabal | 1 + libraries/haskell2010 | 2 +- libraries/haskell98 | 2 +- testsuite/tests/ghci/scripts/ghci008.stdout | 4 +- testsuite/tests/lib/integer/integerGmpInternals.hs | 2 +- testsuite/tests/rename/should_compile/T1972.stderr | 1 + testsuite/tests/rename/should_compile/T7963a.hs | 3 + .../tests/rename/should_fail/rnfail040.stderr | 1 + 16 files changed, 21 insertions(+), 920 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 3daf0023d2dcf7caf85d61f2dc177f8e9421b2fd From git at git.haskell.org Sat Sep 20 21:48:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 21:48:42 +0000 (UTC) Subject: [commit: ghc] master: Turn a few existing folds into `Foldable`-methods (#9621) (1812898) Message-ID: <20140920214842.574843A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1812898c0332c6807201938911bb914633267d9d/ghc >--------------------------------------------------------------- commit 1812898c0332c6807201938911bb914633267d9d Author: Herbert Valerio Riedel Date: Sat Sep 20 23:43:23 2014 +0200 Turn a few existing folds into `Foldable`-methods (#9621) Turn `toList`, `elem`, `sum`, `product`, `maximum`, and `minimum` into `Foldable` methods. This helps avoiding regressions (and semantic differences) while implementing #9586 Reviewed By: austin, dfeuer, ekmett Differential Revision: https://phabricator.haskell.org/D231 >--------------------------------------------------------------- 1812898c0332c6807201938911bb914633267d9d libraries/base/Data/Foldable.hs | 76 +++++++++++++++++++++-------------------- libraries/base/changelog.md | 3 ++ 2 files changed, 42 insertions(+), 37 deletions(-) diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index cb13e5c..726aa6c 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -39,21 +39,15 @@ module Data.Foldable ( sequence_, msum, -- ** Specialized folds - toList, concat, concatMap, and, or, any, all, - sum, - product, - maximum, maximumBy, - minimum, minimumBy, -- ** Searches - elem, notElem, find ) where @@ -97,6 +91,8 @@ infix 4 `elem`, `notElem` -- > foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l -- class Foldable t where + {-# MINIMAL foldMap | foldr #-} + -- | Combine the elements of a structure using a monoid. fold :: Monoid m => t m -> m fold = foldMap id @@ -153,7 +149,32 @@ class Foldable t where where mf Nothing y = Just y mf (Just x) y = Just (f x y) - {-# MINIMAL foldMap | foldr #-} + + -- | List of elements of a structure. + toList :: Foldable t => t a -> [a] + {-# INLINE toList #-} + toList t = build (\ c n -> foldr c n t) + + -- | Does the element occur in the structure? + elem :: (Foldable t, Eq a) => a -> t a -> Bool + elem = any . (==) + + -- | The largest element of a non-empty structure. + maximum :: (Foldable t, Ord a) => t a -> a + maximum = foldr1 max + + -- | The least element of a non-empty structure. + minimum :: (Foldable t, Ord a) => t a -> a + minimum = foldr1 min + + -- | The 'sum' function computes the sum of the numbers of a structure. + sum :: Num a => t a -> a + sum = getSum . foldMap Sum + + -- | The 'product' function computes the product of the numbers of a + -- structure. + product :: (Foldable t, Num a) => t a -> a + product = getProduct . foldMap Product -- instances for Prelude types @@ -165,11 +186,17 @@ instance Foldable Maybe where foldl f z (Just x) = f z x instance Foldable [] where - foldr = List.foldr - foldl = List.foldl - foldl' = List.foldl' - foldr1 = List.foldr1 - foldl1 = List.foldl1 + elem = List.elem + foldl = List.foldl + foldl' = List.foldl' + foldl1 = List.foldl1 + foldr = List.foldr + foldr1 = List.foldr1 + maximum = List.maximum + minimum = List.minimum + product = List.product + sum = List.sum + toList = id instance Foldable (Either a) where foldMap _ (Left _) = mempty @@ -257,11 +284,6 @@ msum = foldr mplus mzero -- These use foldr rather than foldMap to avoid repeated concatenation. --- | List of elements of a structure. -toList :: Foldable t => t a -> [a] -{-# INLINE toList #-} -toList t = build (\ c n -> foldr c n t) - -- | The concatenation of all the elements of a container of lists. concat :: Foldable t => t [a] -> [a] concat = fold @@ -291,18 +313,6 @@ any p = getAny . foldMap (Any . p) all :: Foldable t => (a -> Bool) -> t a -> Bool all p = getAll . foldMap (All . p) --- | The 'sum' function computes the sum of the numbers of a structure. -sum :: (Foldable t, Num a) => t a -> a -sum = getSum . foldMap Sum - --- | The 'product' function computes the product of the numbers of a structure. -product :: (Foldable t, Num a) => t a -> a -product = getProduct . foldMap Product - --- | The largest element of a non-empty structure. -maximum :: (Foldable t, Ord a) => t a -> a -maximum = foldr1 max - -- | The largest element of a non-empty structure with respect to the -- given comparison function. maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a @@ -311,10 +321,6 @@ maximumBy cmp = foldr1 max' GT -> x _ -> y --- | The least element of a non-empty structure. -minimum :: (Foldable t, Ord a) => t a -> a -minimum = foldr1 min - -- | The least element of a non-empty structure with respect to the -- given comparison function. minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a @@ -323,10 +329,6 @@ minimumBy cmp = foldr1 min' GT -> y _ -> x --- | Does the element occur in the structure? -elem :: (Foldable t, Eq a) => a -> t a -> Bool -elem = any . (==) - -- | 'notElem' is the negation of 'elem'. notElem :: (Foldable t, Eq a) => a -> t a -> Bool notElem x = not . elem x diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 1dbada0..d82d354 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -32,6 +32,9 @@ * Set fixity for `Data.Foldable.{elem,notElem}` to match the conventional one set for `Data.List.{elem,notElem}` (#9610) + * Turn `toList`, `elem`, `sum`, `product`, `maximum`, and `minimum` + into `Foldable` methods (#9621) + ## 4.7.0.1 *Jul 2014* * Bundled with GHC 7.8.3 From git at git.haskell.org Sat Sep 20 21:53:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 21:53:44 +0000 (UTC) Subject: [commit: ghc] master: Generalise (some of) Data.List to Foldables (re #9568) (05cf18f) Message-ID: <20140920215344.79B503A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/05cf18f883bf2d49b53a1d25cb57eff3333eb0c9/ghc >--------------------------------------------------------------- commit 05cf18f883bf2d49b53a1d25cb57eff3333eb0c9 Author: Herbert Valerio Riedel Date: Sat Sep 20 23:50:06 2014 +0200 Generalise (some of) Data.List to Foldables (re #9568) This replaces the entities in Data.List conflicting with Data.Foldable with re-exports of the generalised version from Data.Foldable. As of this commit, the following compiles w/o error module XPrelude (module X) where import Control.Monad as X import Data.Foldable as X import Data.List as X import Prelude as X Reviewed By: austin, dfeuer, ekmett Differential Revision: https://phabricator.haskell.org/D229 >--------------------------------------------------------------- 05cf18f883bf2d49b53a1d25cb57eff3333eb0c9 libraries/base/Data/List.hs | 7 +++++-- libraries/base/changelog.md | 10 ++++++++++ testsuite/tests/rename/should_fail/rnfail032.stderr | 4 ++-- testsuite/tests/rename/should_fail/rnfail033.stderr | 4 ++-- 4 files changed, 19 insertions(+), 6 deletions(-) diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs index 44c86bb..5bc8121 100644 --- a/libraries/base/Data/List.hs +++ b/libraries/base/Data/List.hs @@ -207,5 +207,8 @@ module Data.List ) where -import Data.Foldable () -import Data.OldList +import Data.Foldable +import Data.OldList hiding ( all, and, any, concat, concatMap, elem, find, + foldl, foldl1, foldl', foldr, foldr1, maximum, + maximumBy, minimum, minimumBy, notElem, or, + product, sum ) diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index d82d354..c57d5f0 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -35,6 +35,16 @@ * Turn `toList`, `elem`, `sum`, `product`, `maximum`, and `minimum` into `Foldable` methods (#9621) + * Replace the `Data.List`-exported functions + + ``` + all, and, any, concat, concatMap, elem, find, product, sum + ``` + + by re-exports of their generalised `Data.Foldable` counterparts. + In other words, unqualified imports of `Data.List` and + `Data.Foldable` no longer lead to conflicting definitions. (#9586) + ## 4.7.0.1 *Jul 2014* * Bundled with GHC 7.8.3 diff --git a/testsuite/tests/rename/should_fail/rnfail032.stderr b/testsuite/tests/rename/should_fail/rnfail032.stderr index 8a2bf0c..2169fd5 100644 --- a/testsuite/tests/rename/should_fail/rnfail032.stderr +++ b/testsuite/tests/rename/should_fail/rnfail032.stderr @@ -3,5 +3,5 @@ rnfail032.hs:2:21: Not in scope: ?Data.List.map? Perhaps you meant one of these: ?Data.List.zip? (imported from Data.List), - ?Data.List.sum? (imported from Data.List), - ?Data.List.all? (imported from Data.List) + ?Data.List.all? (imported from Data.List), + ?Data.List.and? (imported from Data.List) diff --git a/testsuite/tests/rename/should_fail/rnfail033.stderr b/testsuite/tests/rename/should_fail/rnfail033.stderr index 9e95a85..6b6849d 100644 --- a/testsuite/tests/rename/should_fail/rnfail033.stderr +++ b/testsuite/tests/rename/should_fail/rnfail033.stderr @@ -3,5 +3,5 @@ rnfail033.hs:2:21: Not in scope: ?Data.List.map? Perhaps you meant one of these: ?Data.List.zip? (imported from Data.List), - ?Data.List.sum? (imported from Data.List), - ?Data.List.all? (imported from Data.List) + ?Data.List.all? (imported from Data.List), + ?Data.List.and? (imported from Data.List) From git at git.haskell.org Sat Sep 20 21:59:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 21:59:51 +0000 (UTC) Subject: [commit: ghc] master: Add missing changelog entries for current state of #9586 (ed65808) Message-ID: <20140920215951.5AAA33A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ed65808cebf068a98f564f6ad962838c6526591b/ghc >--------------------------------------------------------------- commit ed65808cebf068a98f564f6ad962838c6526591b Author: Herbert Valerio Riedel Date: Sat Sep 20 23:58:12 2014 +0200 Add missing changelog entries for current state of #9586 >--------------------------------------------------------------- ed65808cebf068a98f564f6ad962838c6526591b libraries/base/changelog.md | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index c57d5f0..d7e1133 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -45,6 +45,20 @@ In other words, unqualified imports of `Data.List` and `Data.Foldable` no longer lead to conflicting definitions. (#9586) + * Replace the `Control.Monad`-exported functions + + ``` + sequence_, msum, mapM_, forM_ + ``` + + by re-exports of their generalised `Data.Foldable` counterparts. + In other words, unqualified imports of `Control.Monad` and + `Data.Foldable` no longer lead to conflicting definitions. (#9586) + + * New module `Data.OldList` containing only list-specialised versions of + the functions from `Data.List` (in other words, `Data.OldList` corresponds + to `base-4.7.0.1`'s `Data.List`) + ## 4.7.0.1 *Jul 2014* * Bundled with GHC 7.8.3 From git at git.haskell.org Sat Sep 20 23:20:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 23:20:53 +0000 (UTC) Subject: [commit: ghc] branch 'wip/python3' created Message-ID: <20140920232053.D8F163A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/python3 Referencing: 7b4411e49ee76ae2f3428e4f3cc5f1d6839469d4 From git at git.haskell.org Sat Sep 20 23:20:56 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 23:20:56 +0000 (UTC) Subject: [commit: ghc] wip/python3: Fix mixed tab/space indentation in tests (8118bd1) Message-ID: <20140920232056.673FC3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/python3 Link : http://ghc.haskell.org/trac/ghc/changeset/8118bd1d5709e99559c7bd65442eb192488660f6/ghc >--------------------------------------------------------------- commit 8118bd1d5709e99559c7bd65442eb192488660f6 Author: Krzysztof Gogolewski Date: Sat Sep 20 18:29:32 2014 +0200 Fix mixed tab/space indentation in tests Python 3 does not like it >--------------------------------------------------------------- 8118bd1d5709e99559c7bd65442eb192488660f6 testsuite/tests/ffi/should_run/all.T | 10 +++++----- testsuite/tests/ghci/prog004/prog004.T | 4 ++-- testsuite/tests/numeric/should_run/all.T | 8 ++++---- testsuite/tests/plugins/all.T | 4 ++-- testsuite/tests/th/TH_spliceViewPat/test.T | 6 +++--- testsuite/tests/th/all.T | 6 +++--- testsuite/tests/typecheck/should_run/all.T | 4 ++-- 7 files changed, 21 insertions(+), 21 deletions(-) diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T index 7efc6eb..6fe0878 100644 --- a/testsuite/tests/ffi/should_run/all.T +++ b/testsuite/tests/ffi/should_run/all.T @@ -50,10 +50,10 @@ test('ffi008', [exit_code(1), omit_ways(['ghci'])], compile_and_run, ['']) maybe_skip = normal opts = '' if config.platform.startswith('i386-'): - if config.compiler_type == 'ghc' and \ + if config.compiler_type == 'ghc' and \ version_ge(config.compiler_version, '6.13'): - opts = '-msse2' - else: + opts = '-msse2' + else: maybe_skip = only_ways(['ghci']) test('ffi009', [when(fast(), skip), @@ -69,9 +69,9 @@ test('ffi011', normal, compile_and_run, ['']) # it. if config.os == 'mingw32': - skip_if_not_windows = normal + skip_if_not_windows = normal else: - skip_if_not_windows = skip + skip_if_not_windows = skip test('ffi012', skip_if_not_windows, compile_and_run, ['']) test('ffi013', normal, compile_and_run, ['']) diff --git a/testsuite/tests/ghci/prog004/prog004.T b/testsuite/tests/ghci/prog004/prog004.T index ed17afd..4b6ee13 100644 --- a/testsuite/tests/ghci/prog004/prog004.T +++ b/testsuite/tests/ghci/prog004/prog004.T @@ -1,8 +1,8 @@ setTestOpts(only_compiler_types(['ghc'])) def f(name, opts): - if not ('ghci' in config.run_ways): - opts.skip = 1 + if not ('ghci' in config.run_ways): + opts.skip = 1 setTestOpts(f) test('ghciprog004', diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index 72c8e6a..76181a2 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -15,11 +15,11 @@ test('arith007', normal, compile_and_run, ['']) ways = normal opts = '' if config.platform.startswith('i386-'): - if config.compiler_type == 'ghc' and \ + if config.compiler_type == 'ghc' and \ version_ge(config.compiler_version, '6.13'): - opts = '-msse2' - else: - ways = expect_fail_for(['optasm','threaded2','hpc','dyn','profasm']) + opts = '-msse2' + else: + ways = expect_fail_for(['optasm','threaded2','hpc','dyn','profasm']) test('arith008', ways, compile_and_run, [opts]) diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index 7e5f9b4..8b2256a 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -1,6 +1,6 @@ def f(name, opts): - if (ghc_with_interpreter == 0): - opts.skip = 1 + if (ghc_with_interpreter == 0): + opts.skip = 1 setTestOpts(f) setTestOpts(when(compiler_lt('ghc', '7.1'), skip)) diff --git a/testsuite/tests/th/TH_spliceViewPat/test.T b/testsuite/tests/th/TH_spliceViewPat/test.T index c08e7cb..21fdff3 100644 --- a/testsuite/tests/th/TH_spliceViewPat/test.T +++ b/testsuite/tests/th/TH_spliceViewPat/test.T @@ -1,7 +1,7 @@ def f(name, opts): - opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell' - if (ghc_with_interpreter == 0): - opts.skip = 1 + opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell' + if (ghc_with_interpreter == 0): + opts.skip = 1 setTestOpts(f) setTestOpts(only_compiler_types(['ghc'])) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 6e86d30..00f5fc9 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -4,9 +4,9 @@ test('T4255', unless(compiler_profiled(), skip), compile_fail, ['-v0']) def f(name, opts): - opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell' - if (ghc_with_interpreter == 0): - opts.skip = 1 + opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell' + if (ghc_with_interpreter == 0): + opts.skip = 1 setTestOpts(f) setTestOpts(only_compiler_types(['ghc'])) diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index 760d5e1..5da7c8b 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/testsuite/tests/typecheck/should_run/all.T @@ -19,8 +19,8 @@ test('TcCoercible', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, [''] # Skip everything else if fast is on def f(name, opts): - if config.fast: - opts.skip = 1 + if config.fast: + opts.skip = 1 setTestOpts(f) test('tcrun006', normal, compile_and_run, ['']) From git at git.haskell.org Sat Sep 20 23:20:58 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 23:20:58 +0000 (UTC) Subject: [commit: ghc] wip/python3: Catch only an Exception (1fff290) Message-ID: <20140920232058.E7E083A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/python3 Link : http://ghc.haskell.org/trac/ghc/changeset/1fff29000adc087e0ed98a397d6c2ded594c80ac/ghc >--------------------------------------------------------------- commit 1fff29000adc087e0ed98a397d6c2ded594c80ac Author: Krzysztof Gogolewski Date: Sat Sep 20 19:04:22 2014 +0200 Catch only an Exception This allows ^C during test discovery >--------------------------------------------------------------- 1fff29000adc087e0ed98a397d6c2ded594c80ac testsuite/driver/runtests.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index fcff225..7b01f7d 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -263,7 +263,7 @@ for file in t_files: newTestDir(os.path.dirname(file)) try: exec(open(file).read()) - except: + except Exception: print('*** framework failure: found an error while executing ', file, ':') t.n_framework_failures = t.n_framework_failures + 1 traceback.print_exc() From git at git.haskell.org Sat Sep 20 23:21:01 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 23:21:01 +0000 (UTC) Subject: [commit: ghc] wip/python3: Replace deprecated string.join(x, y) with y.join(x) (6b0d6cc) Message-ID: <20140920232101.769943A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/python3 Link : http://ghc.haskell.org/trac/ghc/changeset/6b0d6ccdc15eaa0b0026f75a18ec20b9907d58a0/ghc >--------------------------------------------------------------- commit 6b0d6ccdc15eaa0b0026f75a18ec20b9907d58a0 Author: Krzysztof Gogolewski Date: Sat Sep 20 18:05:28 2014 +0200 Replace deprecated string.join(x,y) with y.join(x) >--------------------------------------------------------------- 6b0d6ccdc15eaa0b0026f75a18ec20b9907d58a0 testsuite/driver/testlib.py | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 768f4bb..2e79476 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -24,7 +24,6 @@ try: except: print("Warning: subprocess not found, will fall back to spawnv") -from string import join from testglobals import * from testutil import * @@ -903,10 +902,10 @@ def ghci_script( name, way, script ): # We pass HC and HC_OPTS as environment variables, so that the # script can invoke the correct compiler by using ':! $HC $HC_OPTS' cmd = "HC='" + config.compiler + "' " + \ - "HC_OPTS='" + join(flags,' ') + "' " + \ + "HC_OPTS='" + ' '.join(flags) + "' " + \ "'" + config.compiler + "'" + \ ' --interactive -v0 -ignore-dot-ghci ' + \ - join(flags,' ') + ' '.join(flags) getTestOpts().stdin = script return simple_run( name, way, cmd, getTestOpts().extra_run_opts ) @@ -1160,9 +1159,9 @@ def simple_build( name, way, extra_hc_opts, should_fail, top_mod, link, addsuf, cmd = 'cd ' + getTestOpts().testdir + " && " + cmd_prefix + "'" \ + config.compiler + "' " \ - + join(comp_flags,' ') + ' ' \ + + ' '.join(comp_flags) + ' ' \ + to_do + ' ' + srcname + ' ' \ - + join(config.way_flags(name)[way],' ') + ' ' \ + + ' '.join(config.way_flags(name)[way]) + ' ' \ + extra_hc_opts + ' ' \ + opts.extra_hc_opts + ' ' \ + '>' + errname + ' 2>&1' @@ -1287,7 +1286,7 @@ def rts_flags(way): if args == []: return '' else: - return '+RTS ' + join(args,' ') + ' -RTS' + return '+RTS ' + ' '.join(args) + ' -RTS' # ----------------------------------------------------------------------------- # Run a program in the interpreter and check its output @@ -1344,9 +1343,9 @@ def interpreter_run( name, way, extra_hc_opts, compile_only, top_mod ): flags.extend(["-outputdir", getTestOpts().outputdir]) cmd = "'" + config.compiler + "' " \ - + join(flags,' ') + ' ' \ + + ' '.join(flags) + ' ' \ + srcname + ' ' \ - + join(config.way_flags(name)[way],' ') + ' ' \ + + ' '.join(config.way_flags(name)[way]) + ' ' \ + extra_hc_opts + ' ' \ + getTestOpts().extra_hc_opts + ' ' \ + '<' + scriptname + ' 1>' + outname + ' 2>' + errname @@ -2124,7 +2123,7 @@ def printPassingTestInfosSummary(file, testInfos): tests.sort() for test in tests: file.write(' ' + directory.ljust(maxDirLen + 2) + test + \ - ' (' + join(testInfos[directory][test],',') + ')\n') + ' (' + ','.join(testInfos[directory][test]) + ')\n') file.write('\n') def printFailingTestInfosSummary(file, testInfos): @@ -2139,7 +2138,7 @@ def printFailingTestInfosSummary(file, testInfos): for reason in reasons: file.write(' ' + directory.ljust(maxDirLen + 2) + test + \ ' [' + reason + ']' + \ - ' (' + join(testInfos[directory][test][reason],',') + ')\n') + ' (' + ','.join(testInfos[directory][test][reason]) + ')\n') file.write('\n') def getStdout(cmd): From git at git.haskell.org Sat Sep 20 23:21:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 23:21:04 +0000 (UTC) Subject: [commit: ghc] wip/python3: Use list comprehensions in config/ghc for Python 3 compatibility (3e6e981) Message-ID: <20140920232104.05EB03A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/python3 Link : http://ghc.haskell.org/trac/ghc/changeset/3e6e9813c0b3935a4f3cd1a34d6e1feef979c179/ghc >--------------------------------------------------------------- commit 3e6e9813c0b3935a4f3cd1a34d6e1feef979c179 Author: Krzysztof Gogolewski Date: Sat Sep 20 18:37:04 2014 +0200 Use list comprehensions in config/ghc for Python 3 compatibility >--------------------------------------------------------------- 3e6e9813c0b3935a4f3cd1a34d6e1feef979c179 testsuite/config/ghc | 22 +++++++++------------- 1 file changed, 9 insertions(+), 13 deletions(-) diff --git a/testsuite/config/ghc b/testsuite/config/ghc index 031d955..84b89d4 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -148,21 +148,17 @@ config.way_rts_flags = { # Useful classes of ways that can be used with only_ways() and # expect_broken_for(). -prof_ways = map (lambda x: x[0], \ - filter(lambda x: '-prof' in x[1], \ - config.way_flags('dummy_name').items())) +prof_ways = [x[0] for x in config.way_flags('dummy_name').items() + if '-prof' in x[1]] -threaded_ways = map (lambda x: x[0], \ - filter(lambda x: '-threaded' in x[1] or 'ghci' == x[0], \ - config.way_flags('dummy_name').items())) +threaded_ways = [x[0] for x in config.way_flags('dummy_name').items() + if '-threaded' in x[1] or 'ghci' == x[0]] -opt_ways = map (lambda x: x[0], \ - filter(lambda x: '-O' in x[1], \ - config.way_flags('dummy_name').items())) +opt_ways = [x[0] for x in config.way_flags('dummy_name').items() + if '-O' in x[1]] -llvm_ways = map (lambda x: x[0], \ - filter(lambda x: '-fllvm' in x[1], \ - config.way_flags('dummy_name').items())) +llvm_ways = [x[0] for x in config.way_flags('dummy_name').items() + if '-fflvm' in x[1]] def get_compiler_info(): # This should really not go through the shell @@ -192,7 +188,7 @@ def get_compiler_info(): if re.match(".*_p(_.*|$)", rtsInfoDict["RTS way"]): config.compiler_profiled = True - config.run_ways = filter(lambda x: x != 'ghci', config.run_ways) + config.run_ways = [x for x in config.run_ways if x != 'ghci'] else: config.compiler_profiled = False From git at git.haskell.org Sat Sep 20 23:21:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 23:21:06 +0000 (UTC) Subject: [commit: ghc] wip/python3: Replace execfile with exec(open(...)) (f74f1f5) Message-ID: <20140920232106.8F2683A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/python3 Link : http://ghc.haskell.org/trac/ghc/changeset/f74f1f52f08ef543ef84ace6188f0354a121600b/ghc >--------------------------------------------------------------- commit f74f1f52f08ef543ef84ace6188f0354a121600b Author: Krzysztof Gogolewski Date: Sat Sep 20 17:59:53 2014 +0200 Replace execfile with exec(open(...)) >--------------------------------------------------------------- f74f1f52f08ef543ef84ace6188f0354a121600b testsuite/driver/runtests.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 5283c9a..fcff225 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -54,7 +54,7 @@ opts, args = getopt.getopt(sys.argv[1:], "e:", long_options) for opt,arg in opts: if opt == '--config': - exec(compile(open(arg).read(), arg, 'exec')) + exec(open(arg).read()) # -e is a string to execute from the command line. For example: # testframe -e 'config.compiler=ghc-5.04' @@ -262,7 +262,7 @@ for file in t_files: if_verbose(2, '====> Scanning %s' % file) newTestDir(os.path.dirname(file)) try: - exec(compile(open(file).read(), arg, 'exec')) + exec(open(file).read()) except: print('*** framework failure: found an error while executing ', file, ':') t.n_framework_failures = t.n_framework_failures + 1 From git at git.haskell.org Sat Sep 20 23:21:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 23:21:09 +0000 (UTC) Subject: [commit: ghc] wip/python3: Improve testsuite driver compatibility with Python 3 (Trac #9184) (88671a7) Message-ID: <20140920232109.2225C3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/python3 Link : http://ghc.haskell.org/trac/ghc/changeset/88671a7f2ec8f193ccc37a6727f70e48a812d286/ghc >--------------------------------------------------------------- commit 88671a7f2ec8f193ccc37a6727f70e48a812d286 Author: Krzysztof Gogolewski Date: Sat Sep 20 15:59:12 2014 +0200 Improve testsuite driver compatibility with Python 3 (Trac #9184) Thanks to aspidites who provided the patch. >--------------------------------------------------------------- 88671a7f2ec8f193ccc37a6727f70e48a812d286 testsuite/driver/runtests.py | 38 +++++++++--------- testsuite/driver/testlib.py | 87 ++++++++++++++++++++-------------------- testsuite/timeout/timeout.py | 2 +- utils/fingerprint/fingerprint.py | 8 ++-- 4 files changed, 70 insertions(+), 65 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 88671a7f2ec8f193ccc37a6727f70e48a812d286 From git at git.haskell.org Sat Sep 20 23:21:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 23:21:11 +0000 (UTC) Subject: [commit: ghc] wip/python3: Replace several Python 2 only idioms with Python 2/3 compatible versions (16ecbc1) Message-ID: <20140920232111.A9CAE3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/python3 Link : http://ghc.haskell.org/trac/ghc/changeset/16ecbc121d064893057912aa0c5210c0b18febd1/ghc >--------------------------------------------------------------- commit 16ecbc121d064893057912aa0c5210c0b18febd1 Author: Krzysztof Gogolewski Date: Sat Sep 20 17:46:56 2014 +0200 Replace several Python 2 only idioms with Python 2/3 compatible versions Mostly done by manually checking 2to3 output >--------------------------------------------------------------- 16ecbc121d064893057912aa0c5210c0b18febd1 testsuite/driver/runtests.py | 16 +++---- testsuite/driver/testlib.py | 103 +++++++++++++++++++++---------------------- testsuite/driver/testutil.py | 1 + 3 files changed, 60 insertions(+), 60 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 16ecbc121d064893057912aa0c5210c0b18febd1 From git at git.haskell.org Sat Sep 20 23:21:14 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 23:21:14 +0000 (UTC) Subject: [commit: ghc] wip/python3: Minor Python 3 compatibility fixes (0300812) Message-ID: <20140920232114.352A23A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/python3 Link : http://ghc.haskell.org/trac/ghc/changeset/0300812c66663dbd9bf92b7d1a654305b08660a2/ghc >--------------------------------------------------------------- commit 0300812c66663dbd9bf92b7d1a654305b08660a2 Author: Krzysztof Gogolewski Date: Sat Sep 20 23:49:45 2014 +0200 Minor Python 3 compatibility fixes >--------------------------------------------------------------- 0300812c66663dbd9bf92b7d1a654305b08660a2 testsuite/tests/perf/compiler/all.T | 2 +- testsuite/timeout/calibrate | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index a7783a4..9868fae 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -1,6 +1,6 @@ def no_lint(name, opts): opts.compiler_always_flags = \ - filter(lambda opt: opt != '-dcore-lint' and opt != '-dcmm-lint', opts.compiler_always_flags) + [opt for opt in opts.compiler_always_flags if opt != '-dcore-lint' and opt != '-dcmm-lint'] setTestOpts(no_lint) diff --git a/testsuite/timeout/calibrate b/testsuite/timeout/calibrate index b0d75da..f30c628 100644 --- a/testsuite/timeout/calibrate +++ b/testsuite/timeout/calibrate @@ -10,7 +10,7 @@ except: # We don't have resource, so this is a non-UNIX machine. # It's probably a reasonable modern x86/x86_64 machines, so we'd # probably calibrate to 300 anyway; thus just print 300. - print 300 + print(300) exit(0) compiler = argv[1] From git at git.haskell.org Sat Sep 20 23:21:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 23:21:16 +0000 (UTC) Subject: [commit: ghc] wip/python3: Fixup tuple unpacking (1b8239d) Message-ID: <20140920232116.B5B183A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/python3 Link : http://ghc.haskell.org/trac/ghc/changeset/1b8239dd81c9668ecc08082f7b84cef7739dee32/ghc >--------------------------------------------------------------- commit 1b8239dd81c9668ecc08082f7b84cef7739dee32 Author: Krzysztof Gogolewski Date: Sun Sep 21 00:54:31 2014 +0200 Fixup tuple unpacking >--------------------------------------------------------------- 1b8239dd81c9668ecc08082f7b84cef7739dee32 testsuite/driver/runtests.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 7b01f7d..00a0b34 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -272,7 +272,7 @@ if config.list_broken: global brokens print('') print('Broken tests:') - print(' '.join(map (lambda b, d, n: '#' + str(b) + '(' + d + '/' + n + ')', brokens))) + print(' '.join(map (lambda bdn: '#' + str(bdn[0]) + '(' + bdn[1] + '/' + bdn[2] + ')', brokens))) print('') if t.n_framework_failures != 0: From git at git.haskell.org Sat Sep 20 23:21:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Sep 2014 23:21:19 +0000 (UTC) Subject: [commit: ghc] wip/python3: Do not set buffering under Python 3, show a warning with Python 3 (7b4411e) Message-ID: <20140920232119.415F43A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/python3 Link : http://ghc.haskell.org/trac/ghc/changeset/7b4411e49ee76ae2f3428e4f3cc5f1d6839469d4/ghc >--------------------------------------------------------------- commit 7b4411e49ee76ae2f3428e4f3cc5f1d6839469d4 Author: Krzysztof Gogolewski Date: Sun Sep 21 01:15:33 2014 +0200 Do not set buffering under Python 3, show a warning with Python 3 I am not happy with this solution; a better way is to use uniformly unicode or bytes in both Pythons, but this seems too disruptive for now. >--------------------------------------------------------------- 7b4411e49ee76ae2f3428e4f3cc5f1d6839469d4 testsuite/driver/runtests.py | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 00a0b34..883bda7 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -23,6 +23,11 @@ try: except: pass +PYTHON3 = sys.version_info >= (3, 0) +if PYTHON3: + print("*** WARNING: running testsuite using Python 3.\n" + "*** Python 3 support is experimental. See Trac #9184.") + from testutil import * from testglobals import * @@ -253,9 +258,13 @@ t.start_time = time.localtime() print('Beginning test run at', time.strftime("%c %Z",t.start_time)) -# set stdout to unbuffered (is this the best way to do it?) sys.stdout.flush() -sys.stdout = os.fdopen(sys.__stdout__.fileno(), "w", 0) +if PYTHON3: + # in Python 3, we output text, which cannot be unbuffered + sys.stdout = os.fdopen(sys.__stdout__.fileno(), "w") +else: + # set stdout to unbuffered (is this the best way to do it?) + sys.stdout = os.fdopen(sys.__stdout__.fileno(), "w", 0) # First collect all the tests to be run for file in t_files: From git at git.haskell.org Sun Sep 21 09:18:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Sep 2014 09:18:44 +0000 (UTC) Subject: [commit: packages/haskell2010] master: Use explicit import-list for GHC.Base (979e43f) Message-ID: <20140921091844.60B5F3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell2010 On branch : master Link : http://git.haskell.org/packages/haskell2010.git/commitdiff/979e43fad04603ea533cc9a8b948fde9e801705e >--------------------------------------------------------------- commit 979e43fad04603ea533cc9a8b948fde9e801705e Author: Herbert Valerio Riedel Date: Sun Sep 21 11:16:45 2014 +0200 Use explicit import-list for GHC.Base This improves forward-compatibility with base >--------------------------------------------------------------- 979e43fad04603ea533cc9a8b948fde9e801705e Prelude.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Prelude.hs b/Prelude.hs index 71d36a5..e4a03d7 100644 --- a/Prelude.hs +++ b/Prelude.hs @@ -130,7 +130,9 @@ import "base" Data.Either import "base" Data.Maybe import "base" Data.Tuple -import GHC.Base +import GHC.Base (($), ($!), (&&), (.), (||), Bool(..), Char, Eq(..), Int, + Ord(..), Ordering(..), String, asTypeOf, const, error, flip, + id, not, otherwise, seq, undefined, until) import Text.Read import GHC.Enum import GHC.Num From git at git.haskell.org Sun Sep 21 09:18:46 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Sep 2014 09:18:46 +0000 (UTC) Subject: [commit: packages/haskell2010] master: Cabal cleanup overlooked in 8d5301d03f2bb945ef3 (425df1d) Message-ID: <20140921091846.645E73A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell2010 On branch : master Link : http://git.haskell.org/packages/haskell2010.git/commitdiff/425df1d9ea7adcf823bbb5426528bd80eb2b820e >--------------------------------------------------------------- commit 425df1d9ea7adcf823bbb5426528bd80eb2b820e Author: Herbert Valerio Riedel Date: Sun Sep 21 11:17:25 2014 +0200 Cabal cleanup overlooked in 8d5301d03f2bb945ef3 >--------------------------------------------------------------- 425df1d9ea7adcf823bbb5426528bd80eb2b820e haskell2010.cabal | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/haskell2010.cabal b/haskell2010.cabal index 976c33c..3e0c85b 100644 --- a/haskell2010.cabal +++ b/haskell2010.cabal @@ -29,8 +29,6 @@ Library NoImplicitPrelude Safe Trustworthy - if impl(ghc) - other-extensions: Safe, Trustworthy build-depends: array >= 0.5 && < 0.6, @@ -40,8 +38,7 @@ Library -- build system doesn't seem to track transitive dependencies when -- running Haddock, and if we don't do this then Haddock can't -- find the docs for things defined in ghc-prim. - if impl(ghc) - build-depends: ghc-prim >= 0.3.1 && < 0.4 + build-depends: ghc-prim >= 0.3.1 && < 0.4 -- haskell2010 is a "hidden" package exposed: False From git at git.haskell.org Sun Sep 21 09:19:07 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Sep 2014 09:19:07 +0000 (UTC) Subject: [commit: packages/haskell98] master: Kill CPP conditionals for HUGS and old GHCs (401283a) Message-ID: <20140921091907.679473A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskell98 On branch : master Link : http://git.haskell.org/packages/haskell98.git/commitdiff/401283a98a818f66f856939f939562de5c4a2b47 >--------------------------------------------------------------- commit 401283a98a818f66f856939f939562de5c4a2b47 Author: Herbert Valerio Riedel Date: Sun Sep 21 11:13:02 2014 +0200 Kill CPP conditionals for HUGS and old GHCs This commit removes that bitrotting part of Prelude.hs. This reduces the CPP clutter to the point of not requiring any CPP processing altogether anymore. The same clanup was performed in the haskell2010 package recently. >--------------------------------------------------------------- 401283a98a818f66f856939f939562de5c4a2b47 Prelude.hs | 47 ++++------------------------------------------- haskell98.cabal | 9 +++------ 2 files changed, 7 insertions(+), 49 deletions(-) diff --git a/Prelude.hs b/Prelude.hs index bed225f..508f735 100644 --- a/Prelude.hs +++ b/Prelude.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE BangPatterns, CPP, NoImplicitPrelude, PackageImports #-} -#if __GLASGOW_HASKELL__ >= 701 -{-# LANGUAGE Trustworthy #-} -#endif +{-# LANGUAGE BangPatterns, NoImplicitPrelude, PackageImports, Trustworthy #-} -- | -- The Haskell 98 Prelude: a standard module imported by default @@ -28,10 +25,6 @@ module Prelude ( -- *** Tuples fst, snd, curry, uncurry, -#ifdef __HUGS__ - (:), -- Not legal Haskell 98 -#endif - -- ** Basic type classes Eq((==), (/=)), Ord(compare, (<), (<=), (>=), (>), max, min), @@ -129,7 +122,6 @@ module Prelude ( ) where -#ifndef __HUGS__ import qualified "base" Control.Exception.Base as New (catch) import "base" Control.Monad import "base" System.IO @@ -138,12 +130,10 @@ import "base" Data.OldList hiding ( splitAt ) import "base" Data.Either import "base" Data.Maybe import "base" Data.Tuple -#endif -#ifdef __GLASGOW_HASKELL__ -import GHC.Base hiding ( ($!) ) --- import GHC.IO --- import GHC.IO.Exception +import GHC.Base (($), ($!), (&&), (.), (||), Bool(..), Char, Eq(..), Int, + Ord(..), Ordering(..), String, asTypeOf, const, error, flip, + id, not, otherwise, seq, undefined, until) import Text.Read import GHC.Enum import GHC.Num @@ -151,35 +141,10 @@ import GHC.Real hiding ( gcd ) import qualified GHC.Real ( gcd ) import GHC.Float import GHC.Show -#endif - -#ifdef __HUGS__ -import Hugs.Prelude -#endif - -#ifndef __HUGS__ -infixr 0 $! -#endif -- ----------------------------------------------------------------------------- -- Miscellaneous functions --- | Strict (call-by-value) application, defined in terms of 'seq'. -($!) :: (a -> b) -> a -> b -#ifdef __GLASGOW_HASKELL__ -f $! x = let !vx = x in f vx -- see #2273 -#elif !defined(__HUGS__) -f $! x = x `seq` f x -#endif - -#ifdef __HADDOCK__ --- | The value of @'seq' a b@ is bottom if @a@ is bottom, and otherwise --- equal to @b at . 'seq' is usually introduced to improve performance by --- avoiding unneeded laziness. -seq :: a -> b -> b -seq _ y = y -#endif - -- | The 'catch' function establishes a handler that receives any -- 'IOError' raised in the action protected by 'catch'. -- An 'IOError' is caught by @@ -203,16 +168,13 @@ seq _ y = y catch :: IO a -> (IOError -> IO a) -> IO a catch = New.catch -#ifdef __GLASGOW_HASKELL__ -- | @'gcd' x y@ is the greatest (positive) integer that divides both @x@ -- and @y@; for example @'gcd' (-3) 6@ = @3@, @'gcd' (-3) (-6)@ = @3@, -- @'gcd' 0 4@ = @4 at . @'gcd' 0 0@ raises a runtime error. gcd :: (Integral a) => a -> a -> a gcd 0 0 = error "Prelude.gcd: gcd 0 0 is undefined" gcd x y = GHC.Real.gcd x y -#endif -#ifndef __HUGS__ -- The GHC's version of 'splitAt' is too strict in 'n' compared to -- Haskell98/2010 version. Ticket #1182. @@ -232,4 +194,3 @@ gcd x y = GHC.Real.gcd x y -- in which @n@ may be of any integral type. splitAt :: Int -> [a] -> ([a],[a]) splitAt n xs = (take n xs, drop n xs) -#endif diff --git a/haskell98.cabal b/haskell98.cabal index d89087f..728879d 100644 --- a/haskell98.cabal +++ b/haskell98.cabal @@ -28,17 +28,14 @@ Library default-language: Haskell98 other-extensions: BangPatterns - CPP NoImplicitPrelude PackageImports - if impl(ghc) - other-extensions: - Safe - Trustworthy + Safe + Trustworthy build-depends: array >= 0.5 && < 0.6, - base >= 4.7 && < 4.9, + base >= 4.8 && < 4.9, directory >= 1.2 && < 1.3, old-locale >= 1.0 && < 1.1, old-time >= 1.1 && < 1.2, From git at git.haskell.org Sun Sep 21 09:25:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Sep 2014 09:25:09 +0000 (UTC) Subject: [commit: packages/array] master: More forward-compat way to accomplish f7955522c45a (19b7aeb) Message-ID: <20140921092509.854AE3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/array On branch : master Link : http://git.haskell.org/packages/array.git/commitdiff/19b7aebd7dff912728029778749aaa8a9ed1cffd >--------------------------------------------------------------- commit 19b7aebd7dff912728029778749aaa8a9ed1cffd Author: Herbert Valerio Riedel Date: Sun Sep 21 11:24:27 2014 +0200 More forward-compat way to accomplish f7955522c45a >--------------------------------------------------------------- 19b7aebd7dff912728029778749aaa8a9ed1cffd Data/Array/Base.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs index b57ae4a..27e69c3 100644 --- a/Data/Array/Base.hs +++ b/Data/Array/Base.hs @@ -29,8 +29,9 @@ import GHC.Arr ( STArray ) import qualified GHC.Arr as Arr import qualified GHC.Arr as ArrST import GHC.ST ( ST(..), runST ) -import GHC.Base -import GHC.Ptr ( Ptr(..), FunPtr(..), nullPtr, nullFunPtr ) +import GHC.Base ( IO(..) ) +import GHC.Exts +import GHC.Ptr ( nullPtr, nullFunPtr ) import GHC.Stable ( StablePtr(..) ) #if !MIN_VERSION_base(4,6,0) import GHC.Exts ( Word(..) ) @@ -461,7 +462,7 @@ cmpIntUArray arr1@(UArray l1 u1 n1 _) arr2@(UArray l2 u2 n2 _) = if n1 == 0 then if n2 == 0 then EQ else LT else if n2 == 0 then GT else case compare l1 l2 of - EQ -> GHC.Base.foldr cmp (compare u1 u2) [0 .. (n1 `min` n2) - 1] + EQ -> foldr cmp (compare u1 u2) [0 .. (n1 `min` n2) - 1] other -> other where cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of From git at git.haskell.org Sun Sep 21 09:25:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Sep 2014 09:25:55 +0000 (UTC) Subject: [commit: ghc] master: Simplify import-graph a bit more (e7c1633) Message-ID: <20140921092555.90E1A3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e7c1633203e33c4a1af866c8658683bcef20a514/ghc >--------------------------------------------------------------- commit e7c1633203e33c4a1af866c8658683bcef20a514 Author: Herbert Valerio Riedel Date: Sun Sep 21 10:46:19 2014 +0200 Simplify import-graph a bit more This is preparatory refactoring for avoiding import cycles when `Data.Traversable` will be imported by `Control.Monad` and `Data.List` for implementing #9586 >--------------------------------------------------------------- e7c1633203e33c4a1af866c8658683bcef20a514 libraries/base/Foreign/Marshal/Pool.hs | 2 +- libraries/base/GHC/Event/Thread.hs | 2 +- libraries/base/GHC/IO/Encoding.hs | 2 +- libraries/base/System/IO.hs | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/libraries/base/Foreign/Marshal/Pool.hs b/libraries/base/Foreign/Marshal/Pool.hs index 1488e0f..78d069a 100644 --- a/libraries/base/Foreign/Marshal/Pool.hs +++ b/libraries/base/Foreign/Marshal/Pool.hs @@ -54,7 +54,7 @@ import GHC.IORef ( IORef, newIORef, readIORef, writeIORef ) import GHC.List ( elem, length ) import GHC.Num ( Num(..) ) -import Data.List ( delete ) +import Data.OldList ( delete ) import Foreign.Marshal.Alloc ( mallocBytes, reallocBytes, free ) import Foreign.Marshal.Array ( pokeArray, pokeArray0 ) import Foreign.Marshal.Error ( throwIf ) diff --git a/libraries/base/GHC/Event/Thread.hs b/libraries/base/GHC/Event/Thread.hs index f74fb7d..6fe7689 100644 --- a/libraries/base/GHC/Event/Thread.hs +++ b/libraries/base/GHC/Event/Thread.hs @@ -18,12 +18,12 @@ module GHC.Event.Thread import Control.Exception (finally, SomeException, toException) import Control.Monad (forM, forM_, sequence_, zipWithM) import Data.IORef (IORef, newIORef, readIORef, writeIORef) -import Data.List (zipWith3) import Data.Tuple (snd) import Foreign.C.Error (eBADF, errnoToIOError) import Foreign.C.Types (CInt(..), CUInt(..)) import Foreign.Ptr (Ptr) import GHC.Base +import GHC.List (zipWith3) import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO, labelThread, modifyMVar_, withMVar, newTVar, sharedCAF, getNumCapabilities, threadCapability, myThreadId, forkOn, diff --git a/libraries/base/GHC/IO/Encoding.hs b/libraries/base/GHC/IO/Encoding.hs index 9d03276..e8bbdfa 100644 --- a/libraries/base/GHC/IO/Encoding.hs +++ b/libraries/base/GHC/IO/Encoding.hs @@ -44,11 +44,11 @@ import qualified GHC.IO.Encoding.Latin1 as Latin1 import qualified GHC.IO.Encoding.UTF8 as UTF8 import qualified GHC.IO.Encoding.UTF16 as UTF16 import qualified GHC.IO.Encoding.UTF32 as UTF32 +import GHC.List import GHC.Word import Data.IORef import Data.Char (toUpper) -import Data.List import System.IO.Unsafe (unsafePerformIO) -- ----------------------------------------------------------------------------- diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs index 5cd0351..cb67a2a 100644 --- a/libraries/base/System/IO.hs +++ b/libraries/base/System/IO.hs @@ -222,7 +222,6 @@ module System.IO ( import Control.Exception.Base import Data.Bits -import Data.List import Data.Maybe import Foreign.C.Error #ifdef mingw32_HOST_OS @@ -233,6 +232,7 @@ import System.Posix.Internals import System.Posix.Types import GHC.Base +import GHC.List import GHC.IO hiding ( bracket, onException ) import GHC.IO.IOMode import GHC.IO.Handle.FD From git at git.haskell.org Sun Sep 21 09:28:15 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Sep 2014 09:28:15 +0000 (UTC) Subject: [commit: ghc] master: Update haskell2010, haskell98, and array submodules (bfc7195) Message-ID: <20140921092815.071153A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bfc719561ff96cb29dfa53647de47c402722a028/ghc >--------------------------------------------------------------- commit bfc719561ff96cb29dfa53647de47c402722a028 Author: Herbert Valerio Riedel Date: Sun Sep 21 11:27:08 2014 +0200 Update haskell2010, haskell98, and array submodules The changes are purely cleanups to improve forward compatibility to help with the Foldable/Traversal changes ahead. >--------------------------------------------------------------- bfc719561ff96cb29dfa53647de47c402722a028 libraries/array | 2 +- libraries/haskell2010 | 2 +- libraries/haskell98 | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/array b/libraries/array index f795552..19b7aeb 160000 --- a/libraries/array +++ b/libraries/array @@ -1 +1 @@ -Subproject commit f7955522c45a6b7da352349381d93be7c38dff35 +Subproject commit 19b7aebd7dff912728029778749aaa8a9ed1cffd diff --git a/libraries/haskell2010 b/libraries/haskell2010 index 8ab509b..425df1d 160000 --- a/libraries/haskell2010 +++ b/libraries/haskell2010 @@ -1 +1 @@ -Subproject commit 8ab509b674c73df2298d0f356b438d7db52896e6 +Subproject commit 425df1d9ea7adcf823bbb5426528bd80eb2b820e diff --git a/libraries/haskell98 b/libraries/haskell98 index 51ac61f..401283a 160000 --- a/libraries/haskell98 +++ b/libraries/haskell98 @@ -1 +1 @@ -Subproject commit 51ac61ffff22ad23b5c7edc3fcc503af1d88c745 +Subproject commit 401283a98a818f66f856939f939562de5c4a2b47 From git at git.haskell.org Sun Sep 21 13:24:59 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Sep 2014 13:24:59 +0000 (UTC) Subject: [commit: ghc] master: Make libffi install into a predictable directory (#9620) (835d874) Message-ID: <20140921132459.BF66E3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/835d874df1973b7e1c602a747b42b77095592a9c/ghc >--------------------------------------------------------------- commit 835d874df1973b7e1c602a747b42b77095592a9c Author: Reid Barton Date: Sun Sep 21 08:53:37 2014 -0400 Make libffi install into a predictable directory (#9620) On some systems (depending on gcc multilib configuration) libffi would install into libffi/build/inst/lib64 even though we configure it with --libdir=libffi/build/inst/lib. There appears to be no way to get libffi to install to a predictable directory "out of the box", so we apply a small patch to Makefile.in. This is the same fix used in Gentoo's ebuild (https://bugs.gentoo.org/show_bug.cgi?id=462814). >--------------------------------------------------------------- 835d874df1973b7e1c602a747b42b77095592a9c libffi/ghc.mk | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/libffi/ghc.mk b/libffi/ghc.mk index bc62ad9..4e177d2 100644 --- a/libffi/ghc.mk +++ b/libffi/ghc.mk @@ -69,6 +69,13 @@ $(libffi_STAMP_CONFIGURE): $(TOUCH_DEP) mv libffi/build/Makefile.in libffi/build/Makefile.in.orig sed "s/-MD/-MMD/" < libffi/build/Makefile.in.orig > libffi/build/Makefile.in + # We attempt to specify the installation directory below with --libdir, + # but libffi installs into 'toolexeclibdir' instead, which may differ + # on systems where gcc has multilib support. Force libffi to use libdir. + # (https://sourceware.org/ml/libffi-discuss/2014/msg00016.html) + mv libffi/build/Makefile.in libffi/build/Makefile.in.orig + sed 's:@toolexeclibdir@:$$(libdir):g' < libffi/build/Makefile.in.orig > libffi/build/Makefile.in + # Their cmd invocation only works on msys. On cygwin it starts # a cmd interactive shell. The replacement works in both environments. mv libffi/build/ltmain.sh libffi/build/ltmain.sh.orig From git at git.haskell.org Sun Sep 21 17:15:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Sep 2014 17:15:09 +0000 (UTC) Subject: [commit: ghc] master: Move `mapM` and `sequence` to GHC.Base and break import-cycles (5ed1281) Message-ID: <20140921171509.C81973A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5ed12810e0972b1e0d408fe1355805746c4614f9/ghc >--------------------------------------------------------------- commit 5ed12810e0972b1e0d408fe1355805746c4614f9 Author: Herbert Valerio Riedel Date: Sun Sep 21 19:14:04 2014 +0200 Move `mapM` and `sequence` to GHC.Base and break import-cycles This simplifies the import graph and more importantly removes import cycles that arise due to `Control.Monad` & `Data.List` importing `Data.Traversable` (preparation for #9586) Reviewed By: ekmett, austin Differential Revision: https://phabricator.haskell.org/D234 >--------------------------------------------------------------- 5ed12810e0972b1e0d408fe1355805746c4614f9 libraries/base/Control/Arrow.hs | 3 +-- libraries/base/Control/Monad.hs | 17 +---------------- libraries/base/Control/Monad/Fix.hs | 3 +-- libraries/base/Data/List.hs | 2 ++ libraries/base/Data/Traversable.hs | 17 ++++++++--------- libraries/base/GHC/Base.lhs | 13 +++++++++++++ libraries/base/GHC/Event/Manager.hs | 7 +++++-- libraries/base/GHC/Event/Thread.hs | 11 ++++++----- libraries/base/GHC/Event/TimerManager.hs | 2 +- libraries/base/GHC/ForeignPtr.hs | 2 +- libraries/base/GHC/IO/Handle.hs | 1 - libraries/base/Prelude.hs | 2 +- libraries/base/Text/ParserCombinators/ReadP.hs | 4 ---- testsuite/tests/module/mod176.hs | 4 ++-- 14 files changed, 42 insertions(+), 46 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5ed12810e0972b1e0d408fe1355805746c4614f9 From git at git.haskell.org Sun Sep 21 17:17:06 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Sep 2014 17:17:06 +0000 (UTC) Subject: [commit: ghc] master: Generalise Data.List/Control.Monad to Foldable/Traversable (1f7f46f) Message-ID: <20140921171706.DE0633A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f7f46f94a95ab7fc6f3101da7c02529e1964f24/ghc >--------------------------------------------------------------- commit 1f7f46f94a95ab7fc6f3101da7c02529e1964f24 Author: Herbert Valerio Riedel Date: Sun Sep 21 19:15:46 2014 +0200 Generalise Data.List/Control.Monad to Foldable/Traversable This flips the switch and replaces the entities in `Data.List`/`Control.Monad` conflicting with `Data.{Foldable,Traversable}` with re-exports of the more general versions. As of this commit, the code below (which is also added as a test-case) compiles w/o error. module XPrelude (module X) where import Control.Monad as X import Data.Foldable as X import Data.List as X import Data.Monoid as X import Data.Traversable as X import Prelude as X This addresses #9568 Reviewed By: ekmett, austin Differential Revision: https://phabricator.haskell.org/D235 >--------------------------------------------------------------- 1f7f46f94a95ab7fc6f3101da7c02529e1964f24 libraries/base/Control/Monad.hs | 9 ++------- libraries/base/Data/Foldable.hs | 6 ------ libraries/base/Data/List.hs | 8 ++++---- libraries/base/Data/Traversable.hs | 5 ----- libraries/base/changelog.md | 20 ++++++++++++-------- libraries/base/tests/T9586.hs | 8 ++++++++ libraries/base/tests/all.T | 1 + testsuite/tests/rename/should_compile/T1972.stderr | 2 +- 8 files changed, 28 insertions(+), 31 deletions(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index c04c4a8..561d40d 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -78,9 +78,9 @@ module Control.Monad import Data.Foldable ( sequence_, msum, mapM_, forM_ ) import Data.Functor ( void ) -import Data.Traversable () +import Data.Traversable ( forM, mapM, sequence ) -import GHC.Base +import GHC.Base hiding ( mapM, sequence ) import GHC.List ( zipWith, unzip, replicate ) -- ----------------------------------------------------------------------------- @@ -101,11 +101,6 @@ filterM p (x:xs) = do ys <- filterM p xs return (if flg then x:ys else ys) --- | 'forM' is 'mapM' with its arguments flipped -forM :: Monad m => [a] -> (a -> m b) -> m [b] -{-# INLINE forM #-} -forM = flip mapM - infixr 1 <=<, >=> -- | Left-to-right Kleisli composition of monads. diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index 726aa6c..2bda827 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -13,12 +13,6 @@ -- -- Class of data structures that can be folded to a summary value. -- --- Many of these functions generalize "Prelude", "Control.Monad" and --- "Data.List" functions of the same names from lists to any 'Foldable' --- functor. To avoid ambiguity, either import those modules hiding --- these names or qualify uses of these function names with an alias --- for this module. --- ----------------------------------------------------------------------------- module Data.Foldable ( diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs index e742cac..795baec 100644 --- a/libraries/base/Data/List.hs +++ b/libraries/base/Data/List.hs @@ -208,9 +208,9 @@ module Data.List ) where import Data.Foldable -import Data.Traversable () +import Data.Traversable import Data.OldList hiding ( all, and, any, concat, concatMap, elem, find, - foldl, foldl1, foldl', foldr, foldr1, maximum, - maximumBy, minimum, minimumBy, notElem, or, - product, sum ) + foldl, foldl1, foldl', foldr, foldr1, mapAccumL, + mapAccumR, maximum, maximumBy, minimum, minimumBy, + notElem, or, product, sum ) diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index d050aea..eb5123d 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -31,11 +31,6 @@ -- in /Mathematically-Structured Functional Programming/, 2012, online at -- . -- --- Note that the functions 'mapM' and 'sequence' generalize "Prelude" --- functions of the same names from lists to any 'Traversable' functor. --- To avoid ambiguity, either import the "Prelude" hiding these names --- or qualify uses of these function names with an alias for this module. --- ----------------------------------------------------------------------------- module Data.Traversable ( diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index d7e1133..0d95898 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -38,22 +38,26 @@ * Replace the `Data.List`-exported functions ``` - all, and, any, concat, concatMap, elem, find, product, sum + all, and, any, concat, concatMap, elem, find, product, sum, + mapAccumL, mapAccumR ``` - by re-exports of their generalised `Data.Foldable` counterparts. - In other words, unqualified imports of `Data.List` and - `Data.Foldable` no longer lead to conflicting definitions. (#9586) + by re-exports of their generalised `Data.Foldable`/`Data.Traversable` + counterparts. In other words, unqualified imports of `Data.List` + and `Data.Foldable`/`Data.Traversable` no longer lead to conflicting + definitions. (#9586) * Replace the `Control.Monad`-exported functions ``` - sequence_, msum, mapM_, forM_ + sequence_, msum, mapM_, forM_, + forM, mapM, sequence ``` - by re-exports of their generalised `Data.Foldable` counterparts. - In other words, unqualified imports of `Control.Monad` and - `Data.Foldable` no longer lead to conflicting definitions. (#9586) + by re-exports of their generalised `Data.Foldable`/`Data.Traversable` + counterparts. In other words, unqualified imports of `Control.Monad` + and `Data.Foldable`/`Data.Traversable` no longer lead to conflicting + definitions. (#9586) * New module `Data.OldList` containing only list-specialised versions of the functions from `Data.List` (in other words, `Data.OldList` corresponds diff --git a/libraries/base/tests/T9586.hs b/libraries/base/tests/T9586.hs new file mode 100644 index 0000000..8310b99 --- /dev/null +++ b/libraries/base/tests/T9586.hs @@ -0,0 +1,8 @@ +module XPrelude (module X) where + +import Control.Monad as X +import Data.Foldable as X +import Data.List as X +import Data.Monoid as X +import Data.Traversable as X +import Prelude as X diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 5fe862f..6520b21 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -170,3 +170,4 @@ test('T8766', test('T9111', normal, compile, ['']) test('T9395', normal, compile_and_run, ['']) test('T9532', normal, compile_and_run, ['']) +test('T9586', normal, compile, ['']) diff --git a/testsuite/tests/rename/should_compile/T1972.stderr b/testsuite/tests/rename/should_compile/T1972.stderr index 38f013e..0f450fc 100644 --- a/testsuite/tests/rename/should_compile/T1972.stderr +++ b/testsuite/tests/rename/should_compile/T1972.stderr @@ -7,6 +7,6 @@ T1972.hs:14:3: Warning: This binding for ?mapAccumL? shadows the existing bindings defined at T1972.hs:16:1 imported from ?Data.List? at T1972.hs:7:1-16 - (and originally defined in ?Data.OldList?) + (and originally defined in ?Data.Traversable?) T1972.hs:20:10: Warning: Defined but not used: ?c? From git at git.haskell.org Sun Sep 21 21:29:04 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Sep 2014 21:29:04 +0000 (UTC) Subject: [commit: ghc] master: Export `Monoid(..)`/`Foldable(..)`/`Traversable(..)` from Prelude (b8f5839) Message-ID: <20140921212904.1A2683A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b8f583928fa6cb5371a872fc73080d2002dd87d9/ghc >--------------------------------------------------------------- commit b8f583928fa6cb5371a872fc73080d2002dd87d9 Author: Herbert Valerio Riedel Date: Sun Sep 21 23:22:19 2014 +0200 Export `Monoid(..)`/`Foldable(..)`/`Traversable(..)` from Prelude This finally exposes also the methods of these 3 classes in the Prelude in order to allow to define basic class instances w/o needing imports. This almost completes the primary goal of #9586 NOTE: `fold`, `foldl'`, `foldr'`, and `toList` are not exposed yet, as they require upstream fixes for at least `containers` and `bytestring`, and are not required for defining basic instances. Reviewed By: ekmett, austin Differential Revision: https://phabricator.haskell.org/D236 >--------------------------------------------------------------- b8f583928fa6cb5371a872fc73080d2002dd87d9 compiler/deSugar/MatchLit.lhs | 2 ++ compiler/ghci/RtClosureInspect.hs | 2 ++ compiler/hsSyn/HsBinds.lhs | 2 +- compiler/iface/TcIface.lhs | 2 ++ compiler/main/Packages.lhs | 2 ++ compiler/rename/RnBinds.lhs | 3 ++ compiler/rename/RnSource.lhs | 2 ++ compiler/typecheck/TcEvidence.lhs | 2 ++ compiler/typecheck/TcHsSyn.lhs | 2 ++ compiler/typecheck/TcPatSyn.lhs | 2 ++ compiler/types/Coercion.lhs | 2 ++ compiler/utils/Pair.lhs | 4 ++- compiler/utils/UniqFM.lhs | 7 ++++- libraries/base/Prelude.hs | 36 +++++++++++++++------- libraries/base/changelog.md | 7 +++++ mk/validate-settings.mk | 9 ++++++ testsuite/tests/ghci.debugger/mdo.hs | 1 + .../tests/ghci.debugger/scripts/break018.stdout | 8 ++--- .../tests/ghci.debugger/scripts/dynbrk004.stdout | 2 +- testsuite/tests/ghci/scripts/T4175.stdout | 2 ++ testsuite/tests/ghci/scripts/T7627.stdout | 6 ++-- testsuite/tests/ghci/scripts/ghci011.stdout | 7 +++-- testsuite/tests/ghci/scripts/ghci020.stdout | 1 + testsuite/tests/mdo/should_run/mdorun002.hs | 1 + testsuite/tests/quasiquotation/T7918.hs | 1 + .../tests/typecheck/should_compile/DfltProb1.hs | 1 + utils/hpc/HpcMarkup.hs | 1 - utils/runghc/runghc.hs | 1 - 28 files changed, 93 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 b8f583928fa6cb5371a872fc73080d2002dd87d9 From git at git.haskell.org Mon Sep 22 08:44:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Sep 2014 08:44:05 +0000 (UTC) Subject: [commit: ghc] master: Fix windows breakage from 5ed12810e0972b1e due to import cycles (27b937e) Message-ID: <20140922084405.90AD23A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/27b937e5012c902a513dbc3b6ae24bf490ce656e/ghc >--------------------------------------------------------------- commit 27b937e5012c902a513dbc3b6ae24bf490ce656e Author: Herbert Valerio Riedel Date: Mon Sep 22 10:42:09 2014 +0200 Fix windows breakage from 5ed12810e0972b1e due to import cycles Refs #9586 >--------------------------------------------------------------- 27b937e5012c902a513dbc3b6ae24bf490ce656e libraries/base/GHC/Conc/Windows.hs | 5 ++--- libraries/base/GHC/IO/Encoding/CodePage.hs | 2 +- libraries/base/GHC/IO/Encoding/CodePage/API.hs | 3 +-- libraries/base/GHC/Windows.hs | 2 +- 4 files changed, 5 insertions(+), 7 deletions(-) diff --git a/libraries/base/GHC/Conc/Windows.hs b/libraries/base/GHC/Conc/Windows.hs index aef7fbf..a957182 100644 --- a/libraries/base/GHC/Conc/Windows.hs +++ b/libraries/base/GHC/Conc/Windows.hs @@ -38,7 +38,6 @@ module GHC.Conc.Windows , toWin32ConsoleEvent ) where -import Control.Monad (unless) import Data.Bits (shiftR) import Data.Typeable import GHC.Base @@ -225,7 +224,7 @@ prodServiceThread = do -- conditions in which prodding is left at True but the server is -- blocked in select(). was_set <- atomicModifyIORef prodding $ \b -> (True,b) - unless was_set wakeupIOManager + when (not was_set) wakeupIOManager -- ---------------------------------------------------------------------------- -- Windows IO manager thread @@ -258,7 +257,7 @@ service_loop wakeup old_delays = do _ | r2 == io_MANAGER_DIE -> return True 0 -> return False -- spurious wakeup _ -> do start_console_handler (r2 `shiftR` 1); return False - unless exit $ service_cont wakeup delays' + when (not exit) $ service_cont wakeup delays' _other -> service_cont wakeup delays' -- probably timeout diff --git a/libraries/base/GHC/IO/Encoding/CodePage.hs b/libraries/base/GHC/IO/Encoding/CodePage.hs index 6a8ee1a..aea4314 100644 --- a/libraries/base/GHC/IO/Encoding/CodePage.hs +++ b/libraries/base/GHC/IO/Encoding/CodePage.hs @@ -23,7 +23,7 @@ import GHC.IO.Encoding.Types import GHC.IO.Buffer import Data.Bits import Data.Maybe -import Data.List (lookup) +import Data.OldList (lookup) import qualified GHC.IO.Encoding.CodePage.API as API import GHC.IO.Encoding.CodePage.Table diff --git a/libraries/base/GHC/IO/Encoding/CodePage/API.hs b/libraries/base/GHC/IO/Encoding/CodePage/API.hs index 570ea80..8b6472b 100644 --- a/libraries/base/GHC/IO/Encoding/CodePage/API.hs +++ b/libraries/base/GHC/IO/Encoding/CodePage/API.hs @@ -8,7 +8,6 @@ import Foreign.C import Foreign.Ptr import Foreign.Marshal import Foreign.Storable -import Control.Monad import Data.Bits import Data.Either import Data.Word @@ -136,7 +135,7 @@ newCP rec fn cp = do -- Fail early if the code page doesn't exist, to match the behaviour of the IConv TextEncoding max_char_size <- alloca $ \cpinfo_ptr -> do success <- c_GetCPInfo cp cpinfo_ptr - unless success $ throwGetLastError ("GetCPInfo " ++ show cp) + when (not success) $ throwGetLastError ("GetCPInfo " ++ show cp) fmap (fromIntegral . maxCharSize) $ peek cpinfo_ptr debugIO $ "GetCPInfo " ++ show cp ++ " = " ++ show max_char_size diff --git a/libraries/base/GHC/Windows.hs b/libraries/base/GHC/Windows.hs index 940ba58..71ebcf7 100644 --- a/libraries/base/GHC/Windows.hs +++ b/libraries/base/GHC/Windows.hs @@ -58,7 +58,7 @@ module GHC.Windows ( ) where import Data.Char -import Data.List +import Data.OldList import Data.Maybe import Data.Word import Foreign.C.Error From git at git.haskell.org Tue Sep 23 06:40:09 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Sep 2014 06:40:09 +0000 (UTC) Subject: [commit: packages/haskeline] master: Use explicit forall syntax to avoid warning (fe08e89) Message-ID: <20140923064009.BB7673A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/fe08e896cfb67b0f24b07194f5b95f23b70dce32 >--------------------------------------------------------------- commit fe08e896cfb67b0f24b07194f5b95f23b70dce32 Author: Herbert Valerio Riedel Date: Mon Sep 22 23:24:51 2014 +0200 Use explicit forall syntax to avoid warning This is currently just a warning in GHC HEAD, but ought to be fixed nevertheless: Variable ?m? is implicitly quantified due to a context Use explicit forall syntax instead. This will become an error in GHC 7.12. >--------------------------------------------------------------- fe08e896cfb67b0f24b07194f5b95f23b70dce32 System/Console/Haskeline/Backend/Win32.hsc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/System/Console/Haskeline/Backend/Win32.hsc b/System/Console/Haskeline/Backend/Win32.hsc index 8dd626f..d0a594f 100644 --- a/System/Console/Haskeline/Backend/Win32.hsc +++ b/System/Console/Haskeline/Backend/Win32.hsc @@ -262,7 +262,7 @@ closeHandles hs = closeHandle (hIn hs) >> closeHandle (hOut hs) newtype Draw m a = Draw {runDraw :: ReaderT Handles m a} deriving (Functor, Applicative, Monad, MonadIO, MonadException, MonadReader Handles) -type DrawM a = (MonadIO m, MonadReader Layout m) => Draw m a +type DrawM a = forall m . (MonadIO m, MonadReader Layout m) => Draw m a instance MonadTrans Draw where lift = Draw . lift From git at git.haskell.org Tue Sep 23 06:40:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Sep 2014 06:40:11 +0000 (UTC) Subject: [commit: packages/haskeline] master: Merge pull request #11 from hvr/pr-forall (bf1a30f) Message-ID: <20140923064011.C03133A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/bf1a30ff7e25406359db9b0146a104248d058008 >--------------------------------------------------------------- commit bf1a30ff7e25406359db9b0146a104248d058008 Merge: 9295332 fe08e89 Author: Judah Jacobson Date: Mon Sep 22 17:36:52 2014 -0700 Merge pull request #11 from hvr/pr-forall Use explicit forall syntax to avoid warning >--------------------------------------------------------------- bf1a30ff7e25406359db9b0146a104248d058008 System/Console/Haskeline/Backend/Win32.hsc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) From git at git.haskell.org Tue Sep 23 06:44:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Sep 2014 06:44:49 +0000 (UTC) Subject: [commit: ghc] master: Update haskeline submodule to avoid -Werror failure (38cb5ec) Message-ID: <20140923064449.08A0C3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/38cb5ec13ea7757edf99cda1de9303177b448b88/ghc >--------------------------------------------------------------- commit 38cb5ec13ea7757edf99cda1de9303177b448b88 Author: Herbert Valerio Riedel Date: Tue Sep 23 08:42:55 2014 +0200 Update haskeline submodule to avoid -Werror failure This would occur only on Windows during `./validate` >--------------------------------------------------------------- 38cb5ec13ea7757edf99cda1de9303177b448b88 libraries/haskeline | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/haskeline b/libraries/haskeline index 4a26c23..bf1a30f 160000 --- a/libraries/haskeline +++ b/libraries/haskeline @@ -1 +1 @@ -Subproject commit 4a26c23c49583142648b4e60ad2fd450a70731e2 +Subproject commit bf1a30ff7e25406359db9b0146a104248d058008 From git at git.haskell.org Tue Sep 23 10:26:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Sep 2014 10:26:35 +0000 (UTC) Subject: [commit: ghc] master: Ensure that loop breakers are computed when glomming (5fa6e75) Message-ID: <20140923102635.76CB43A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5fa6e75960b3dddbc72c35eb3fc0f2759215dfbb/ghc >--------------------------------------------------------------- commit 5fa6e75960b3dddbc72c35eb3fc0f2759215dfbb Author: Simon Peyton Jones Date: Fri Sep 19 14:51:54 2014 +0100 Ensure that loop breakers are computed when glomming This patch fixes Trac #9583, a loop in the simplifier. I thought this was going to be very complicated but it turned out to be very simple! The occurrence analyser does something called "glomming" if the application of imported RULES means that something that didn't look recursive becomes recursive. See `Note [Glomming]` in `OccurAnal`. Under these circumstances we group all the top-level bindings into a single massive `Rec`. But, crucially, I failed to repeat the occurrence analysis on this glommed set of bindings. That means that we weren't establishing the right loop breakers (indeed there were no loop breakers whatsoever), and that led immediately to the loop. The only surprising this is that it didn't happen before. >--------------------------------------------------------------- 5fa6e75960b3dddbc72c35eb3fc0f2759215dfbb compiler/simplCore/OccurAnal.lhs | 34 ++++++++++++++++++++++++++-------- 1 file changed, 26 insertions(+), 8 deletions(-) diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs index ca0fc22..3477073 100644 --- a/compiler/simplCore/OccurAnal.lhs +++ b/compiler/simplCore/OccurAnal.lhs @@ -59,13 +59,21 @@ occurAnalysePgm :: Module -- Used only in debug output -> CoreProgram -> CoreProgram occurAnalysePgm this_mod active_rule imp_rules vects vectVars binds | isEmptyVarEnv final_usage - = binds' + = occ_anald_binds + | otherwise -- See Note [Glomming] = WARN( True, hang (text "Glomming in" <+> ppr this_mod <> colon) 2 (ppr final_usage ) ) - [Rec (flattenBinds binds')] + occ_anald_glommed_binds where - (final_usage, binds') = go (initOccEnv active_rule) binds + init_env = initOccEnv active_rule + (final_usage, occ_anald_binds) = go init_env binds + (_, occ_anald_glommed_binds) = occAnalRecBind init_env imp_rules_edges + (flattenBinds occ_anald_binds) + initial_uds + -- It's crucial to re-analyse the glommed-together bindings + -- so that we establish the right loop breakers. Otherwise + -- we can easily create an infinite loop (Trac #9583 is an example) initial_uds = addIdOccs emptyDetails (rulesFreeVars imp_rules `unionVarSet` @@ -90,7 +98,7 @@ occurAnalysePgm this_mod active_rule imp_rules vects vectVars binds = (final_usage, bind' ++ binds') where (bs_usage, binds') = go env binds - (final_usage, bind') = occAnalBind env env imp_rules_edges bind bs_usage + (final_usage, bind') = occAnalBind env imp_rules_edges bind bs_usage occurAnalyseExpr :: CoreExpr -> CoreExpr -- Do occurrence analysis, and discard occurrence info returned @@ -120,14 +128,21 @@ Bindings \begin{code} occAnalBind :: OccEnv -- The incoming OccEnv - -> OccEnv -- Same, but trimmed by (binderOf bind) -> IdEnv IdSet -- Mapping from FVs of imported RULE LHSs to RHS FVs -> CoreBind -> UsageDetails -- Usage details of scope -> (UsageDetails, -- Of the whole let(rec) [CoreBind]) -occAnalBind env _ imp_rules_edges (NonRec binder rhs) body_usage +occAnalBind env imp_rules_edges (NonRec binder rhs) body_usage + = occAnalNonRecBind env imp_rules_edges binder rhs body_usage +occAnalBind env imp_rules_edges (Rec pairs) body_usage + = occAnalRecBind env imp_rules_edges pairs body_usage + +----------------- +occAnalNonRecBind :: OccEnv -> IdEnv IdSet -> Var -> CoreExpr + -> UsageDetails -> (UsageDetails, [CoreBind]) +occAnalNonRecBind env imp_rules_edges binder rhs body_usage | isTyVar binder -- A type let; we don't gather usage info = (body_usage, [NonRec binder rhs]) @@ -145,7 +160,10 @@ occAnalBind env _ imp_rules_edges (NonRec binder rhs) body_usage rhs_usage4 = maybe rhs_usage3 (addIdOccs rhs_usage3) $ lookupVarEnv imp_rules_edges binder -- See Note [Preventing loops due to imported functions rules] -occAnalBind _ env imp_rules_edges (Rec pairs) body_usage +----------------- +occAnalRecBind :: OccEnv -> IdEnv IdSet -> [(Var,CoreExpr)] + -> UsageDetails -> (UsageDetails, [CoreBind]) +occAnalRecBind env imp_rules_edges pairs body_usage = foldr occAnalRec (body_usage, []) sccs -- For a recursive group, we -- * occ-analyse all the RHSs @@ -1264,7 +1282,7 @@ occAnal env (Case scrut bndr ty alts) occAnal env (Let bind body) = case occAnal env body of { (body_usage, body') -> - case occAnalBind env env emptyVarEnv bind body_usage of { (final_usage, new_binds) -> + case occAnalBind env emptyVarEnv bind body_usage of { (final_usage, new_binds) -> (final_usage, mkLets new_binds body') }} occAnalArgs :: OccEnv -> [CoreExpr] -> [OneShots] -> (UsageDetails, [CoreExpr]) From git at git.haskell.org Tue Sep 23 11:09:18 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Sep 2014 11:09:18 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #9565 and #9583 (01906c7) Message-ID: <20140923110918.279883A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/01906c7399301e4f69959ecbd3b0d8bee5d5ef70/ghc >--------------------------------------------------------------- commit 01906c7399301e4f69959ecbd3b0d8bee5d5ef70 Author: Simon Peyton Jones Date: Tue Sep 23 12:09:07 2014 +0100 Test Trac #9565 and #9583 >--------------------------------------------------------------- 01906c7399301e4f69959ecbd3b0d8bee5d5ef70 .../T3500b.hs => simplCore/should_compile/T9565.hs} | 7 +++++-- testsuite/tests/simplCore/should_compile/T9583.hs | 19 +++++++++++++++++++ testsuite/tests/simplCore/should_compile/all.T | 2 ++ 3 files changed, 26 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/typecheck/should_run/T3500b.hs b/testsuite/tests/simplCore/should_compile/T9565.hs similarity index 58% copy from testsuite/tests/typecheck/should_run/T3500b.hs copy to testsuite/tests/simplCore/should_compile/T9565.hs index 59a2c47..1dacb97 100644 --- a/testsuite/tests/typecheck/should_run/T3500b.hs +++ b/testsuite/tests/simplCore/should_compile/T9565.hs @@ -1,6 +1,10 @@ {-# LANGUAGE TypeFamilies, FlexibleContexts, UndecidableInstances #-} -module Main where +-- This is a copy of typecheck/should_run/T3500b, but it's here for +-- a different reason: at one time, it sent the compiler into a loop. +-- ANd T3500b isn't tested 'fast' mode + +module T9565 where newtype Mu f = Mu (f (Mu f)) @@ -10,7 +14,6 @@ type instance Id m = m instance Show (Id (f (Mu f))) => Show (Mu f) where show (Mu f) = show f - showMu :: Mu (Either ()) -> String showMu = show diff --git a/testsuite/tests/simplCore/should_compile/T9583.hs b/testsuite/tests/simplCore/should_compile/T9583.hs new file mode 100644 index 0000000..a77fcdd --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9583.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# OPTIONS_GHC -O #-} + +module T9583 where + +import Data.Binary ( Binary(..) ) +import Data.Data ( Data ) +import Data.Typeable ( Typeable ) +import GHC.Generics ( Generic ) + +data T = A + | B + | C T + | D T T + | E T T + deriving (Data, Generic, Typeable) + +instance Binary T diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 399498b..bbdadbf 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -207,3 +207,5 @@ test('T8848a', only_ways(['optasm']), compile, ['-ddump-rules']) test('T8331', only_ways(['optasm']), compile, ['-ddump-rules']) test('T6056', only_ways(['optasm']), multimod_compile, ['T6056', '-v0 -ddump-rule-firings']) test('T9400', only_ways(['optasm']), compile, ['-O0 -ddump-simpl -dsuppress-uniques']) +test('T9583', only_ways(['optasm']), compile, ['']) +test('T9565', only_ways(['optasm']), compile, ['']) From git at git.haskell.org Tue Sep 23 13:45:38 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Sep 2014 13:45:38 +0000 (UTC) Subject: [commit: ghc] master: Delete hack when takeDirectory returns "" (2a743bb) Message-ID: <20140923134538.2A61F3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2a743bbddd4de41a77af9b83ec4720cd013292cf/ghc >--------------------------------------------------------------- commit 2a743bbddd4de41a77af9b83ec4720cd013292cf Author: Thomas Miedema Date: Tue Sep 23 08:44:02 2014 -0500 Delete hack when takeDirectory returns "" Summary: Since commits 8fe1f8 and bb6731 in the filepath packages (ticket #2034, closed in 2010), takeDirectory "foo" returns ".", and not "", so this check is no longer needed. Other commits: * Remove trailing whitespace * Update comments for #2278 Test Plan: harbormaster Reviewers: austin Reviewed By: austin Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D213 GHC Trac Issues: #2034 >--------------------------------------------------------------- 2a743bbddd4de41a77af9b83ec4720cd013292cf compiler/utils/Util.lhs | 4 +--- ghc/Main.hs | 6 +++--- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 97bafe6..999eb90 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -950,9 +950,7 @@ maybeReadFuzzy str = case reads str of -- Verify that the 'dirname' portion of a FilePath exists. -- doesDirNameExist :: FilePath -> IO Bool -doesDirNameExist fpath = case takeDirectory fpath of - "" -> return True -- XXX Hack - _ -> doesDirectoryExist (takeDirectory fpath) +doesDirNameExist fpath = doesDirectoryExist (takeDirectory fpath) ----------------------------------------------------------------------------- -- Backwards compatibility definition of getModificationTime diff --git a/ghc/Main.hs b/ghc/Main.hs index e6ff043..c1ee247 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -345,16 +345,16 @@ checkOptions mode dflags srcs objs = do -- Compiler output options --- called to verify that the output files & directories --- point somewhere valid. +-- Called to verify that the output files point somewhere valid. -- -- The assumption is that the directory portion of these output -- options will have to exist by the time 'verifyOutputFiles' -- is invoked. -- +-- We create the directories for -odir, -hidir, -outputdir etc. ourselves if +-- they don't exist, so don't check for those here (#2278). verifyOutputFiles :: DynFlags -> IO () verifyOutputFiles dflags = do - -- not -odir: we create the directory for -odir if it doesn't exist (#2278). let ofile = outputFile dflags when (isJust ofile) $ do let fn = fromJust ofile From git at git.haskell.org Tue Sep 23 13:45:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Sep 2014 13:45:40 +0000 (UTC) Subject: [commit: ghc] master: Delete all /* ! __GLASGOW_HASKELL__ */ code (330bb3e) Message-ID: <20140923134540.B90303A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/330bb3ef856166d18d959b377f12a51c2629b223/ghc >--------------------------------------------------------------- commit 330bb3ef856166d18d959b377f12a51c2629b223 Author: Thomas Miedema Date: Tue Sep 23 08:44:45 2014 -0500 Delete all /* ! __GLASGOW_HASKELL__ */ code Summary: ``` git grep -l '\(#ifdef \|#if defined\)(\?__GLASGOW_HASKELL__)\?' ``` Test Plan: validate Reviewers: rwbarton, hvr, austin Reviewed By: rwbarton, hvr, austin Subscribers: rwbarton, simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D218 >--------------------------------------------------------------- 330bb3ef856166d18d959b377f12a51c2629b223 compiler/HsVersions.h | 4 -- compiler/basicTypes/Unique.lhs | 12 +--- compiler/utils/Binary.hs | 5 -- compiler/utils/FastBool.lhs | 17 ------ compiler/utils/FastFunctions.lhs | 25 -------- compiler/utils/FastMutInt.lhs | 46 --------------- compiler/utils/FastString.lhs | 8 --- compiler/utils/FastTypes.lhs | 74 ------------------------ compiler/utils/Pretty.lhs | 4 -- compiler/utils/Util.lhs | 2 - libraries/base/cbits/PrelIOUtils.c | 9 +-- testsuite/tests/programs/andy_cherry/GenUtils.hs | 42 ++++++-------- 12 files changed, 20 insertions(+), 228 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 330bb3ef856166d18d959b377f12a51c2629b223 From git at git.haskell.org Tue Sep 23 13:45:43 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Sep 2014 13:45:43 +0000 (UTC) Subject: [commit: ghc] master: Change all hashbangs to /usr/bin/env (#9057) (d5e4874) Message-ID: <20140923134543.507AC3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d5e4874833054f1789289c433be292ae3e9bd7d0/ghc >--------------------------------------------------------------- commit d5e4874833054f1789289c433be292ae3e9bd7d0 Author: Thomas Miedema Date: Tue Sep 23 08:45:31 2014 -0500 Change all hashbangs to /usr/bin/env (#9057) Summary: ``` git grep -l '#!' | xargs sed -i 's|#!.*/bin/\([^ ]*\)$|#!/usr/bin/env \1|' ``` and some manual tweaking Test Plan: harbormaster Reviewers: austin Subscribers: hvr, simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D237 GHC Trac Issues: #9057 >--------------------------------------------------------------- d5e4874833054f1789289c433be292ae3e9bd7d0 compiler/count_bytes | 2 +- distrib/cross-port | 2 +- testsuite/tests/rename/prog006/Setup.lhs | 2 +- utils/count_lines/count_lines.lprl | 2 +- utils/runghc/runghc.hs | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/count_bytes b/compiler/count_bytes index bf62402..4b8aa37 100644 --- a/compiler/count_bytes +++ b/compiler/count_bytes @@ -1,4 +1,4 @@ -#! /usr/local/bin/perl +#!/usr/bin/env perl # %DirCount = (); %ModCount = (); diff --git a/distrib/cross-port b/distrib/cross-port index 690e60b..7c54604 100644 --- a/distrib/cross-port +++ b/distrib/cross-port @@ -1,4 +1,4 @@ -#! /bin/bash +#!/usr/bin/env bash # This script can be used to generate some unregisterised .hc files # for bootstrapping GHC on a new/unsupported platform. It involves a diff --git a/testsuite/tests/rename/prog006/Setup.lhs b/testsuite/tests/rename/prog006/Setup.lhs index b28a823..a81e9d2 100644 --- a/testsuite/tests/rename/prog006/Setup.lhs +++ b/testsuite/tests/rename/prog006/Setup.lhs @@ -1,4 +1,4 @@ -#!/usr/bin/runhaskell +#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () diff --git a/utils/count_lines/count_lines.lprl b/utils/count_lines/count_lines.lprl index 72b4413..49b11ee 100644 --- a/utils/count_lines/count_lines.lprl +++ b/utils/count_lines/count_lines.lprl @@ -1,4 +1,4 @@ -#! /usr/bin/perl +#!/usr/bin/env perl \begin{code} diff --git a/utils/runghc/runghc.hs b/utils/runghc/runghc.hs index e94c550..42ddb83 100644 --- a/utils/runghc/runghc.hs +++ b/utils/runghc/runghc.hs @@ -7,7 +7,7 @@ -- runghc program, for invoking from a #! line in a script. For example: -- -- script.lhs: --- #!/usr/bin/env /usr/bin/runghc +-- #!/usr/bin/env runghc -- > main = putStrLn "hello!" -- -- runghc accepts one flag: From git at git.haskell.org Wed Sep 24 10:15:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Sep 2014 10:15:39 +0000 (UTC) Subject: [commit: nofib] master: Adapt `nofib` code to Foldable-generalised Prelude (5c9562c) Message-ID: <20140924101539.4015E3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5c9562cfb48431c73d81be613d594a345e7ef73c/nofib >--------------------------------------------------------------- commit 5c9562cfb48431c73d81be613d594a345e7ef73c Author: Herbert Valerio Riedel Date: Tue Sep 23 23:41:37 2014 +0200 Adapt `nofib` code to Foldable-generalised Prelude >--------------------------------------------------------------- 5c9562cfb48431c73d81be613d594a345e7ef73c real/anna/AbstractVals2.hs | 8 ++++---- real/veritas/DerivedRules.hs | 1 + shootout/spectral-norm/Main.hs | 3 ++- 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/real/anna/AbstractVals2.hs b/real/anna/AbstractVals2.hs index 811f214..c223d5f 100644 --- a/real/anna/AbstractVals2.hs +++ b/real/anna/AbstractVals2.hs @@ -466,9 +466,9 @@ avMaxAddPtR x ys | x `avBelowMax0R` ys = ys | otherwise = x:[y | y <- ys, not (y << x)] -avMinR = foldr avMinAddPtR [] +avMinR = foldr avMinAddPtR [] :: [Route] -> [Route] -avMaxR = foldr avMaxAddPtR [] +avMaxR = foldr avMaxAddPtR [] :: [Route] -> [Route] -- ==========================================================-- @@ -489,9 +489,9 @@ avMaxAddPtrep x ys | x `avBelowMax0rep` ys = ys | otherwise = x:[y | y <- ys, not (y `avBelowEQrep` x)] -avMinrep = foldr avMinAddPtrep [] +avMinrep = foldr avMinAddPtrep [] :: [Rep] -> [Rep] -avMaxrep = foldr avMaxAddPtrep [] +avMaxrep = foldr avMaxAddPtrep [] :: [Rep] -> [Rep] -- ==========================================================-- diff --git a/real/veritas/DerivedRules.hs b/real/veritas/DerivedRules.hs index e4c299b..e07b27e 100644 --- a/real/veritas/DerivedRules.hs +++ b/real/veritas/DerivedRules.hs @@ -152,5 +152,6 @@ find_betas do_beta_red _ (App (Binder Lambda dc tm1 _ _) tm2 _ _) = subst_trm dc tm1 tm2 +rep_beta :: Thm -> [[Int]] -> Thm rep_beta = foldl beta_rw diff --git a/shootout/spectral-norm/Main.hs b/shootout/spectral-norm/Main.hs index ed6c022..1fae229 100644 --- a/shootout/spectral-norm/Main.hs +++ b/shootout/spectral-norm/Main.hs @@ -20,7 +20,8 @@ import Foreign import Text.Printf import Control.Concurrent import Control.Monad -import GHC.Base +import GHC.Base (Int(..), Double(..), (+#), (*#), (/##), + quotInt, uncheckedIShiftRA#, int2Double#) import GHC.Conc type Reals = Ptr Double From git at git.haskell.org Wed Sep 24 10:15:54 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Sep 2014 10:15:54 +0000 (UTC) Subject: [commit: ghc] master: Adapt nofib submodule to #9586 changes (165072b) Message-ID: <20140924101554.667823A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/165072b334ebb2ccbef38a963ac4d126f1e08c96/ghc >--------------------------------------------------------------- commit 165072b334ebb2ccbef38a963ac4d126f1e08c96 Author: Herbert Valerio Riedel Date: Tue Sep 23 23:46:11 2014 +0200 Adapt nofib submodule to #9586 changes >--------------------------------------------------------------- 165072b334ebb2ccbef38a963ac4d126f1e08c96 nofib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nofib b/nofib index 487ff1a..5c9562c 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit 487ff1a205ad4314b10c9bf486e84086ef39d419 +Subproject commit 5c9562cfb48431c73d81be613d594a345e7ef73c From git at git.haskell.org Wed Sep 24 21:19:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Sep 2014 21:19:40 +0000 (UTC) Subject: [commit: ghc] master: Update Cabal submodule & ghc-pkg to use new module re-export types (4b648be) Message-ID: <20140924211940.98C843A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4b648be19c75e6c6a8e6f9f93fa12c7a4176f0ae/ghc >--------------------------------------------------------------- commit 4b648be19c75e6c6a8e6f9f93fa12c7a4176f0ae Author: Edward Z. Yang Date: Tue Sep 23 16:05:25 2014 +0200 Update Cabal submodule & ghc-pkg to use new module re-export types Summary: The main change is that Cabal changed the representation of module re-exports to distinguish reexports in source .cabal files versus re-exports in installed package registraion files. Cabal now also does the resolution of re-exports to specific installed packages itself, so ghc-pkg no longer has to do this. This is a cleaner design overall because re-export resolution can fail so it is better to do it during package configuration rather than package registration. It also simplifies the re-export representation that ghc-pkg has to use. Add extra ghc-pkg sanity check for module re-exports and duplicates For re-exports, check that the defining package exists and that it exposes the defining module (or for self-rexport exposed or hidden modules). Also check that the defining package is actually a direct or indirect dependency of the package doing the re-exporting. Also add a check for duplicate modules in a package, including re-exported modules. Test Plan: So far the sanity checks are totally untested. Should add some test case to make sure the sanity checks do catch things correctly, and don't ban legal things. Reviewers: austin, duncan Subscribers: angerman, simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D183 GHC Trac Issues: >--------------------------------------------------------------- 4b648be19c75e6c6a8e6f9f93fa12c7a4176f0ae compiler/main/Packages.lhs | 6 +- ghc.mk | 4 +- libraries/Cabal | 2 +- testsuite/tests/cabal/ghcpkg07.stdout | 14 +- testsuite/tests/cabal/test7a.pkg | 3 +- testsuite/tests/cabal/test7b.pkg | 5 +- testsuite/tests/perf/haddock/all.T | 3 +- utils/ghc-cabal/Main.hs | 2 +- utils/ghc-cabal/ghc.mk | 1 + utils/ghc-pkg/Main.hs | 279 +++++++++------------------------- 10 files changed, 99 insertions(+), 220 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 4b648be19c75e6c6a8e6f9f93fa12c7a4176f0ae From git at git.haskell.org Wed Sep 24 21:44:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Sep 2014 21:44:27 +0000 (UTC) Subject: [commit: ghc] master: `M-x delete-trailing-whitespace` & `M-x untabify` (805ee11) Message-ID: <20140924214427.1915D3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/805ee118b823f271dfd8036d35b15eb3454a95ad/ghc >--------------------------------------------------------------- commit 805ee118b823f271dfd8036d35b15eb3454a95ad Author: Herbert Valerio Riedel Date: Wed Sep 24 23:42:55 2014 +0200 `M-x delete-trailing-whitespace` & `M-x untabify` ...several modules in `base` recently touched by me >--------------------------------------------------------------- 805ee118b823f271dfd8036d35b15eb3454a95ad libraries/base/Control/Exception/Base.hs | 2 +- libraries/base/Control/Monad.hs | 0 libraries/base/Control/Monad/Fix.hs | 0 libraries/base/Data/Data.hs | 0 libraries/base/Data/Foldable.hs | 0 libraries/base/Data/Functor.hs | 0 libraries/base/Data/Maybe.hs | 0 libraries/base/Data/OldTypeable/Internal.hs | 0 libraries/base/Data/Typeable/Internal.hs | 0 libraries/base/Data/Version.hs | 0 libraries/base/Debug/Trace.hs | 0 libraries/base/Foreign/C/Error.hs | 0 libraries/base/Foreign/C/String.hs | 0 libraries/base/Foreign/Marshal/Pool.hs | 0 libraries/base/GHC/Base.lhs | 0 libraries/base/GHC/Event/EPoll.hsc | 0 libraries/base/GHC/Exts.hs | 8 ++++---- libraries/base/GHC/Foreign.hs | 0 libraries/base/GHC/ForeignPtr.hs | 0 libraries/base/GHC/Generics.hs | 0 libraries/base/GHC/IO.hs | 0 libraries/base/GHC/IO/BufferedIO.hs | 0 libraries/base/GHC/IO/Device.hs | 0 libraries/base/GHC/IO/Encoding.hs | 0 libraries/base/GHC/IO/Encoding/CodePage/API.hs | 0 libraries/base/GHC/IO/Encoding/Failure.hs | 0 libraries/base/GHC/IO/Encoding/UTF16.hs | 0 libraries/base/GHC/IO/Encoding/UTF32.hs | 0 libraries/base/GHC/IO/FD.hs | 0 libraries/base/GHC/IO/Handle.hs | 0 libraries/base/GHC/IO/Handle/Internals.hs | 0 libraries/base/GHC/IO/Handle/Text.hs | 0 libraries/base/GHC/IO/Handle/Types.hs | 0 libraries/base/GHC/List.lhs | 6 +++--- libraries/base/GHC/Stack.hsc | 0 libraries/base/GHC/Weak.lhs | 0 libraries/base/GHC/Windows.hs | 0 libraries/base/System/Exit.hs | 0 libraries/base/System/IO.hs | 0 libraries/base/System/IO/Error.hs | 0 libraries/base/System/Posix/Internals.hs | 0 libraries/base/Text/ParserCombinators/ReadP.hs | 8 ++++---- libraries/base/Text/ParserCombinators/ReadPrec.hs | 0 libraries/base/Text/Read.hs | 0 libraries/base/Text/Read/Lex.hs | 0 45 files changed, 12 insertions(+), 12 deletions(-) diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs index afb7151..c581d1a 100644 --- a/libraries/base/Control/Exception/Base.hs +++ b/libraries/base/Control/Exception/Base.hs @@ -387,7 +387,7 @@ recSelError, recConError, irrefutPatError, runtimeError, :: Addr# -> a -- All take a UTF8-encoded C string recSelError s = throw (RecSelError ("No match in record selector " - ++ unpackCStringUtf8# s)) -- No location info unfortunately + ++ unpackCStringUtf8# s)) -- No location info unfortunately runtimeError s = error (unpackCStringUtf8# s) -- No location info unfortunately absentError s = error ("Oops! Entered absent arg " ++ unpackCStringUtf8# s) diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index aa0fc93..6754edc 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -126,9 +126,9 @@ traceEvent = Debug.Trace.traceEventIO {- ********************************************************************** -* * +* * * SpecConstr annotation * -* * +* * ********************************************************************** -} -- Annotating a type with NoSpecConstr will make SpecConstr @@ -143,9 +143,9 @@ data SpecConstrAnnotation = NoSpecConstr | ForceSpecConstr {- ********************************************************************** -* * +* * * The IsList class * -* * +* * ********************************************************************** -} -- | The 'IsList' class and its methods are intended to be used in diff --git a/libraries/base/GHC/List.lhs b/libraries/base/GHC/List.lhs index 2dffecc..ffcc8ab 100644 --- a/libraries/base/GHC/List.lhs +++ b/libraries/base/GHC/List.lhs @@ -646,9 +646,9 @@ xs !! (I# n0) | isTrue# (n0 <# 0#) = error "Prelude.(!!): negative index\n" foldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c foldr2 k z = go where - go [] _ys = z - go _xs [] = z - go (x:xs) (y:ys) = k x y (go xs ys) + go [] _ys = z + go _xs [] = z + go (x:xs) (y:ys) = k x y (go xs ys) {-# INLINE [0] foldr2 #-} foldr2_left :: (a -> b -> c -> d) -> d -> a -> ([b] -> c) -> [b] -> d diff --git a/libraries/base/Text/ParserCombinators/ReadP.hs b/libraries/base/Text/ParserCombinators/ReadP.hs index 48cbe57..4de0908 100644 --- a/libraries/base/Text/ParserCombinators/ReadP.hs +++ b/libraries/base/Text/ParserCombinators/ReadP.hs @@ -479,10 +479,10 @@ Here follow the properties: > prop_Gather s = > forAll readPWithoutReadS $ \p -> > readP_to_S (gather p) s =~ -> [ ((pre,x::Int),s') -> | (x,s') <- readP_to_S p s -> , let pre = take (length s - length s') s -> ] +> [ ((pre,x::Int),s') +> | (x,s') <- readP_to_S p s +> , let pre = take (length s - length s') s +> ] > > prop_String_Yes this s = > readP_to_S (string this) (this ++ s) =~ From git at git.haskell.org Wed Sep 24 21:47:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Sep 2014 21:47:27 +0000 (UTC) Subject: [commit: ghc] master: `M-x delete-trailing-whitespace` & `M-x untabify` (fb84817) Message-ID: <20140924214727.141433A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fb848179c85dca388edd6d92ef5cd7cd0520b4c8/ghc >--------------------------------------------------------------- commit fb848179c85dca388edd6d92ef5cd7cd0520b4c8 Author: Herbert Valerio Riedel Date: Wed Sep 24 23:47:00 2014 +0200 `M-x delete-trailing-whitespace` & `M-x untabify` >--------------------------------------------------------------- fb848179c85dca388edd6d92ef5cd7cd0520b4c8 compiler/deSugar/MatchLit.lhs | 0 compiler/ghci/Linker.lhs | 0 compiler/hsSyn/HsBinds.lhs | 0 compiler/hsSyn/HsDecls.lhs | 0 compiler/iface/TcIface.lhs | 0 compiler/main/Packages.lhs | 0 compiler/rename/RnSource.lhs | 0 compiler/typecheck/TcEvidence.lhs | 0 compiler/typecheck/TcHsSyn.lhs | 0 includes/stg/MiscClosures.h | 0 .../template-haskell/Language/Haskell/TH/Syntax.hs | 144 ++++++++++----------- rts/Linker.c | 0 rts/PrimOps.cmm | 0 rts/StgPrimFloat.c | 0 testsuite/tests/mdo/should_run/mdorun002.hs | 6 +- 15 files changed, 75 insertions(+), 75 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc fb848179c85dca388edd6d92ef5cd7cd0520b4c8 From git at git.haskell.org Wed Sep 24 22:39:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Sep 2014 22:39:32 +0000 (UTC) Subject: [commit: ghc] master: Update time submodule to 1.5.0 release (6b02626) Message-ID: <20140924223932.D54F43A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6b02626ed83ea0ab5d56bbb4981270858949991c/ghc >--------------------------------------------------------------- commit 6b02626ed83ea0ab5d56bbb4981270858949991c Author: Herbert Valerio Riedel Date: Thu Sep 25 00:38:28 2014 +0200 Update time submodule to 1.5.0 release >--------------------------------------------------------------- 6b02626ed83ea0ab5d56bbb4981270858949991c libraries/time | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/time b/libraries/time index adafac2..892717c 160000 --- a/libraries/time +++ b/libraries/time @@ -1 +1 @@ -Subproject commit adafac26307cffab0be20c126385ab161c259237 +Subproject commit 892717c506ebbeadf8b9f1f8eecf5e145cfed47e From git at git.haskell.org Thu Sep 25 08:19:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Sep 2014 08:19:51 +0000 (UTC) Subject: [commit: ghc] master: Link from 7.6.3.4 to 7.7.2.6 in the user guide. (f1d8841) Message-ID: <20140925081951.BB5B93A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f1d884193ff03ce40ad58134e44df5b50c6a62f5/ghc >--------------------------------------------------------------- commit f1d884193ff03ce40ad58134e44df5b50c6a62f5 Author: Jan Stolarek Date: Thu Sep 25 10:18:15 2014 +0200 Link from 7.6.3.4 to 7.7.2.6 in the user guide. This point the user that there is a relation between the UndecibadleInstances flag and the type families, not just type classes. >--------------------------------------------------------------- f1d884193ff03ce40ad58134e44df5b50c6a62f5 docs/users_guide/glasgow_exts.xml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 13090c6..04e603a 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -5025,6 +5025,11 @@ sort of backtrace, and the opportunity to increase the stack depth with N. + +The flag is also used to lift some of the +restricitions imposed on type family instances. See . + + From git at git.haskell.org Thu Sep 25 09:24:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Sep 2014 09:24:10 +0000 (UTC) Subject: [commit: ghc] master: Remove a few redundant `-fno-warn-tabs`s (55e04cb) Message-ID: <20140925092410.AC6073A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/55e04cb9cb78951cbcc2a30cccb965124b1a283d/ghc >--------------------------------------------------------------- commit 55e04cb9cb78951cbcc2a30cccb965124b1a283d Author: Herbert Valerio Riedel Date: Thu Sep 25 08:49:02 2014 +0200 Remove a few redundant `-fno-warn-tabs`s >--------------------------------------------------------------- 55e04cb9cb78951cbcc2a30cccb965124b1a283d compiler/coreSyn/MkCore.lhs | 6 ------ compiler/hsSyn/HsUtils.lhs | 6 ------ compiler/rename/RnBinds.lhs | 6 ------ 3 files changed, 18 deletions(-) diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs index d749f82..6987f06 100644 --- a/compiler/coreSyn/MkCore.lhs +++ b/compiler/coreSyn/MkCore.lhs @@ -1,11 +1,5 @@ \begin{code} {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details -- | Handy functions for creating much Core syntax module MkCore ( diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index 35de6a6..cae0983 100644 --- a/compiler/hsSyn/HsUtils.lhs +++ b/compiler/hsSyn/HsUtils.lhs @@ -15,12 +15,6 @@ which deal with the instantiated versions are located elsewhere: \begin{code} {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index f76090f..c572e32 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -10,12 +10,6 @@ they may be affected by renaming (which isn't fully worked out yet). \begin{code} {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details module RnBinds ( -- Renaming top-level bindings From git at git.haskell.org Thu Sep 25 12:37:20 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Sep 2014 12:37:20 +0000 (UTC) Subject: [commit: ghc] wip/new-flatten-skolems-Aug14: More progress (88a007c) Message-ID: <20140925123720.27AE73A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/new-flatten-skolems-Aug14 Link : http://ghc.haskell.org/trac/ghc/changeset/88a007c84b37a6b2f5ed340fccfb7ddd6ffc2ba0/ghc >--------------------------------------------------------------- commit 88a007c84b37a6b2f5ed340fccfb7ddd6ffc2ba0 Author: Simon Peyton Jones Date: Thu Sep 25 13:35:55 2014 +0100 More progress >--------------------------------------------------------------- 88a007c84b37a6b2f5ed340fccfb7ddd6ffc2ba0 compiler/typecheck/Flattening-notes | 150 +++++++++-- compiler/typecheck/TcCanonical.lhs | 198 +++++++------- compiler/typecheck/TcErrors.lhs | 4 +- compiler/typecheck/TcHsSyn.lhs | 2 +- compiler/typecheck/TcInteract.lhs | 53 ++-- compiler/typecheck/TcMType.lhs | 27 +- compiler/typecheck/TcRnTypes.lhs | 32 ++- compiler/typecheck/TcRules.lhs | 4 +- compiler/typecheck/TcSMonad.lhs | 283 +++++++++++---------- compiler/typecheck/TcSimplify.lhs | 267 +++++++------------ compiler/typecheck/TcType.lhs | 34 ++- compiler/typecheck/TcUnify.lhs | 2 +- .../should_compile/IndTypesPerfMerge.hs | 8 + .../indexed-types/should_compile/T3208b.stderr | 13 +- .../tests/indexed-types/should_fail/GADTwrong1.hs | 19 +- .../indexed-types/should_fail/GADTwrong1.stderr | 22 +- testsuite/tests/indexed-types/should_fail/T2544.hs | 13 + .../tests/indexed-types/should_fail/T2544.stderr | 23 +- .../tests/indexed-types/should_fail/T2627b.stderr | 4 +- .../tests/indexed-types/should_fail/T6123.stderr | 6 +- .../tests/indexed-types/should_fail/T7729.stderr | 5 +- testsuite/tests/indexed-types/should_fail/T7786.hs | 2 +- .../tests/indexed-types/should_fail/T8129.stdout | 4 +- .../tests/indexed-types/should_fail/T8227.stderr | 4 +- .../tests/indexed-types/should_fail/T8518.stderr | 19 ++ .../tests/indexed-types/should_fail/T9036.stderr | 4 +- .../typecheck/should_compile/TcTypeNatSimple.hs | 12 +- .../typecheck/should_fail/FrozenErrorTests.stderr | 8 +- 28 files changed, 678 insertions(+), 544 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 88a007c84b37a6b2f5ed340fccfb7ddd6ffc2ba0 From git at git.haskell.org Thu Sep 25 17:59:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Sep 2014 17:59:57 +0000 (UTC) Subject: [commit: ghc] master: Detab DataCon (46a5b7c) Message-ID: <20140925175957.582773A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/46a5b7cc64c971102cd3b56e6a2d6e993bd8c576/ghc >--------------------------------------------------------------- commit 46a5b7cc64c971102cd3b56e6a2d6e993bd8c576 Author: Edward Z. Yang Date: Thu Sep 25 02:39:12 2014 -0700 Detab DataCon Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 46a5b7cc64c971102cd3b56e6a2d6e993bd8c576 compiler/basicTypes/DataCon.lhs | 602 ++++++++++++++++++++-------------------- 1 file changed, 298 insertions(+), 304 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 46a5b7cc64c971102cd3b56e6a2d6e993bd8c576 From git at git.haskell.org Thu Sep 25 20:18:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Sep 2014 20:18:03 +0000 (UTC) Subject: [commit: packages/binary] ghc-head: Remove INLINEs from GBinary/GSum methods (03adb0a) Message-ID: <20140925201803.3C84B3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : ghc-head Link : http://git.haskell.org/packages/binary.git/commitdiff/03adb0aa2c17ce044586e3a30edc13e5cc83f69e >--------------------------------------------------------------- commit 03adb0aa2c17ce044586e3a30edc13e5cc83f69e Author: Herbert Valerio Riedel Date: Thu Sep 25 22:07:13 2014 +0200 Remove INLINEs from GBinary/GSum methods These interact very badly with GHC 7.9.x's simplifier See also - https://ghc.haskell.org/trac/ghc/ticket/9630 and - https://ghc.haskell.org/trac/ghc/ticket/9583 Submitted upstream as https://github.com/kolmodin/binary/pull/62 >--------------------------------------------------------------- 03adb0aa2c17ce044586e3a30edc13e5cc83f69e src/Data/Binary/Generic.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/Data/Binary/Generic.hs b/src/Data/Binary/Generic.hs index 03ce711..a2eb6ea 100644 --- a/src/Data/Binary/Generic.hs +++ b/src/Data/Binary/Generic.hs @@ -72,13 +72,11 @@ instance ( GSum a, GSum b | otherwise = sizeError "encode" size where size = unTagged (sumSize :: Tagged (a :+: b) Word64) - {-# INLINE gput #-} gget | GETSUM(Word8) | GETSUM(Word16) | GETSUM(Word32) | GETSUM(Word64) | otherwise = sizeError "decode" size where size = unTagged (sumSize :: Tagged (a :+: b) Word64) - {-# INLINE gget #-} sizeError :: Show size => String -> size -> error sizeError s size = @@ -102,7 +100,6 @@ instance (GSum a, GSum b, GBinary a, GBinary b) => GSum (a :+: b) where where sizeL = size `shiftR` 1 sizeR = size - sizeL - {-# INLINE getSum #-} putSum !code !size s = case s of L1 x -> putSum code sizeL x @@ -110,14 +107,11 @@ instance (GSum a, GSum b, GBinary a, GBinary b) => GSum (a :+: b) where where sizeL = size `shiftR` 1 sizeR = size - sizeL - {-# INLINE putSum #-} instance GBinary a => GSum (C1 c a) where getSum _ _ = gget - {-# INLINE getSum #-} putSum !code _ x = put code *> gput x - {-# INLINE putSum #-} ------------------------------------------------------------------------ From git at git.haskell.org Thu Sep 25 20:22:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Sep 2014 20:22:10 +0000 (UTC) Subject: [commit: ghc] master: Update `binary` submodule in an attempt to address #9630 (3ecca02) Message-ID: <20140925202210.322DD3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3ecca02516af5de803e4ff667c8c969c5bffb35f/ghc >--------------------------------------------------------------- commit 3ecca02516af5de803e4ff667c8c969c5bffb35f Author: Herbert Valerio Riedel Date: Thu Sep 25 22:19:32 2014 +0200 Update `binary` submodule in an attempt to address #9630 This removes a couple of `INLINE` pragmas from the generics helper classes. With this change the compile times and memory usage should go back to the previous GHC 7.8.3 situation. This has been submitted upstream as https://github.com/kolmodin/binary/pull/62 >--------------------------------------------------------------- 3ecca02516af5de803e4ff667c8c969c5bffb35f libraries/binary | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/binary b/libraries/binary index f5f6fe7..03adb0a 160000 --- a/libraries/binary +++ b/libraries/binary @@ -1 +1 @@ -Subproject commit f5f6fe72bd069a2b56dd52e645aad406c6195526 +Subproject commit 03adb0aa2c17ce044586e3a30edc13e5cc83f69e From git at git.haskell.org Fri Sep 26 04:07:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 04:07:32 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] iface: detabify/dewhitespace IfaceSyn (c315702) Message-ID: <20140926040732.BF04D3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c315702fb164346b198298dfcc06aeb350e9cc43/ghc >--------------------------------------------------------------- commit c315702fb164346b198298dfcc06aeb350e9cc43 Author: Austin Seipp Date: Thu Sep 25 23:03:53 2014 -0500 [ci skip] iface: detabify/dewhitespace IfaceSyn Signed-off-by: Austin Seipp >--------------------------------------------------------------- c315702fb164346b198298dfcc06aeb350e9cc43 compiler/iface/IfaceSyn.lhs | 42 ++++++++++++++++++------------------------ 1 file changed, 18 insertions(+), 24 deletions(-) diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index 6fec398..e45fac2 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -5,12 +5,6 @@ \begin{code} {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details module IfaceSyn ( module IfaceType, @@ -113,16 +107,16 @@ data IfaceDecl ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon) ifSynRhs :: IfaceSynTyConRhs } - | IfaceClass { ifCtxt :: IfaceContext, -- Context... - ifName :: IfaceTopBndr, -- Name of the class TyCon - ifTyVars :: [IfaceTvBndr], -- Type variables - ifRoles :: [Role], -- Roles - ifFDs :: [FunDep FastString], -- Functional dependencies + | IfaceClass { ifCtxt :: IfaceContext, -- Context... + ifName :: IfaceTopBndr, -- Name of the class TyCon + ifTyVars :: [IfaceTvBndr], -- Type variables + ifRoles :: [Role], -- Roles + ifFDs :: [FunDep FastString], -- Functional dependencies ifATs :: [IfaceAT], -- Associated type families ifSigs :: [IfaceClassOp], -- Method signatures ifMinDef :: BooleanFormula IfLclName, -- Minimal complete definition - ifRec :: RecFlag -- Is newtype/datatype associated - -- with the class recursive? + ifRec :: RecFlag -- Is newtype/datatype associated + -- with the class recursive? } | IfaceAxiom { ifName :: IfaceTopBndr, -- Axiom name @@ -491,12 +485,12 @@ data IfaceExpr | IfaceExt IfExtName | IfaceType IfaceType | IfaceCo IfaceCoercion - | IfaceTuple TupleSort [IfaceExpr] -- Saturated; type arguments omitted - | IfaceLam IfaceBndr IfaceExpr - | IfaceApp IfaceExpr IfaceExpr - | IfaceCase IfaceExpr IfLclName [IfaceAlt] + | IfaceTuple TupleSort [IfaceExpr] -- Saturated; type arguments omitted + | IfaceLam IfaceBndr IfaceExpr + | IfaceApp IfaceExpr IfaceExpr + | IfaceCase IfaceExpr IfLclName [IfaceAlt] | IfaceECase IfaceExpr IfaceType -- See Note [Empty case alternatives] - | IfaceLet IfaceBinding IfaceExpr + | IfaceLet IfaceBinding IfaceExpr | IfaceCast IfaceExpr IfaceCoercion | IfaceLit Literal | IfaceFCall ForeignCall IfaceType @@ -1008,15 +1002,15 @@ pprIfaceExpr add_par (IfaceECase scrut ty) pprIfaceExpr add_par (IfaceCase scrut bndr [(con, bs, rhs)]) = add_par (sep [ptext (sLit "case") - <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") - <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow, - pprIfaceExpr noParens rhs <+> char '}']) + <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") + <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow, + pprIfaceExpr noParens rhs <+> char '}']) pprIfaceExpr add_par (IfaceCase scrut bndr alts) = add_par (sep [ptext (sLit "case") - <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") - <+> ppr bndr <+> char '{', - nest 2 (sep (map ppr_alt alts)) <+> char '}']) + <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") + <+> ppr bndr <+> char '{', + nest 2 (sep (map ppr_alt alts)) <+> char '}']) pprIfaceExpr _ (IfaceCast expr co) = sep [pprParendIfaceExpr expr, From git at git.haskell.org Fri Sep 26 04:07:35 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 04:07:35 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] simplCore: detabify/dewhitespace CoreMonad (3765e21) Message-ID: <20140926040735.537333A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3765e21b67b13cca0b3c606d4c34fe65f5805b10/ghc >--------------------------------------------------------------- commit 3765e21b67b13cca0b3c606d4c34fe65f5805b10 Author: Austin Seipp Date: Thu Sep 25 23:04:38 2014 -0500 [ci skip] simplCore: detabify/dewhitespace CoreMonad Signed-off-by: Austin Seipp >--------------------------------------------------------------- 3765e21b67b13cca0b3c606d4c34fe65f5805b10 compiler/simplCore/CoreMonad.lhs | 332 +++++++++++++++++++-------------------- 1 file changed, 163 insertions(+), 169 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3765e21b67b13cca0b3c606d4c34fe65f5805b10 From git at git.haskell.org Fri Sep 26 04:07:37 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 04:07:37 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] typecheck: detabify/dewhitespace TcInstDecls (7567ad3) Message-ID: <20140926040737.D4F553A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7567ad3cd0fc7e4ac2e6068a9067219d3fbd0399/ghc >--------------------------------------------------------------- commit 7567ad3cd0fc7e4ac2e6068a9067219d3fbd0399 Author: Austin Seipp Date: Thu Sep 25 23:05:20 2014 -0500 [ci skip] typecheck: detabify/dewhitespace TcInstDecls Signed-off-by: Austin Seipp >--------------------------------------------------------------- 7567ad3cd0fc7e4ac2e6068a9067219d3fbd0399 compiler/typecheck/TcInstDcls.lhs | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index f559dda..70553ff 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -7,12 +7,6 @@ TcInstDecls: Typechecking instance declarations \begin{code} {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details module TcInstDcls ( tcInstDecls1, tcInstDecls2 ) where @@ -558,8 +552,8 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = poly_ty, cid_binds = binds do defaultOverlapFlag <- getOverlapFlag return $ setOverlapModeMaybe defaultOverlapFlag overlap_mode ; (subst, tyvars') <- tcInstSkolTyVars tyvars - ; let dfun = mkDictFunId dfun_name tyvars theta clas inst_tys - ispec = mkLocalInstance dfun overlap_flag tyvars' clas (substTys subst inst_tys) + ; let dfun = mkDictFunId dfun_name tyvars theta clas inst_tys + ispec = mkLocalInstance dfun overlap_flag tyvars' clas (substTys subst inst_tys) -- Be sure to freshen those type variables, -- so they are sure not to appear in any lookup inst_info = InstInfo { iSpec = ispec @@ -1355,13 +1349,13 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys mkGenericDefMethBind :: Class -> [Type] -> Id -> Name -> TcM (LHsBind Name) mkGenericDefMethBind clas inst_tys sel_id dm_name - = -- A generic default method - -- If the method is defined generically, we only have to call the + = -- A generic default method + -- If the method is defined generically, we only have to call the -- dm_name. - do { dflags <- getDynFlags - ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body" - (vcat [ppr clas <+> ppr inst_tys, - nest 2 (ppr sel_id <+> equals <+> ppr rhs)])) + do { dflags <- getDynFlags + ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body" + (vcat [ppr clas <+> ppr inst_tys, + nest 2 (ppr sel_id <+> equals <+> ppr rhs)])) ; return (noLoc $ mkTopFunBind Generated (noLoc (idName sel_id)) [mkSimpleMatch [] rhs]) } From git at git.haskell.org Fri Sep 26 04:07:40 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 04:07:40 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] typecheck: detabify/dewhitespace TcPat (c4ea319) Message-ID: <20140926040740.6FF743A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c4ea3196905e2929dc7aebc1e211442227e917cd/ghc >--------------------------------------------------------------- commit c4ea3196905e2929dc7aebc1e211442227e917cd Author: Austin Seipp Date: Thu Sep 25 23:05:34 2014 -0500 [ci skip] typecheck: detabify/dewhitespace TcPat Signed-off-by: Austin Seipp >--------------------------------------------------------------- c4ea3196905e2929dc7aebc1e211442227e917cd compiler/typecheck/TcPat.lhs | 570 +++++++++++++++++++++---------------------- 1 file changed, 282 insertions(+), 288 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 c4ea3196905e2929dc7aebc1e211442227e917cd From git at git.haskell.org Fri Sep 26 04:07:42 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 04:07:42 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] typecheck: detabify/dewhitespace TcTyDecls (a3dcaa5) Message-ID: <20140926040742.F1C2A3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a3dcaa5382f47d8982038aaf6a177f56fe403339/ghc >--------------------------------------------------------------- commit a3dcaa5382f47d8982038aaf6a177f56fe403339 Author: Austin Seipp Date: Thu Sep 25 23:05:54 2014 -0500 [ci skip] typecheck: detabify/dewhitespace TcTyDecls Signed-off-by: Austin Seipp >--------------------------------------------------------------- a3dcaa5382f47d8982038aaf6a177f56fe403339 compiler/typecheck/TcTyDecls.lhs | 26 ++++++++++---------------- 1 file changed, 10 insertions(+), 16 deletions(-) diff --git a/compiler/typecheck/TcTyDecls.lhs b/compiler/typecheck/TcTyDecls.lhs index 2360f7b..ee26641 100644 --- a/compiler/typecheck/TcTyDecls.lhs +++ b/compiler/typecheck/TcTyDecls.lhs @@ -10,12 +10,6 @@ files for imported data types. \begin{code} {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details module TcTyDecls( calcRecFlags, RecTyInfo(..), @@ -149,7 +143,7 @@ and then *their* superclasses, and so on. This set must be finite! It is OK for superclasses to be type synonyms for other classes, so must "look through" type synonyms. Eg type X a = C [a] - class X a => C a -- No! Recursive superclass! + class X a => C a -- No! Recursive superclass! We want definitions such as: @@ -413,12 +407,12 @@ calcRecFlags boot_details is_boot mrole_env tyclss (new_tycons, prod_tycons) = partition isNewTyCon single_con_tycons -- NB: we do *not* call isProductTyCon because that checks - -- for vanilla-ness of data constructors; and that depends - -- on empty existential type variables; and that is figured - -- out by tcResultType; which uses tcMatchTy; which uses - -- coreView; which calls coreExpandTyCon_maybe; which uses - -- the recursiveness of the TyCon. Result... a black hole. - -- YUK YUK YUK + -- for vanilla-ness of data constructors; and that depends + -- on empty existential type variables; and that is figured + -- out by tcResultType; which uses tcMatchTy; which uses + -- coreView; which calls coreExpandTyCon_maybe; which uses + -- the recursiveness of the TyCon. Result... a black hole. + -- YUK YUK YUK --------------- Newtypes ---------------------- nt_loop_breakers = mkNameSet (findLoopBreakers nt_edges) @@ -530,9 +524,9 @@ isPromotableType rec_tcs con_arg_ty && (tyConName tc `elemNameSet` rec_tcs || isJust (promotableTyCon_maybe tc)) && all go tys - go (FunTy arg res) = go arg && go res - go (TyVarTy {}) = True - go _ = False + go (FunTy arg res) = go arg && go res + go (TyVarTy {}) = True + go _ = False \end{code} %************************************************************************ From git at git.haskell.org Fri Sep 26 04:07:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 04:07:45 +0000 (UTC) Subject: [commit: ghc] master: [ci skip] typecheck: detabify/dewhitespace TcUnify (18155ac) Message-ID: <20140926040745.8A16E3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/18155ac21257316b430bfa209512d06822319707/ghc >--------------------------------------------------------------- commit 18155ac21257316b430bfa209512d06822319707 Author: Austin Seipp Date: Thu Sep 25 23:06:19 2014 -0500 [ci skip] typecheck: detabify/dewhitespace TcUnify Signed-off-by: Austin Seipp >--------------------------------------------------------------- 18155ac21257316b430bfa209512d06822319707 compiler/typecheck/TcUnify.lhs | 118 +++++++++++++++++++---------------------- 1 file changed, 56 insertions(+), 62 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 18155ac21257316b430bfa209512d06822319707 From git at git.haskell.org Fri Sep 26 04:07:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 04:07:48 +0000 (UTC) Subject: [commit: ghc] master: types: detabify/dewhitespace Unify (efdf4b9) Message-ID: <20140926040748.1DBC63A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/efdf4b9d69d7eda83f872cbcfac9ef1215f39b7c/ghc >--------------------------------------------------------------- commit efdf4b9d69d7eda83f872cbcfac9ef1215f39b7c Author: Austin Seipp Date: Thu Sep 25 23:07:07 2014 -0500 types: detabify/dewhitespace Unify Signed-off-by: Austin Seipp >--------------------------------------------------------------- efdf4b9d69d7eda83f872cbcfac9ef1215f39b7c compiler/types/Unify.lhs | 309 +++++++++++++++++++++++------------------------ 1 file changed, 151 insertions(+), 158 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 efdf4b9d69d7eda83f872cbcfac9ef1215f39b7c From git at git.haskell.org Fri Sep 26 04:11:16 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 04:11:16 +0000 (UTC) Subject: [commit: ghc] master: Refer to 'mask' instead of 'block' in Control.Exception (dc1fce1) Message-ID: <20140926041116.995753A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dc1fce13633e44c6068eb76fc7ed48e94feb5e32/ghc >--------------------------------------------------------------- commit dc1fce13633e44c6068eb76fc7ed48e94feb5e32 Author: Thomas Miedema Date: Thu Sep 25 23:10:18 2014 -0500 Refer to 'mask' instead of 'block' in Control.Exception Summary: More thorough version of a75383cdd46f7bb593639bc6d1628b068b78262a Test Plan: change of comments only [skip ci] Reviewers: austin, simonmar, ekmett Reviewed By: austin, ekmett Subscribers: simonmar, ezyang, carter Differential Revision: https://phabricator.haskell.org/D239 >--------------------------------------------------------------- dc1fce13633e44c6068eb76fc7ed48e94feb5e32 libraries/base/Control/Exception.hs | 8 ++++---- libraries/base/GHC/IO.hs | 5 +++-- rts/Exception.cmm | 37 +++++++++++++++++++++---------------- 3 files changed, 28 insertions(+), 22 deletions(-) diff --git a/libraries/base/Control/Exception.hs b/libraries/base/Control/Exception.hs index 252597d..fa50575 100644 --- a/libraries/base/Control/Exception.hs +++ b/libraries/base/Control/Exception.hs @@ -190,11 +190,11 @@ use: case use 'catch' or 'catchJust'. The difference between using 'try' and 'catch' for recovery is that in -'catch' the handler is inside an implicit 'block' (see \"Asynchronous +'catch' the handler is inside an implicit 'mask' (see \"Asynchronous Exceptions\") which is important when catching asynchronous exceptions, but when catching other kinds of exception it is unnecessary. Furthermore it is possible to accidentally stay inside -the implicit 'block' by tail-calling rather than returning from the +the implicit 'mask' by tail-calling rather than returning from the handler, which is why we recommend using 'try' rather than 'catch' for ordinary exception recovery. @@ -210,7 +210,7 @@ A typical use of 'tryJust' for recovery looks like this: -- ----------------------------------------------------------------------------- -- Asynchronous exceptions --- | When invoked inside 'mask', this function allows a blocked +-- | When invoked inside 'mask', this function allows a masked -- asynchronous exception to be raised, if one exists. It is -- equivalent to performing an interruptible operation (see -- #interruptible#), but does not involve any actual blocking. @@ -258,7 +258,7 @@ to write something like > catch (restore (...)) > (\e -> handler) -If you need to unblock asynchronous exceptions again in the exception +If you need to unmask asynchronous exceptions again in the exception handler, 'restore' can be used there too. Note that 'try' and friends /do not/ have a similar default, because diff --git a/libraries/base/GHC/IO.hs b/libraries/base/GHC/IO.hs index 66e4bfb..62c4975 100644 --- a/libraries/base/GHC/IO.hs +++ b/libraries/base/GHC/IO.hs @@ -402,8 +402,9 @@ onException io what = io `catchException` \e -> do _ <- what -- state if the masked thread /blocks/ in certain ways; see -- "Control.Exception#interruptible". -- --- Threads created by 'Control.Concurrent.forkIO' inherit the masked --- state from the parent; that is, to start a thread in blocked mode, +-- Threads created by 'Control.Concurrent.forkIO' inherit the +-- 'MaskingState' from the parent; that is, to start a thread in the +-- 'MaskedInterruptible' state, -- use @mask_ $ forkIO ... at . This is particularly useful if you need -- to establish an exception handler in the forked thread before any -- asynchronous exceptions are received. To create a a new thread in diff --git a/rts/Exception.cmm b/rts/Exception.cmm index 553df3d..bc55911 100644 --- a/rts/Exception.cmm +++ b/rts/Exception.cmm @@ -19,23 +19,28 @@ import ghczmprim_GHCziTypes_True_closure; Exception Primitives A thread can request that asynchronous exceptions not be delivered - ("blocked") for the duration of an I/O computation. The primitive + ("masked") for the duration of an I/O computation. The primitives maskAsyncExceptions# :: IO a -> IO a - is used for this purpose. During a blocked section, asynchronous - exceptions may be unblocked again temporarily: + and + + maskUninterruptible# :: IO a -> IO a + + are used for this purpose. During a masked section, asynchronous + exceptions may be unmasked again temporarily: unmaskAsyncExceptions# :: IO a -> IO a - Furthermore, asynchronous exceptions are blocked automatically during - the execution of an exception handler. Both of these primitives + Furthermore, asynchronous exceptions are masked automatically during + the execution of an exception handler. All three of these primitives leave a continuation on the stack which reverts to the previous - state (blocked or unblocked) on exit. + state (masked interruptible, masked non-interruptible, or unmasked) + on exit. A thread which wants to raise an exception in another thread (using killThread#) must block until the target thread is ready to receive - it. The action of unblocking exceptions in a thread will release all + it. The action of unmasking exceptions in a thread will release all the threads waiting to deliver exceptions to that thread. NB. there's a bug in here. If a thread is inside an @@ -44,7 +49,7 @@ import ghczmprim_GHCziTypes_True_closure; interruptible operation, and it receives an exception, then the unsafePerformIO thunk will be updated with a stack object containing the unmaskAsyncExceptions_ret frame. Later, when - someone else evaluates this thunk, the blocked exception state is + someone else evaluates this thunk, the original masking state is not restored. -------------------------------------------------------------------------- */ @@ -61,7 +66,7 @@ INFO_TABLE_RET(stg_unmaskAsyncExceptionszh_ret, RET_SMALL, W_ info_ptr) StgTSO_flags(CurrentTSO) = %lobits32( TO_W_(StgTSO_flags(CurrentTSO)) & ~(TSO_BLOCKEX|TSO_INTERRUPTIBLE)); - /* Eagerly raise a blocked exception, if there is one */ + /* Eagerly raise a masked exception, if there is one */ if (StgTSO_blocked_exceptions(CurrentTSO) != END_TSO_QUEUE) { STK_CHK_P_LL (WDS(2), stg_unmaskAsyncExceptionszh_ret_info, R1); @@ -192,11 +197,11 @@ stg_unmaskAsyncExceptionszh /* explicit stack */ io = R1; STK_CHK_P_LL (WDS(4), stg_unmaskAsyncExceptionszh, io); - /* 4 words: one for the unblock frame, 3 for setting up the + /* 4 words: one for the unmask frame, 3 for setting up the * stack to call maybePerformBlockedException() below. */ - /* If exceptions are already unblocked, there's nothing to do */ + /* If exceptions are already unmasked, there's nothing to do */ if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) != 0) { /* avoid growing the stack unnecessarily */ @@ -214,7 +219,7 @@ stg_unmaskAsyncExceptionszh /* explicit stack */ StgTSO_flags(CurrentTSO) = %lobits32( TO_W_(StgTSO_flags(CurrentTSO)) & ~(TSO_BLOCKEX|TSO_INTERRUPTIBLE)); - /* Eagerly raise a blocked exception, if there is one */ + /* Eagerly raise a masked exception, if there is one */ if (StgTSO_blocked_exceptions(CurrentTSO) != END_TSO_QUEUE) { /* * We have to be very careful here, as in killThread#, since @@ -329,7 +334,7 @@ stg_killMyself exception = R2; SAVE_THREAD_STATE(); - /* ToDo: what if the current thread is blocking exceptions? */ + /* ToDo: what if the current thread is masking exceptions? */ ccall throwToSingleThreaded(MyCapability() "ptr", target "ptr", exception "ptr"); if (StgTSO_what_next(CurrentTSO) == ThreadKilled::I16) { @@ -557,10 +562,10 @@ retry_pop_stack: handler = StgCatchSTMFrame_handler(Sp); } - /* Restore the blocked/unblocked state for asynchronous exceptions + /* Restore the masked/unmasked state for asynchronous exceptions * at the CATCH_FRAME. * - * If exceptions were unblocked, arrange that they are unblocked + * If exceptions were unmasked, arrange that they are unmasked * again after executing the handler by pushing an * unmaskAsyncExceptions_ret stack frame. * @@ -577,7 +582,7 @@ retry_pop_stack: Sp(0) = stg_unmaskAsyncExceptionszh_ret_info; } - /* Ensure that async exceptions are blocked when running the handler. + /* Ensure that async exceptions are masked when running the handler. */ StgTSO_flags(CurrentTSO) = %lobits32( TO_W_(StgTSO_flags(CurrentTSO)) | TSO_BLOCKEX | TSO_INTERRUPTIBLE); From git at git.haskell.org Fri Sep 26 04:11:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 04:11:19 +0000 (UTC) Subject: [commit: ghc] master: Delete hack that was once needed to fix the build (a7ec061) Message-ID: <20140926041119.2B1323A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a7ec061ed3c4373b0b47d6779d2fd259ad712b5e/ghc >--------------------------------------------------------------- commit a7ec061ed3c4373b0b47d6779d2fd259ad712b5e Author: Thomas Miedema Date: Thu Sep 25 23:10:33 2014 -0500 Delete hack that was once needed to fix the build Summary: Introduced in 6c7b41cc2b24f533697a62bf1843507ae043fc97. I checked the rest of that commit, and this is all that was left to revert. Test Plan: x Reviewers: ezyang, austin Reviewed By: ezyang, austin Subscribers: simonmar, ezyang, carter, thomie Differential Revision: https://phabricator.haskell.org/D241 >--------------------------------------------------------------- a7ec061ed3c4373b0b47d6779d2fd259ad712b5e compiler/nativeGen/RegAlloc/Graph/Spill.hs | 1 + compiler/nativeGen/RegAlloc/Liveness.hs | 1 + compiler/utils/State.hs | 8 +++++--- 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs index 543db11..802046c 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs @@ -13,6 +13,7 @@ import Reg import Cmm hiding (RegSet) import BlockId +import MonadUtils import State import Unique import UniqFM diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs index d7fd8bd..167197d 100644 --- a/compiler/nativeGen/RegAlloc/Liveness.hs +++ b/compiler/nativeGen/RegAlloc/Liveness.hs @@ -44,6 +44,7 @@ import PprCmm() import Digraph import DynFlags +import MonadUtils import Outputable import Platform import UniqSet diff --git a/compiler/utils/State.hs b/compiler/utils/State.hs index 216034f..7346841 100644 --- a/compiler/utils/State.hs +++ b/compiler/utils/State.hs @@ -1,8 +1,10 @@ -{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnboxedTuples, CPP #-} -module State (module State, mapAccumLM {- XXX hack -}) where +module State where -import MonadUtils +#if __GLASGOW_HASKELL__ < 709 +import Control.Applicative +#endif newtype State s a = State { runState' :: s -> (# a, s #) } From git at git.haskell.org Fri Sep 26 04:11:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 04:11:21 +0000 (UTC) Subject: [commit: ghc] master: User's Guide: various unfolding-related fixes (2388146) Message-ID: <20140926041121.AC96B3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/238814620e188e4f3ff22950960c41994211fdc0/ghc >--------------------------------------------------------------- commit 238814620e188e4f3ff22950960c41994211fdc0 Author: Reid Barton Date: Thu Sep 25 23:10:50 2014 -0500 User's Guide: various unfolding-related fixes Test Plan: harbormaster Reviewers: austin Reviewed By: austin Subscribers: simonmar, ezyang, carter, thomie Differential Revision: https://phabricator.haskell.org/D243 >--------------------------------------------------------------- 238814620e188e4f3ff22950960c41994211fdc0 docs/users_guide/flags.xml | 15 +++++++++++---- docs/users_guide/using.xml | 8 ++++---- 2 files changed, 15 insertions(+), 8 deletions(-) diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index 94b4598..affe194 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -1937,28 +1937,35 @@ Tweak unfolding settings dynamic - + - Tweak unfolding settings dynamic - + - + + + + + Tweak unfolding settings + dynamic + - Tweak unfolding settings dynamic - + - Tweak unfolding settings dynamic - + - diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml index 09747ae..54c127d 100644 --- a/docs/users_guide/using.xml +++ b/docs/users_guide/using.xml @@ -2475,7 +2475,7 @@ _ = rhs3 -- No warning: lone wild-card pattern unfolding, controlling - (Default: 45) Governs the maximum size that GHC will allow a + (Default: 750) Governs the maximum size that GHC will allow a function unfolding to be. (An unfolding has a “size” that reflects the cost in terms of “code bloat” of expanding (aka inlining) that unfolding at a call site. A bigger @@ -2502,12 +2502,12 @@ _ = rhs3 -- No warning: lone wild-card pattern unfolding, controlling - (Default: 8) This is the magic cut-off figure for unfolding + (Default: 60) This is the magic cut-off figure for unfolding (aka inlining): below this size, a function definition will be unfolded at the call-site, any bigger and it won't. The size computed for a function depends on two things: the actual size of - the expression minus any discounts that - apply (see ). + the expression minus any discounts that apply depending on the + context into which the expression is to be inlined. The difference between this and From git at git.haskell.org Fri Sep 26 04:11:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 04:11:24 +0000 (UTC) Subject: [commit: ghc] master: Fixes cyclic import on OS X(#9635) (c23beff) Message-ID: <20140926041124.3946B3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c23beffd65fd0eb50e7fe3a53a89220252aadd74/ghc >--------------------------------------------------------------- commit c23beffd65fd0eb50e7fe3a53a89220252aadd74 Author: Dave Laing Date: Thu Sep 25 23:11:01 2014 -0500 Fixes cyclic import on OS X(#9635) Summary: Signed-off-by: Dave Laing Test Plan: Locally tested Reviewers: thomie, austin Reviewed By: thomie, austin Subscribers: simonmar, ezyang, carter, thomie Differential Revision: https://phabricator.haskell.org/D244 GHC Trac Issues: #9635 >--------------------------------------------------------------- c23beffd65fd0eb50e7fe3a53a89220252aadd74 libraries/base/GHC/Event/KQueue.hsc | 1 - 1 file changed, 1 deletion(-) diff --git a/libraries/base/GHC/Event/KQueue.hsc b/libraries/base/GHC/Event/KQueue.hsc index 439765c..2b8d443 100644 --- a/libraries/base/GHC/Event/KQueue.hsc +++ b/libraries/base/GHC/Event/KQueue.hsc @@ -26,7 +26,6 @@ available = False {-# INLINE available #-} #else -import Control.Monad (when) import Data.Bits (Bits(..), FiniteBits(..)) import Data.Word (Word16, Word32) import Foreign.C.Error (throwErrnoIfMinus1, eINTR, eINVAL, From git at git.haskell.org Fri Sep 26 11:34:55 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 11:34:55 +0000 (UTC) Subject: [commit: ghc] master: Defer errors in derived instances (74ae598) Message-ID: <20140926113455.2FC6F3A005@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/74ae59896e4222a8115f5548845f13495f5bb76e/ghc >--------------------------------------------------------------- commit 74ae59896e4222a8115f5548845f13495f5bb76e Author: Simon Peyton Jones Date: Wed Sep 24 11:22:52 2014 +0100 Defer errors in derived instances Fixes Trac #9576. Turned out to be pretty easy. >--------------------------------------------------------------- 74ae59896e4222a8115f5548845f13495f5bb76e compiler/typecheck/TcDeriv.lhs | 18 ++++++++------- compiler/typecheck/TcEnv.lhs | 7 +++--- compiler/typecheck/TcGenGenerics.lhs | 6 ++--- compiler/typecheck/TcInstDcls.lhs | 26 ++++++++++------------ testsuite/tests/deriving/should_fail/T4846.stderr | 2 +- .../tests/deriving/should_fail/drvfail011.stderr | 2 +- testsuite/tests/deriving/should_run/T9576.hs | 9 ++++++++ testsuite/tests/deriving/should_run/T9576.stderr | 11 +++++++++ .../tests/deriving/should_run/T9576.stdout | 0 testsuite/tests/deriving/should_run/all.T | 1 + 10 files changed, 52 insertions(+), 30 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 74ae59896e4222a8115f5548845f13495f5bb76e From git at git.haskell.org Fri Sep 26 11:34:57 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 11:34:57 +0000 (UTC) Subject: [commit: ghc] master: Do not discard insoluble Derived constraints (20632d3) Message-ID: <20140926113457.B687D3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/20632d37b5bcb68bb0ca34238f1ed49c7be3a8f7/ghc >--------------------------------------------------------------- commit 20632d37b5bcb68bb0ca34238f1ed49c7be3a8f7 Author: Simon Peyton Jones Date: Fri Sep 26 10:44:46 2014 +0100 Do not discard insoluble Derived constraints This is preparing for a fix to Trac #9612. The idea is that insoluble constraints are nice solid errors that we should not discard before we have a chance to report them. So TcRnTypes.dropDerivedWC now keeps insoluble Derived constrains, and instead TcSimplify.solve_wanteds filters them out We get somewhat better error message for kind-equality failures too. A slight downside is that to avoid *duplicate* kind-equality failures when we float a kind-incompatible equality (e.g. alpha:* ~ Int#), I've disabled constraint-floating when there are insolubles. But that in turn makes a handful of error messages a little less informative; good examples are mc21, mc22, mc25. But I am re-jigging the constraint floating machinery in another branch, which will make this go back to the way it was before. >--------------------------------------------------------------- 20632d37b5bcb68bb0ca34238f1ed49c7be3a8f7 compiler/typecheck/TcRnTypes.lhs | 44 +++++++++++----------- compiler/typecheck/TcSimplify.lhs | 18 ++++++++- .../tests/indexed-types/should_fail/T3330c.stderr | 22 ++--------- testsuite/tests/typecheck/should_fail/T3950.stderr | 5 ++- testsuite/tests/typecheck/should_fail/T5570.stderr | 3 +- testsuite/tests/typecheck/should_fail/T7368.stderr | 3 +- .../tests/typecheck/should_fail/T7368a.stderr | 7 ++-- testsuite/tests/typecheck/should_fail/T8262.stderr | 3 +- testsuite/tests/typecheck/should_fail/T8603.stderr | 5 ++- testsuite/tests/typecheck/should_fail/mc21.stderr | 4 +- testsuite/tests/typecheck/should_fail/mc22.stderr | 17 +++++---- testsuite/tests/typecheck/should_fail/mc25.stderr | 14 +++---- .../tests/typecheck/should_fail/tcfail090.stderr | 3 +- .../tests/typecheck/should_fail/tcfail122.stderr | 3 +- .../tests/typecheck/should_fail/tcfail123.stderr | 3 +- .../tests/typecheck/should_fail/tcfail159.stderr | 3 +- .../tests/typecheck/should_fail/tcfail200.stderr | 3 +- 17 files changed, 87 insertions(+), 73 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 20632d37b5bcb68bb0ca34238f1ed49c7be3a8f7 From git at git.haskell.org Fri Sep 26 11:35:00 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 11:35:00 +0000 (UTC) Subject: [commit: ghc] master: Wibble to implicit-parameter error message (8c9d0ce) Message-ID: <20140926113500.442A13A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8c9d0ce490506fdc60d9f25d4b80774180cf92ce/ghc >--------------------------------------------------------------- commit 8c9d0ce490506fdc60d9f25d4b80774180cf92ce Author: Simon Peyton Jones Date: Fri Sep 26 10:48:25 2014 +0100 Wibble to implicit-parameter error message >--------------------------------------------------------------- 8c9d0ce490506fdc60d9f25d4b80774180cf92ce compiler/typecheck/TcRnTypes.lhs | 2 +- testsuite/tests/typecheck/should_fail/T5246.stderr | 10 ++++++---- testsuite/tests/typecheck/should_fail/T7525.stderr | 2 +- 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index bff59ee..1be81cb 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -1734,7 +1734,7 @@ pprSkolInfo (SigSkol (FunSigCtxt f) ty) 2 (pprPrefixOcc f <+> dcolon <+> ppr ty) pprSkolInfo (SigSkol cx ty) = hang (pprUserTypeCtxt cx <> colon) 2 (ppr ty) -pprSkolInfo (IPSkol ips) = ptext (sLit "the implicit-parameter bindings for") +pprSkolInfo (IPSkol ips) = ptext (sLit "the implicit-parameter binding") <> plural ips <+> ptext (sLit "for") <+> pprWithCommas ppr ips pprSkolInfo (ClsSkol cls) = ptext (sLit "the class declaration for") <+> quotes (ppr cls) pprSkolInfo InstSkol = ptext (sLit "the instance declaration") diff --git a/testsuite/tests/typecheck/should_fail/T5246.stderr b/testsuite/tests/typecheck/should_fail/T5246.stderr index bd075cb..454c2b7 100644 --- a/testsuite/tests/typecheck/should_fail/T5246.stderr +++ b/testsuite/tests/typecheck/should_fail/T5246.stderr @@ -1,9 +1,11 @@ T5246.hs:11:10: - Could not deduce (?x::Int) arising from a use of ?foo? - from the context (?x::[Char]) - bound by the implicit-parameter bindings for ?x - at T5246.hs:(10,7)-(11,12) + Couldn't match type ?[Char]? with ?Int? + arising from a functional dependency between constraints: + ??x::Int? arising from a use of ?foo? at T5246.hs:11:10-12 + ??x::[Char]? + arising from the implicit-parameter binding for ?x + at T5246.hs:(10,7)-(11,12) In the expression: foo In the expression: let ?x = "hello" in foo In an equation for ?bar?: bar = let ?x = "hello" in foo diff --git a/testsuite/tests/typecheck/should_fail/T7525.stderr b/testsuite/tests/typecheck/should_fail/T7525.stderr index 9524d1a..ecf3eb1 100644 --- a/testsuite/tests/typecheck/should_fail/T7525.stderr +++ b/testsuite/tests/typecheck/should_fail/T7525.stderr @@ -3,7 +3,7 @@ T7525.hs:5:30: Could not deduce (?b::Bool) arising from a use of implicit parameter ??b? from the context (?a::Bool) - bound by the implicit-parameter bindings for ?a at T7525.hs:5:7-31 + bound by the implicit-parameter binding for ?a at T7525.hs:5:7-31 In the second argument of ?(&&)?, namely ??b? In the expression: ?a && ?b In the expression: let ?a = True in ?a && ?b From git at git.haskell.org Fri Sep 26 11:35:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 11:35:03 +0000 (UTC) Subject: [commit: ghc] master: Improve error messages from functional dependencies (1a88f9a) Message-ID: <20140926113503.3CDDE3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1a88f9a4fb373ce52284996212fc23b06848b1c0/ghc >--------------------------------------------------------------- commit 1a88f9a4fb373ce52284996212fc23b06848b1c0 Author: Simon Peyton Jones Date: Fri Sep 26 10:53:32 2014 +0100 Improve error messages from functional dependencies Reponding to Trac #9612: * Track the CtOrigin of a Derived equality, arising from a functional dependency * And report it clearly in the error stream This relies on a previous commit, in which I stop dropping Derived insolubles on the floor. >--------------------------------------------------------------- 1a88f9a4fb373ce52284996212fc23b06848b1c0 compiler/typecheck/FunDeps.lhs | 21 +-- compiler/typecheck/TcErrors.lhs | 61 ++++++--- compiler/typecheck/TcInteract.lhs | 32 +++-- compiler/typecheck/TcRnTypes.lhs | 148 +++++++++++++-------- compiler/typecheck/TcUnify.lhs | 4 +- .../tests/typecheck/should_compile/FD3.stderr | 11 +- .../typecheck/should_fail/FDsFromGivens.stderr | 14 +- testsuite/tests/typecheck/should_fail/T5236.stderr | 13 +- testsuite/tests/typecheck/should_fail/T5978.stderr | 5 +- testsuite/tests/typecheck/should_fail/T9612.hs | 20 +++ testsuite/tests/typecheck/should_fail/T9612.stderr | 20 +++ testsuite/tests/typecheck/should_fail/all.T | 1 + .../tests/typecheck/should_fail/tcfail143.stderr | 5 +- 13 files changed, 247 insertions(+), 108 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1a88f9a4fb373ce52284996212fc23b06848b1c0 From git at git.haskell.org Fri Sep 26 11:35:05 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 11:35:05 +0000 (UTC) Subject: [commit: ghc] master: Two improved error messages (0e16cbf) Message-ID: <20140926113505.B9B0F3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0e16cbf34d5d882c6f4800295db5fa5e2b42c342/ghc >--------------------------------------------------------------- commit 0e16cbf34d5d882c6f4800295db5fa5e2b42c342 Author: Simon Peyton Jones Date: Fri Sep 26 10:54:23 2014 +0100 Two improved error messages I'm not quite sure why these have improved following the previous four commits, but I'm quite happy about it >--------------------------------------------------------------- 0e16cbf34d5d882c6f4800295db5fa5e2b42c342 .../tests/indexed-types/should_fail/T8227.stderr | 14 ++++++-------- .../tests/indexed-types/should_fail/T8518.stderr | 19 +++++++++++++++++++ 2 files changed, 25 insertions(+), 8 deletions(-) diff --git a/testsuite/tests/indexed-types/should_fail/T8227.stderr b/testsuite/tests/indexed-types/should_fail/T8227.stderr index 8d490d6..6bea619 100644 --- a/testsuite/tests/indexed-types/should_fail/T8227.stderr +++ b/testsuite/tests/indexed-types/should_fail/T8227.stderr @@ -1,15 +1,13 @@ -T8227.hs:16:27: - Couldn't match type ?Scalar (V (Scalar (V a)))? with ?Scalar (V a)? - NB: ?Scalar? is a type function, and may not be injective - Expected type: Scalar (V a) - Actual type: Scalar (V (Scalar (V a))) - -> Scalar (V (Scalar (V a))) +T8227.hs:16:44: + Couldn't match type ?Scalar (V a)? + with ?Scalar (V a) -> Scalar (V a)? + Expected type: Scalar (V (Scalar (V a))) + Actual type: Scalar (V a) Relevant bindings include seg :: a (bound at T8227.hs:16:21) eps :: Scalar (V a) (bound at T8227.hs:16:17) absoluteToParam :: Scalar (V a) -> a -> Scalar (V a) (bound at T8227.hs:16:1) + In the first argument of ?arcLengthToParam?, namely ?eps? In the expression: arcLengthToParam eps eps - In an equation for ?absoluteToParam?: - absoluteToParam eps seg = arcLengthToParam eps eps diff --git a/testsuite/tests/indexed-types/should_fail/T8518.stderr b/testsuite/tests/indexed-types/should_fail/T8518.stderr index e5ef99e..d7c2010 100644 --- a/testsuite/tests/indexed-types/should_fail/T8518.stderr +++ b/testsuite/tests/indexed-types/should_fail/T8518.stderr @@ -1,4 +1,23 @@ +T8518.hs:14:18: + Could not deduce (F c ~ Maybe (F c)) + from the context (Continuation c) + bound by the type signature for + callCont :: Continuation c => c -> Z c -> B c -> Maybe (F c) + at T8518.hs:13:13-64 + Relevant bindings include + b :: B c (bound at T8518.hs:14:14) + z :: Z c (bound at T8518.hs:14:12) + c :: c (bound at T8518.hs:14:10) + callCont :: c -> Z c -> B c -> Maybe (F c) (bound at T8518.hs:14:1) + In the expression: rpt (4 :: Int) c z b + In an equation for ?callCont?: + callCont c z b + = rpt (4 :: Int) c z b + where + rpt 0 c' z' b' = fromJust (fst <$> (continue c' z' b')) + rpt i c' z' b' = let ... in rpt (i - 1) c'' + T8518.hs:17:78: Could not deduce (F a1 ~ (Z a1 -> B a1 -> F a1)) from the context (Continuation c) From git at git.haskell.org Fri Sep 26 11:35:08 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 11:35:08 +0000 (UTC) Subject: [commit: ghc] master: Complain about illegal type literals in renamer, not parser (ac157de) Message-ID: <20140926113508.9CD793A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ac157de3cd959a18a71fa056403675e2c0563497/ghc >--------------------------------------------------------------- commit ac157de3cd959a18a71fa056403675e2c0563497 Author: Simon Peyton Jones Date: Fri Sep 26 12:34:13 2014 +0100 Complain about illegal type literals in renamer, not parser A premature complaint was causing Trac #9634. Acutally this change also simplifies the lexer and eliminates duplication. (The renamer was already making the check, as it happens.) >--------------------------------------------------------------- ac157de3cd959a18a71fa056403675e2c0563497 compiler/parser/Lexer.x | 5 ----- compiler/parser/Parser.y.pp | 4 ++-- compiler/parser/RdrHsSyn.lhs | 12 +----------- compiler/rename/RnTypes.lhs | 3 +-- testsuite/tests/parser/should_fail/T3811b.stderr | 2 +- testsuite/tests/typecheck/should_fail/T9634.hs | 3 +++ testsuite/tests/typecheck/should_fail/T9634.stderr | 3 +++ testsuite/tests/typecheck/should_fail/all.T | 1 + testsuite/tests/typecheck/should_fail/tcfail094.stderr | 2 +- 9 files changed, 13 insertions(+), 22 deletions(-) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 8fd5bd9..aa5ddc3 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -65,7 +65,6 @@ module Lexer ( getLexState, popLexState, pushLexState, extension, bangPatEnabled, datatypeContextsEnabled, traditionalRecordSyntaxEnabled, - typeLiteralsEnabled, explicitForallEnabled, inRulePrag, explicitNamespacesEnabled, @@ -1950,7 +1949,6 @@ data ExtBits | NondecreasingIndentationBit | SafeHaskellBit | TraditionalRecordSyntaxBit - | TypeLiteralsBit | ExplicitNamespacesBit | LambdaCaseBit | BinaryLiteralsBit @@ -2002,8 +2000,6 @@ sccProfilingOn :: ExtsBitmap -> Bool sccProfilingOn = xtest SccProfilingOnBit traditionalRecordSyntaxEnabled :: ExtsBitmap -> Bool traditionalRecordSyntaxEnabled = xtest TraditionalRecordSyntaxBit -typeLiteralsEnabled :: ExtsBitmap -> Bool -typeLiteralsEnabled = xtest TypeLiteralsBit explicitNamespacesEnabled :: ExtsBitmap -> Bool explicitNamespacesEnabled = xtest ExplicitNamespacesBit @@ -2074,7 +2070,6 @@ mkPState flags buf loc = .|. NondecreasingIndentationBit `setBitIf` xopt Opt_NondecreasingIndentation flags .|. SafeHaskellBit `setBitIf` safeImportsOn flags .|. TraditionalRecordSyntaxBit `setBitIf` xopt Opt_TraditionalRecordSyntax flags - .|. TypeLiteralsBit `setBitIf` xopt Opt_DataKinds flags .|. ExplicitNamespacesBit `setBitIf` xopt Opt_ExplicitNamespaces flags .|. LambdaCaseBit `setBitIf` xopt Opt_LambdaCase flags .|. BinaryLiteralsBit `setBitIf` xopt Opt_BinaryLiterals flags diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index fcc21e1..e33808d 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -1207,8 +1207,8 @@ atype :: { LHsType RdrName } | '[' ctype ',' comma_types1 ']' { LL $ HsExplicitListTy placeHolderKind ($2 : $4) } - | INTEGER {% mkTyLit $ LL $ HsNumTy $ getINTEGER $1 } - | STRING {% mkTyLit $ LL $ HsStrTy $ getSTRING $1 } + | INTEGER { LL $ HsTyLit $ HsNumTy $ getINTEGER $1 } + | STRING { LL $ HsTyLit $ HsStrTy $ getSTRING $1 } -- An inst_type is what occurs in the head of an instance decl -- e.g. (Foo a, Gaz b) => Wibble a b diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 823be85..6bd5d27 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -20,7 +20,6 @@ module RdrHsSyn ( splitCon, mkInlinePragma, splitPatSyn, toPatSynMatchGroup, mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp - mkTyLit, mkTyClD, mkInstD, cvBindGroup, @@ -261,15 +260,6 @@ mkSpliceDecl lexpr@(L loc expr) where splice = mkHsSplice lexpr -mkTyLit :: Located (HsTyLit) -> P (LHsType RdrName) -mkTyLit l = - do allowed <- extension typeLiteralsEnabled - if allowed - then return (HsTyLit `fmap` l) - else parseErrorSDoc (getLoc l) - (text "Illegal literal in type (use DataKinds to enable):" <+> - ppr l) - mkRoleAnnotDecl :: SrcSpan -> Located RdrName -- type being annotated -> [Located (Maybe FastString)] -- roles @@ -430,7 +420,7 @@ splitCon ty return (data_con, mk_rest ts) split (L l (HsTupleTy _ [])) [] = return (L l (getRdrName unitDataCon), PrefixCon []) -- See Note [Unit tuples] in HsTypes - split (L l _) _ = parseErrorSDoc l (text "parse error in constructor in data/newtype declaration:" <+> ppr ty) + split (L l _) _ = parseErrorSDoc l (text "Cannot parse data constructor in a data/newtype declaration:" <+> ppr ty) mk_rest [L _ (HsRecTy flds)] = RecCon flds mk_rest ts = PrefixCon ts diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs index c719191..38985a4 100644 --- a/compiler/rename/RnTypes.lhs +++ b/compiler/rename/RnTypes.lhs @@ -257,11 +257,10 @@ rnHsTyKi isType doc tupleTy@(HsTupleTy tup_con tys) ; (tys', fvs) <- mapFvRn (rnLHsTyKi isType doc) tys ; return (HsTupleTy tup_con tys', fvs) } --- Perhaps we should use a separate extension here? -- Ensure that a type-level integer is nonnegative (#8306, #8412) rnHsTyKi isType _ tyLit@(HsTyLit t) = do { data_kinds <- xoptM Opt_DataKinds - ; unless (data_kinds || isType) (addErr (dataKindsErr isType tyLit)) + ; unless data_kinds (addErr (dataKindsErr isType tyLit)) ; when (negLit t) (addErr negLitErr) ; return (HsTyLit t, emptyFVs) } where diff --git a/testsuite/tests/parser/should_fail/T3811b.stderr b/testsuite/tests/parser/should_fail/T3811b.stderr index 342354d..e2360b2 100644 --- a/testsuite/tests/parser/should_fail/T3811b.stderr +++ b/testsuite/tests/parser/should_fail/T3811b.stderr @@ -1,3 +1,3 @@ T3811b.hs:4:14: - parse error in constructor in data/newtype declaration: !B + Cannot parse data constructor in a data/newtype declaration: !B diff --git a/testsuite/tests/typecheck/should_fail/T9634.hs b/testsuite/tests/typecheck/should_fail/T9634.hs new file mode 100644 index 0000000..57dea22 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9634.hs @@ -0,0 +1,3 @@ +module T9634 where + +data X = 1 diff --git a/testsuite/tests/typecheck/should_fail/T9634.stderr b/testsuite/tests/typecheck/should_fail/T9634.stderr new file mode 100644 index 0000000..1a2ed05 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9634.stderr @@ -0,0 +1,3 @@ + +T9634.hs:3:10: + Cannot parse data constructor in a data/newtype declaration: 1 diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 431a9ba..960b5c3 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -335,3 +335,4 @@ test('T9305', normal, compile_fail, ['']) test('T9323', normal, compile_fail, ['']) test('T9415', normal, compile_fail, ['']) test('T9612', normal, compile_fail, ['']) +test('T9634', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_fail/tcfail094.stderr b/testsuite/tests/typecheck/should_fail/tcfail094.stderr index c38674b..d3f5e76 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail094.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail094.stderr @@ -1,3 +1,3 @@ tcfail094.hs:7:14: - Illegal literal in type (use DataKinds to enable): 1 + Illegal type: ?1? Perhaps you intended to use DataKinds From git at git.haskell.org Fri Sep 26 12:45:21 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 12:45:21 +0000 (UTC) Subject: [commit: ghc] wip/new-flatten-skolems-Aug14: More progress (286637a) Message-ID: <20140926124521.4C3493A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/new-flatten-skolems-Aug14 Link : http://ghc.haskell.org/trac/ghc/changeset/286637a39ad5ad86724b1adf65a0b1cbd47c8dc9/ghc >--------------------------------------------------------------- commit 286637a39ad5ad86724b1adf65a0b1cbd47c8dc9 Author: Simon Peyton Jones Date: Fri Sep 26 13:44:41 2014 +0100 More progress >--------------------------------------------------------------- 286637a39ad5ad86724b1adf65a0b1cbd47c8dc9 compiler/typecheck/Flattening-notes | 62 +++++++++++++--------- compiler/typecheck/TcInteract.lhs | 19 +++++-- compiler/typecheck/TcSMonad.lhs | 2 +- .../tests/indexed-types/should_fail/GADTwrong1.hs | 11 ++++ .../tests/indexed-types/should_fail/T7729a.hs | 6 +++ .../typecheck/should_compile/TcTypeNatSimple.hs | 10 +--- 6 files changed, 71 insertions(+), 39 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 286637a39ad5ad86724b1adf65a0b1cbd47c8dc9 From git at git.haskell.org Fri Sep 26 13:42:48 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 13:42:48 +0000 (UTC) Subject: [commit: ghc] master: De-tabify and remove trailing whitespace (0ef1cc6) Message-ID: <20140926134248.BECE13A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0ef1cc67dc472493b7dee1a28dedbfe938536b8f/ghc >--------------------------------------------------------------- commit 0ef1cc67dc472493b7dee1a28dedbfe938536b8f Author: Simon Peyton Jones Date: Fri Sep 26 12:58:41 2014 +0100 De-tabify and remove trailing whitespace >--------------------------------------------------------------- 0ef1cc67dc472493b7dee1a28dedbfe938536b8f compiler/basicTypes/MkId.lhs | 154 ++++++------- compiler/basicTypes/OccName.lhs | 395 ++++++++++++++++---------------- compiler/basicTypes/VarSet.lhs | 140 ++++++------ compiler/coreSyn/CoreArity.lhs | 254 ++++++++++----------- compiler/coreSyn/CoreSyn.lhs | 398 ++++++++++++++++---------------- compiler/coreSyn/CoreUnfold.lhs | 466 +++++++++++++++++++------------------- compiler/deSugar/DsArrows.lhs | 418 +++++++++++++++++----------------- compiler/deSugar/DsBinds.lhs | 256 ++++++++++----------- compiler/deSugar/DsUtils.lhs | 180 +++++++-------- compiler/deSugar/MatchCon.lhs | 104 ++++----- compiler/iface/BuildTyCl.lhs | 258 +++++++++++---------- compiler/iface/IfaceEnv.lhs | 148 ++++++------ compiler/simplCore/FloatIn.lhs | 220 +++++++++--------- compiler/simplCore/FloatOut.lhs | 206 ++++++++--------- compiler/typecheck/FamInst.lhs | 76 +++---- compiler/typecheck/Inst.lhs | 148 ++++++------ compiler/typecheck/TcClassDcl.lhs | 184 ++++++++------- compiler/typecheck/TcDefaults.lhs | 69 +++--- compiler/typecheck/TcErrors.lhs | 66 +++--- compiler/typecheck/TcHsType.lhs | 308 ++++++++++++------------- compiler/typecheck/TcMType.lhs | 146 ++++++------ compiler/typecheck/TcMatches.lhs | 352 ++++++++++++++-------------- compiler/typecheck/TcRules.lhs | 89 ++++---- compiler/types/Class.lhs | 94 ++++---- compiler/types/OptCoercion.lhs | 10 +- compiler/types/TypeRep.lhs | 178 +++++++-------- 26 files changed, 2579 insertions(+), 2738 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 0ef1cc67dc472493b7dee1a28dedbfe938536b8f From git at git.haskell.org Fri Sep 26 13:42:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 13:42:51 +0000 (UTC) Subject: [commit: ghc] master: This test should have -XDataKinds (0686897) Message-ID: <20140926134251.4A1313A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/068689703546a5a1b8c300d0307a12d342313707/ghc >--------------------------------------------------------------- commit 068689703546a5a1b8c300d0307a12d342313707 Author: Simon Peyton Jones Date: Fri Sep 26 14:42:26 2014 +0100 This test should have -XDataKinds >--------------------------------------------------------------- 068689703546a5a1b8c300d0307a12d342313707 testsuite/tests/th/T8412.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/th/T8412.hs b/testsuite/tests/th/T8412.hs index 074bb50..5113a94 100644 --- a/testsuite/tests/th/T8412.hs +++ b/testsuite/tests/th/T8412.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, DataKinds #-} import Language.Haskell.TH From git at git.haskell.org Fri Sep 26 13:42:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 13:42:53 +0000 (UTC) Subject: [commit: ghc] master: Comments (2e4f364) Message-ID: <20140926134253.CFE5E3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2e4f36425320f21ebc6039790034df20f2d470f9/ghc >--------------------------------------------------------------- commit 2e4f36425320f21ebc6039790034df20f2d470f9 Author: Simon Peyton Jones Date: Fri Sep 26 14:42:40 2014 +0100 Comments >--------------------------------------------------------------- 2e4f36425320f21ebc6039790034df20f2d470f9 compiler/typecheck/TcSimplify.lhs | 1 + compiler/typecheck/TcUnify.lhs | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index ceb517d..d834763 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -364,6 +364,7 @@ simplifyInfer _top_lvl apply_mr name_taus wanteds else do { -- Step 7) Emit an implication + -- See Trac #9633 for an instructive example let minimal_flat_preds = mkMinimalBySCs bound -- See Note [Minimize by Superclasses] skol_info = InferSkol [ (name, mkSigmaTy [] minimal_flat_preds ty) diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index b66f06b..389c4a3 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -1071,9 +1071,9 @@ We must use the careful function lookupTcTyVar to see if a kind variable is filled or unifiable. It checks for touchablity, and kind variables can certainly be untouchable --- for example the variable might be bound outside an enclosing existental pattern match that -binds an inner kind variable, which we don't want ot escape outside. +binds an inner kind variable, which we don't want to escape outside. -This, or something closely related, was teh cause of Trac #8985. +This, or something closely related, was the cause of Trac #8985. Note [Unifying kind variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Fri Sep 26 15:51:33 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 15:51:33 +0000 (UTC) Subject: [commit: ghc] wip/new-flatten-skolems-Aug14: Merge branch 'master' into wip/new-flatten-skolems-Aug14 (a74611b) Message-ID: <20140926155133.B7AD03A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/new-flatten-skolems-Aug14 Link : http://ghc.haskell.org/trac/ghc/changeset/a74611b92882320ee2ed1f8d8e9e7b3c7ec02cd9/ghc >--------------------------------------------------------------- commit a74611b92882320ee2ed1f8d8e9e7b3c7ec02cd9 Merge: 88a007c 2e4f364 Author: Simon Peyton Jones Date: Fri Sep 26 14:57:23 2014 +0100 Merge branch 'master' into wip/new-flatten-skolems-Aug14 Conflicts: compiler/typecheck/Inst.lhs compiler/typecheck/TcMType.lhs compiler/typecheck/TcRnTypes.lhs compiler/typecheck/TcSimplify.lhs compiler/typecheck/TcUnify.lhs testsuite/tests/indexed-types/should_compile/T3017.stderr testsuite/tests/indexed-types/should_fail/T7729.stderr testsuite/tests/indexed-types/should_fail/T8227.stderr testsuite/tests/indexed-types/should_fail/T8518.stderr >--------------------------------------------------------------- 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 a74611b92882320ee2ed1f8d8e9e7b3c7ec02cd9 From git at git.haskell.org Fri Sep 26 15:51:36 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 15:51:36 +0000 (UTC) Subject: [commit: ghc] wip/new-flatten-skolems-Aug14: More flatten-skolem progress (9b5c9af) Message-ID: <20140926155136.5CAAC3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/new-flatten-skolems-Aug14 Link : http://ghc.haskell.org/trac/ghc/changeset/9b5c9aff4271f3f979c7c63b031e36d55d679c56/ghc >--------------------------------------------------------------- commit 9b5c9aff4271f3f979c7c63b031e36d55d679c56 Author: Simon Peyton Jones Date: Fri Sep 26 16:48:16 2014 +0100 More flatten-skolem progress >--------------------------------------------------------------- 9b5c9aff4271f3f979c7c63b031e36d55d679c56 compiler/typecheck/Flattening-notes | 30 ++++++++++++++++++++++++++++++ compiler/typecheck/Inst.lhs | 2 +- compiler/typecheck/TcRnTypes.lhs | 1 - compiler/typecheck/TcSMonad.lhs | 1 - compiler/typecheck/TcUnify.lhs | 2 +- 5 files changed, 32 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/Flattening-notes b/compiler/typecheck/Flattening-notes index 77ab2fd..e3eecf3 100644 --- a/compiler/typecheck/Flattening-notes +++ b/compiler/typecheck/Flattening-notes @@ -27,6 +27,36 @@ ToDo: * Check orientation (isFlattenTyVar) in canEqTyVarTyVar +---------------------- +Outer given is rewritten by an inner given, then there must have been an inner given equality, hence the ?given-eq? flag will be true anyway. + +Inner given rewritten by outer, retains its level (ie. The inner one) + +-------------------- +Try: rewrite wanted with wanted only for fuvs (not all meta-tyvars) + +But: fuv ~ alpha[0] + alpha[0] ~ fuv? +Now we don?t see that fuv ~ fuv?, which is a problem for injectivity detection. + +Conclusion: rewrite watneds with wanted for all untouchables. + +skol ~ untch, must re-orieint to untch ~ skol, so that we can use it to rewrite. + + +-------------- +f :: [a] -> [b] -> blah +f (e1 :: F Int) (e2 :: F Int) + +we get + F Int ~ fuv + fuv ~ [alpha] + fuv ~ [beta] + +We want: alpha := beta (which might unlock something else). So rewriting wanted with wanted helps here. + + + ---------------------------------------- typecheck/TcTypeNatSimple diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs index 242ff28..ed77706 100644 --- a/compiler/typecheck/Inst.lhs +++ b/compiler/typecheck/Inst.lhs @@ -504,7 +504,7 @@ addClsInstsErr herald ispecs tyVarsOfCt :: Ct -> TcTyVarSet tyVarsOfCt (CTyEqCan { cc_tyvar = tv, cc_rhs = xi }) = extendVarSet (tyVarsOfType xi) tv tyVarsOfCt (CFunEqCan { cc_tyargs = tys, cc_fsk = fsk }) = extendVarSet (tyVarsOfTypes tys) fsk -tyVarsOfCt (CDictCan { cc_tyargs = tys }) = tyVarsOfTypes tys +tyVarsOfCt (CDictCan { cc_tyargs = tys }) = tyVarsOfTypes tys tyVarsOfCt (CIrredEvCan { cc_ev = ev }) = tyVarsOfType (ctEvPred ev) tyVarsOfCt (CHoleCan { cc_ev = ev }) = tyVarsOfType (ctEvPred ev) tyVarsOfCt (CNonCanonical { cc_ev = ev }) = tyVarsOfType (ctEvPred ev) diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index 9a30468..ac87ac6 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -1888,7 +1888,6 @@ pprCtOrigin simple_origin ---------------- pprCtO :: CtOrigin -> SDoc -- Ones that are short one-liners -pprCtO FlatSkolOrigin = ptext (sLit "a given flatten-skolem") pprCtO (OccurrenceOf name) = hsep [ptext (sLit "a use of"), quotes (ppr name)] pprCtO AppOrigin = ptext (sLit "an application") pprCtO (SpecPragOrigin name) = hsep [ptext (sLit "a specialisation pragma for"), quotes (ppr name)] diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index b653d9e..9ba34e6 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -126,7 +126,6 @@ import Name import RdrName (RdrName, GlobalRdrEnv) import RnEnv (addUsedRdrNames) import Var -import VarSet import VarEnv import VarSet import Outputable diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index 389c4a3..789c6ff 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -451,7 +451,7 @@ newImplication skol_info skol_tvs given thing_inside ; env <- getLclEnv ; emitImplication $ Implic { ic_untch = untch , ic_skols = skol_tvs - , ic_fsks = [] + , ic_fsks = emptyCts , ic_no_eqs = False , ic_given = given , ic_wanted = wanted From git at git.haskell.org Fri Sep 26 15:51:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 15:51:39 +0000 (UTC) Subject: [commit: ghc] wip/new-flatten-skolems-Aug14: Merge branch 'wip/new-flatten-skolems-Aug14' of https://git.haskell.org/ghc into wip/new-flatten-skolems-Aug14 (c5f6308) Message-ID: <20140926155139.9852C3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/new-flatten-skolems-Aug14 Link : http://ghc.haskell.org/trac/ghc/changeset/c5f6308d43461de436756f1b396b1287eee6598b/ghc >--------------------------------------------------------------- commit c5f6308d43461de436756f1b396b1287eee6598b Merge: 9b5c9af 286637a Author: Simon Peyton Jones Date: Fri Sep 26 16:51:20 2014 +0100 Merge branch 'wip/new-flatten-skolems-Aug14' of https://git.haskell.org/ghc into wip/new-flatten-skolems-Aug14 Conflicts: testsuite/tests/indexed-types/should_fail/T7729a.hs >--------------------------------------------------------------- c5f6308d43461de436756f1b396b1287eee6598b compiler/typecheck/Flattening-notes | 62 +++++++++++++--------- compiler/typecheck/TcInteract.lhs | 19 +++++-- compiler/typecheck/TcSMonad.lhs | 2 +- .../tests/indexed-types/should_fail/GADTwrong1.hs | 11 ++++ .../tests/indexed-types/should_fail/T7729a.hs | 7 +++ .../typecheck/should_compile/TcTypeNatSimple.hs | 10 +--- 6 files changed, 72 insertions(+), 39 deletions(-) diff --cc testsuite/tests/indexed-types/should_fail/T7729a.hs index ea36e32,7fad7ea..ad3fca5 --- a/testsuite/tests/indexed-types/should_fail/T7729a.hs +++ b/testsuite/tests/indexed-types/should_fail/T7729a.hs @@@ -34,3 -26,9 +34,10 @@@ instance MonadTrans Rand wher instance MonadPrim m => MonadPrim (Rand m) where type BasePrimMonad (Rand m) = BasePrimMonad m liftPrim x = liftPrim (lift x) -- This line changed from T7729 + + {- + liftPrim :: BasePrimMonad (Rand m) a -> Rand m a + = BasePrimMonad m -> Rand m a + + -} ++ From git at git.haskell.org Fri Sep 26 15:51:44 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 15:51:44 +0000 (UTC) Subject: [commit: ghc] wip/new-flatten-skolems-Aug14's head updated: Merge branch 'wip/new-flatten-skolems-Aug14' of https://git.haskell.org/ghc into wip/new-flatten-skolems-Aug14 (c5f6308) Message-ID: <20140926155144.A3D3D3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/new-flatten-skolems-Aug14' now includes: 578fbec Dont allow hand-written Generic instances in Safe Haskell. e69619e Allow warning if could have been infered safe instead of explicit Trustworthy label. 105602f Update Safe Haskell typeable test outputs. fbd0586 Infer safety of modules correctly with new overlapping pragmas. ab90bf2 Add in (disabled for now) test of a Safe Haskell bug. f293931 Add missing *.stderr files 44853a1 Terminate in forkProcess like in real_main df1e775 docs: fix typo: 'OVERLAPPINGP' -> 'OVERLAPPING' 637978f Use 'install' command for 'inplace/' install as we do in 'make install' 65e5dbc fix linker_unload test on Solaris/i386 platform f686682 ghc --make: add nicer names to RTS threads (threaded IO manager, make workers) 7328deb fix openFile003 test on Solaris/i386 (platform output is not needed anymore) 1f24a03 fix topHandler03 execution on Solaris where shell signals SIGTERM correctly edff1ef Disable package auto-hiding if -hide-all-packages is passed 66218d1 Package keys (for linking/type equality) separated from package IDs. 3663791 Disable ghc-pkg accepting multiple package IDs (differing package keys) for now. de3f064 Make PackageState an abstract type. 00b8f8c Refactor package state, also fixing a module reexport bug. 4accf60 Refactor PackageFlags so that ExposePackage is a single constructor. 2078752 Thinning and renaming modules from packages on the command line. 94b2b22 [no-ci] Minor bugfixes in Backpack docs. 7479df6 configure.ac: drop unused VOID_INT_SIGNALS 56ca32c Update Haddock submodule to know about profiling. d360d44 Filter out null bytes from trace, and warn accordingly, fixing #9395. c88559b Temporarily bump Haddock numbers; I'm going to fix it. 8e400d2 Revert "fix linker_unload test on Solaris/i386 platform" f4904fb Mark type-rep not as expect_broken when debugged f42fa9b fix linker_unload test _FILE_OFFSET_BITS redefined warning on Solaris/i386 2b3c621 fix linker_unload test for ghc configurations with --with-gmp-libraries 24a2e49 fix T658b/T5776 to use POSIX grep -c instead of GNU's --count 61baf71 Comments and white space 31399be Move Outputable instance for FloatBind to the data type definition d3fafbb Tiny refactoring, plus comments; no change in behaviour 93b1a43 Add Output instance for OrdList 6b96557 Make Core Lint check the let/app invariant 1736082 Don't float into unlifted function arguments 1fc60ea When desugaring Use the smart mkCoreConApps and friends d174f49 Make buildToArrPReprs obey the let/app invariant db17d58 Document the maintenance of the let/app invariant in the simplifier ab6480b Extensive Notes on can_fail and has_side_effects 8367f06 Refactor the handling of case-elimination 0957a9b Add has_side_effets to the raise# primop 2990e97 Test Trac #9390 18ac546 Fix some typos in recent comments/notes 4855be0 Give the Unique generated by strings a tag '$', fixes #9413. d026e9e Permanently accept the Haddock performance number bump, and add some TODOs c51498b [no-ci] Track Haddock submodule change: ignore TAGS. af1fc53 ghci: tweak option list indentation in ':show packages' 2cca0c0 testsuite: add signal_exit_code function to the driver d0ee4eb Update perf number for T5642 7d52e62 Update Haddock to attoparsec-0.12.1. Adjust perf. dff0623 Implement the final change to INCOHERENT from Trac #9242 ca3fc66 Fix path in cabal file 16776e9 configure.ac: drop unused HAVE_BIN_SH a2ac57b Tweak Haddock markup in GHC.Magic 4e020b3 Tweak Haddock in GHC.Types 44c1e3f testsuite: add list of llvm_ways caa9c8aa Add test case for #9013 8e01ca6 Remove obsolete "-- #hide" Haddock pragmas b7b7633 Add a test for plusWord2#, addIntC#, subIntC# e83e873 Clarify documentation of addIntC#, subIntC# 3260467 systools info: fix warning about C compiler (message said about linker) ba9277c Tweak linting rules. 02be4ff fix T4201 to avoid GNU grep specific -B option by usage of pure POSIX tools 2396940 fix T4981-V3 and T9208 tests for no newline at end of file warning ba3650c fix T4981-V3 to avoid DOS line endings bb00308 Don't build or test dph by default 238fd05 change topHandler02/topHandler03 tests to use signal_exit_code function 7a754a9 rts/Printer.c: drop zcode mangling/demangling support in C code b02fa3b rts: Remove trailing whitespace and tabs from Printer.c 8d90ffa fix darwin threaded static linking by removing -lpthread option #9189 cbfa107 Improve seq documentation; part of trac issue #9390 c80d238 Eliminate some code duplication in x86 backend (genCCall32/64) 5f5d662 Make IntAddCOp, IntSubCOp into GenericOps 71bd4e3 x86: Always generate add instruction in MO_Add2 (#9013) 8e64151 stg/Prim.h: drop redundant #ifdef 6e3c44e Unbreak travis by not passing --no-dph 0a3944c testsuite/base: update .gitignore 3694d87 Re-add `--no-dph` option to ./validate 3669b60 Add bit scan {forward,reverse} insns to x86 NCG 9f285fa Add CMOVcc insns to x86 NCG 6415191 x86: zero extend the result of 16-bit popcnt instructions (#9435) a09508b Test #9371 (indexed-types/should_fail/T9371) f29bdfb Fix Trac #9371. 1b13886 Fix #9415. 1a3e19d Test #9415 (typecheck/should_fail/T9415) 8d27c76 Test #9200. (polykinds/T9200) 6485930 Change definition of CUSK for data and class definitions (#9200). 3dfd3c3 Added more testing for #9200. (polykinds/T9200b) b2c6167 Change treatment of CUSKs for synonyms and families (#9200). 578377c Remove NonParametricKinds (#9200) 1c66b3d Update manual (#9200). 91a48c5 Testsuite wibbles around #9200 6f862df shouldInlinePrimOp: Fix Int overflow a6fd7b5 Add some Haddocks to SMRep 4342049 StgCmmPrim: add note to stop using fixed size signed types for sizes 5e46e1f Have ghc-pkg use an old-style package key when it's not provided. 2272c50 Explicitly version test for package key support. 6b5ea61 Remove out of date TODO e0c1767 Implement new CLZ and CTZ primops (re #9340) 03a8003 Declare `ghc-head` to be haddock's upstream branch 5895f2b LlvmMangler: Be more selective when mangling object types d39c434 Make configure's sed(1) expression for GHC_LDFLAGS more BSD-friendly. 246436f Implement {resize,shrink}MutableByteArray# primops 425d517 Fix typos 'resizze' 53cc943 Revert "Fix typos 'resizze'" this is z-encoding (as hvr tells me) 6375934 Workaround GCC `__ctzdi2` intrinsic linker errors 96d0418 Remove obsolete `digitsTyConKey :: Unique` 2d42564 workaround Solaris 11 GNU C CPP issue by using GNU C 3.4 as CPP 2aabda1 Fix quasi-quoter documentation (#9448) daef885 Fix broken link in Data.Data to SYB home page (Trac #9455) b287bc9 Update list of flags implied by -XGADTs in User's Guide section on GADTs a72614c Make T8832 operative on 32-bit systems (#8832) 3a67aba ghci/scripts/ghci016: Add implementation for negate 5b11b04 concurrent/should_run/throwto002: DoRec -> RecursiveDo 5d5655e Fix three problems with occurrence analysis on case alternatives. 88b1f99 testsuite/T9379: Use GHC.Conc instead of Control.Concurrent.STM 6f6ee6e Make Prelude.abs handle -0.0 correctly (#7858) d9a2057 Make Prelude.signum handle -0.0 correctly (#7858) bbd0311 Bug #9439: Ensure that stage 0 compiler isn't affected 9a708d3 UNREG: fix PackageKey emission into .hc files 0138110 Implement -rdynamic in Linux and Windows/MinGW32. d2f0100 Have the RTS linker search symbols in the originating windows binary. 955dfcb This note's name has been fixed 4333a91 includes/stg/Prim.h: add matching 'hs_atomic_*' prototypes e3c3586 Use absolute links to Cabal docs from the GHC users guide (#9154) 89f5f31 Explain how to clone GitHub forks. Ticket #8379. 2fc2294 Mention that `Data.Ix` uses row-major indexing 527bcc4 build: require GHC 7.6 for bootstrapping defc42e Add test case for #9046 806d823 Correct checkStrictBinds for generalised type 7012ed8 Check if file is present instead of directory 51a0b60 travis: Use hvr?s multi-ghc-PPA f9f89b7 rts/base: Fix #9423 f328890 validate: add simple CPU count autodetection 15faa0e Fix prepositions in the documentation of -rdynamic. 7bf49f8 Make sure that a prototype is included for 'setIOManagerControlFd' 27c99a1 Comments fix to Trac #9140 11f05c5 coreSyn: detabify/dewhitespace TrieMap 236e2ea stranal: detabify/dewhitespace WorkWrap 96c3599 simplCore: detabify/dewhitespace SAT fb9bc40 utils: detabify/dewhitespace BufWrite a9f5c81 utils: detabify/dewhitespace GraphBase e3a5bad utils: detabify/dewhitespace GraphPpr 6f01f0b simplCore: detabify/dewhitespace SetLevels 28a8cd1 simplCore: detabify/dewhitespace LiberateCase ef9dd9f prelude: detabify/dewhitespace TysPrim fbdc21b coreSyn: detabify/dewhitespace CoreTidy ffc1afe coreSyn: detabify/dewhitespace CoreSubst 8396e44 deSugar: detabify/dewhitespace DsCCall 07d01c9 stranal: detabify/dewhitespace DmdAnal 8a8ead0 hsSyn: detabify/dewhitespace HsLit 99f6224 basicTypes: detabify/dewhitespace Var 1ad35f4 basicTypes: detabify/dewhitespace NameSet 1b55153 basicTypes: detabify/dewhitespace NameEnv 37743a1 basicTypes: detabify/dewhitespace IdInfo a2d2546 genprimopcode: Don't output tabs 067bb0d Update a comment in base cbits 92bb7be Add a missing newline to a GHCi linker debugBelch ff4f844 rts: detabify/dewhitespace Ticky.c b4c7bcd rts: detabify/dewhitespace Weak.c dea58de rts: detabify/dewhitespace Updates.h 514a631 rts: detabify/dewhitespace Timer.c 43c68d6 rts: detabify/dewhitespace Trace.c 221c231 rts: detabify/dewhitespace STM.c c49f2e7 rts: reflow some comments in STM.c 4cbf966 rts: detabify/dewhitespace Task.c 684be04 rts: detabify/dewhitespace sm/Storage.h f20708c rts: detabify/dewhitespace sm/BlockAlloc.c 2f3649e rts: detabify/dewhitespace sm/MarkWeak.c 08093a9 rts: detabify/dewhitespace sm/GCAux.c 7e60787 rts: detabify/dewhitespace sm/GCUtils.h 7318aab rts: detabify/dewhitespace sm/GCUtils.c b7b427f rts: detabify/dewhitespace sm/MBlock.c 870cca8 rts: detabify/dewhitespace Apply.cmm 93ec914 rts: detabify/dewhitespace Hpc.c 219785b rts: detabify/dewhitespace Printer.h ee0e47d rts: detabify/dewhitespace Task.h c71ab57 rts: detabify/dewhitespace AutoApply.h ef02edc rts: detabify/dewhitespace StgStdThunks.cmm 1a6a610 rts: detabify/dewhitespace StgStartup.cmm 2f34ab2 rts: detabify/dewhitespace StgPrimFloat.c 584d459 rts: detabify/dewhitespace StgPrimFloat.h 7d48356 rts: detabify/dewhitespace Sparks.c 8f3611e rts: detabify/dewhitespace RtsMain.c b9ee7e8 rts: detabify/dewhitespace RtsAPI.c 00878c5 rts: detabify/dewhitespace RtsStartup.c 646f214 rts: detabify/dewhitespace RtsUtils.c f2864e9 rts: detabify/dewhitespace Disassembler.c 7200edf rts: detabify/dewhitespace LdvProfile.c 15df6d9 Comment why the include is necessary c867cbc [ci skip] includes: detabify/dewhitespace Stg.h 772ffbe [ci skip] includes: detabify/dewhitespace RtsAPI.h 6f3dd98 [ci skip] includes: detabify/dewhitespace Rts.h a784afc [ci skip] includes: detabify/dewhitespace HsFFI.h e183e35 [ci skip] includes: detabify/dewhitespace Cmm.h e232967 [ci skip] includes: detabify/dewhitespace stg/Regs.h efcf0ab [ci skip] includes: detabify/dewhitespace stg/SMP.h e7dd073 [ci skip] includes: detabify/dewhitespace stg/Types.h c607500 [ci skip] includes: detabify/dewhitespace rts/Ticky.h a739416 [ci skip] includes: detabify/dewhitespace rts/Threads.h 2957736 [ci skip] includes: detabify/dewhitespace rts/Stable.h 7d26398 [ci skip] includes: detabify/dewhitespace rts/OSThreads.h bb70e33 [ci skip] includes: detabify/dewhitespace rts/Hpc.h 1c43f62 [ci skip] includes: detabify/dewhitespace rts/prof/CCS.h f20c663 [ci skip] includes: detabify/dewhitespace rts/prof/LDV.h aa045e5 [ci skip] includes: detabify/dewhitespace rts/storage/MBlock.h e57a29a [ci skip] includes: detabify/dewhitespace rts/storage/TSO.h f6cdf04 [ci skip] includes: detabify/dewhitespace rts/storage/Closures.h b4ec067 [ci skip] includes: detabify/dewhitespace rts/storage/GC.h e9e3cf5 [ci skip] includes: detabify/dewhitespace rts/storage/Block.h 98b1b13 [ci skip] includes: detabify/dewhitespace rts/storage/InfoTables.h 840a1cb includes: detabify/dewhitespace rts/storage/ClosureMacros.h 955db0d T8832: fix no newline at end of file warning 030549a Fix #9465. f9e9e71 gitignore: Ignore tests/rts/rdynamic bf1b117 submodule update hpc/stm with gitignore. 22520cd Do not zero out version number when processing wired-in packages. 4748f59 Revert "rts/base: Fix #9423" 2719526 Normalise GHC version number to make tests less fragile. d333c03 Enable GHC API tests by default. ff9f4ad testsuite: T7815 requires SMP support from ghc fcdd58d testsuite: disable gcc's warnings about casts of incompatible prototypes in UNREG eb64be7 testsuite: disable memcpy asm comparison tests on UNREG 2fcb36e testsuite: mark testwsdeque mark as faulty on NOSMP builds 104a66a rts/Linker.c: declare 'deRefStablePtr' as an exported 'rts' symbol cfd08a9 Add MO_AddIntC, MO_SubIntC MachOps and implement in X86 backend e1d77a1 testsuite: added 'bytes allocated' for T9339 wordsize(32) 78ba9f0 Declare official GitHub home of libraries/{directory,process} 5295cd2 testsuite: add 16-byte case for T9329 9f8754e Use DumpStyle rather than UserStyle for pprTrace output c0fe1d9 Introduce the Call data types af4bc31 Do not duplicate call information in SpecConstr (Trac #8852) 5c4df28 More refactoring in SpecConstr 8ff4671 Make Core Lint check for un-saturated type applications ee4501b Check for un-saturated type family applications 06600e7 Two buglets in record wild-cards (Trac #9436 and #9437) 67a6ade Improve documentation of record wildcards 43f1b2e UNREG: fix emission of large Integer literals in C codegen a93ab43 driver: pass '-fPIC' option to assembler as well 78863ed Revert "disable shared libs on sparc (linux/solaris) (fixes #8857)" e9cd1d5 Less voluminous output when printing continuations 6e0f6ed Refactor unfoldings 3af1adf Kill unused setUnfoldingTemplate 8f09937 Make maybeUnfoldingTemplate respond to DFunUnfoldings 9cf5906 Make worker/wrapper work on INLINEABLE things 4c03791 Specialise Eq, Ord, Read, Show at Int, Char, String 3436333 Move the Enum Word instance into GHC.Enum 949ad67 Don't float out (classop dict e1 e2) 2ef997b Slightly improve fusion rules for 'take' 99178c1 Specialise monad functions, and make them INLINEABLE baa3c9a Wibbles to "...plus N others" error message about instances in scope a3e207f More SPEC rules fire dce7095 Compiler performance increases -- yay! b9e49d3 Add -fspecialise-aggressively fa582cc Fix an egregious bug in the NonRec case of bindFreeVars 6d48ce2 Make tidyProgram discard speculative specialisation rules 86a2ebf Comments only 1122857 Run float-inwards immediately before the strictness analyser. 082e41b Testsuite wibbles bb87726 Performance changes a0b2897 Simple refactor of the case-of-case transform 6c6b001 Remove dead lookup_dfun_id (merge-o) 39ccdf9 White space only a1a400e Testsuite wibbles 1145568 testsuite: disable T367_letnoescape on 'optllvm' 75d998b testsuite: disable 'rdynamic' for 'ghci' way 94926b1 Add an interesting type-family/GADT example of deletion for red-black trees 87c1568 Comments only b7bdf13 Temporary fix to the crash aa49892 [ci skip] ghc-prim: Update .gitignore 8270ff3 [ci skip] Update .gitignore 9072f2f PprC: cleanup: don't emit 'FB_' / 'FE_' in via-C 49370ce Improve trimming of auto-rules 4a87142 Fix syntax in perf/compiler/all.T 7eae141 White space only 2da63c6 Better compiler performance (30% less allocation) for T783! dfc9d30 Define mapUnionVarSet, and use it 8df3159 Rename red-black test in indexed-types to red-black-delete db5868c In GHC.Real, specialise 'even' and 'odd' to Int and Integer 9fae691 Improve "specImport discarding" message b2affa0 Testsuite wibbles 69e9f6e Simplify conversion in binary serialisation of ghc-pkg db 557c8b8 Drop support for single-file style package databases ce29a26 Improve the ghc-pkg warnings for missing and out of date package cache files 8d7a1dc Introduce new file format for the package database binary cache 27d6c08 Use ghc-local types for packages, rather than Cabal types 0af7d0c Move Cabal Binary instances from bin-package-db to ghc-pkg itself 9597a25 Drop ghc library dep on Cabal 227205e Make binary a boot package 6930a88 Fix warnings arising from the package db refactoring 29f84d3 Fix long lines and trailing whitespace 8955b5e Remove a TODO that is now done a4cb9a6 Add a ghc -show-packages mode to display ghc's view of the package env 1bc2a55 Make mkFastStringByteString pure and fix up uses c72efd7 Switch the package id types to use FastString (rather than String) b00deb7 Fix string conversions in ghc-pkg to be correct w.r.t. Unicode 42f99e9 Address a number of Edward's code review comments 9d6fbcc Fix validation error in Linker arising from package rep changes 01461ce Update Cabal and haddock submodules to follow the Canal-dep removal changes da72898 Change testsuite to not use old-style file package databases 616dd87 Fix a few minor issues spotted in code review 6d8c70c Add release notes about ghc-pkg change, and Cabal dep removal 020bd49 Fix failing test on BINDIST=YES cb2ac47 Suppress binary warnings for bootstrapping as well as stage1. f0db185 Include pattern synonyms as AConLikes in the type environment, even for simplified/boot ModDetails (fixes #9417) 4e0e774 Fix a bug in CSE, for INLINE/INLNEABLE things ab4c27e Comments, white space, and rename "InlineRule" to "stable unfolding" 3521c50 When finding loop breakers, distinguish INLINE from INLINEABLE 7af33e9 Better specImport discarding message (again) e5f766c Give the worker for an INLINABLE function a suitably-phased Activation 3935062 Finally! Test Trac #6056 5da580b Performance improvement of the compiler itself fa9dd06 Do not say we cannot when we clearly can 9491fea Typos in comments eac8728 Fix to bin-package-db for ming32-only code 985e367 testsuite: normalise integer library name for T8958 0dc2426 Some typos 54db6fa Revert "Comment why the include is necessary" b760cc5 Revert "Make sure that a prototype is included for 'setIOManagerControlFd'" 393b820 Re-export Word from Prelude (re #9531) a8a969a Add `FiniteBits(count{Leading,Trailing}Zeros)` 737f368 `M-x delete-trailing-whitespace` & `M-x untabify`... 3241ac5 Remove incorrect property in docstring (re #9532) a4ec0c9 Make ghc-api cleaning less aggressive. 01a27c9 testsuite: update T6056 rule firing order e81e028 includes/Stg.h: remove unused 'wcStore' inline 9e93940 StringBuffer should not contain initial byte-order mark (BOM) 0f31c2e Cleanup and better documentation of sync-all script 64c9898 Make Lexer.x more like the 2010 report 3be704a genprimopcode: GHC.Prim is Unsafe (#9449) 2f343b0 Refactor stack squeezing logic 918719b Set llc and opt commands on all platforms 9711f78 Fix a couple test failures encountered when building on Windows 4d4d077 systools: fix gcc version detecton on non-english locale 31f43e8 Revert "Fix a couple test failures encountered when building on Windows" 8c427eb Remove max_bytes_used test from haddock test cases 8b107b5 rts/Printer.c: update comments about using USING_LIBBFD 9692393 configure.ac: cleanup: remove unused 'HaveLibDL' subst 1719c42 Update nofib submodule: Hide Word from Prelude e428b5b Add Data.List.uncons 89baab4 Revert "Remove max_bytes_used test from haddock test cases" 498d7dd Do not test max_bytes_used et. al for haddock tests b5a5776 Update performance numbers (mostly improved) 3034dd4 Another test for type function saturation 4c359f5 Small improvement to unsaturated-type-function error message 6af1c9b Add missing changelog/since entry for `uncons` e18525f pprC: declare extern cmm primitives as functions, not data 55e4e5a Revert "Do not test max_bytes_used et. al for haddock tests" 7bf7ca2 Do not use max_bytes_used for haddock test 7d3f2df PostTcType replaced with TypeAnnot 5a1def9 Update T4801 perf numbers 78209d7 INLINE unfoldr f0e725a Typos 049bef7 rules: cleanup: use '$way_*suf' var instead of open-coded '($3_way_)s' fdfe6c0 rules: fix buld failure due to o-boot suffix typo d94de87 Make Applicative a superclass of Monad 0829f4c base: Bump version to 4.8.0.0 27a642c Revert "base: Bump version to 4.8.0.0" c6f502b Bump `base` version to 4.8.0.0 for real 68ecc57 base: replace ver 4.7.1.0 references by 4.8.0.0 841924c build.mk.sample: Stage1 needn't be built with -fllvm 1e40037 Update nofib submodule to fix errors in main suite. f3d2694 Update nofib submodule to track gc bitrot updates. 6477b3d testsuite: AMPify ioprof.hs 29e50da testsuite: AMPify T3001-2 71c8530 Update performance numbers 57fd8ce Fix T5321Fun perf number 23e764f T4801 perf numbers: Another typo c0c1772 Kill obsolete pre GHC 7.6 bootstrapping support 0b54f62 Make GHC `time-1.5`-ready 695d15d Update nofib submodule: Update gitignore with more generated files 946cbce Fix support for deriving Generic1 for data families (FIX #9563) 9d71315 Remove obsolete comment about (!!) b10a7a4 base: Drop obsolete/redundant `__GLASGOW_HASKELL__` checks b53c95f Move ($!) from Prelude into GHC.Base 45cd30d Follow-up to b53c95fe621d3a66a82e6dad383e1c0c08f3871e 6999223 Fixup test-case broken by Follow-up to b53c95fe621 abff2ff Move docstring of `seq` to primops.txt.pp 2cd76c1 Detabify primops.txt.pp 5fbd4e36 Update haskell2010 submodule 39e206a Update libffi-tarballs submodule to libffi 3.1 (re #8701) 004c5f4 Tweak perf-numbers for T1969 and T4801 c0fa383 Export `Traversable()` and `Foldable()` from Prelude df2fa25 base: Remove bunk default impl of (>>=) 65f887e base: Add some notes about the default impl of '(>>)' b72478f Don't offer hidden modules for autocomplete. f8ff637 Declare official GitHub home of libraries/filepath a9b5d99 Mark T8639_api/T8628 as PHONY 72d6d0c Update config.{guess,sub} to GNU automake 1.14.1 d24a618 Follow-up to 72d6d0c2704ee6d9 updating submodules for real 628b21a haskeline: update submodule to fix Windows breakage cdf5a1c Add special stdout for hClose002 on x64 Solaris cfd8c7d Find the target gcc when cross-compiling 3681c88 Fix cppcheck warnings fe9f7e4 Remove special casing of singleton strings, split all strings. 52eab67 Add the ability to :set -l{foo} in ghci, fix #1407. caf449e Return nBytes instead of nextAddr from utf8DecodeChar 7e658bc Revert "Revert "rts/base: Fix #9423"" and resolve issue that caused the revert. e7a0f5b Fix typo "Rrestriction" in user's guide (lspitzner, #9528) b475219 Move `Maybe`-typedef into GHC.Base 1574871 Re-add SPECIALISE liftM* pragmas dropped in d94de87252d0fe 9b8e24a Typo 74f0e15 Simplify 3c28290 Typo in comment b62bd5e Implement `decodeDouble_Int64#` primop 2622eae Remove unnecessary imports in GHC.Event.KQueue to fix compiler warnings. 393f0bb Comments only: explain checkAxInstCo in OptCoercion a8d7f81 Update haddock submodule for package key fix. c4c8924 Fix formatting bug in core-spec. 8b90836 Move (=<<) to GHC.Base eae1911 Move `when` to GHC.Base a94dc4c Move Applicative/MonadPlus into GHC.Base fbf1e30 Move Control.Monad.void into Data.Functor af22696 Invert module-dep between Control.Monad and Data.Foldable b406085 Generalise Control.Monad.{sequence_,msum,mapM_,forM_} ed58ec0 Revert "Update haddock submodule for package key fix." 275dcaf Add -fwarn-context-quantification (#4426) 8c79dcb Update haddock submodule (miscellaneous fixes) e12a6a8 Propositional equality for Datatype meta-information 0a8e6fc Make constructor metadata parametrized (with intended parameter <- datatype) f097b77 Implement sameConstructor cc618e6 get roles right and fix a FIXME 79c7125 Actually parametrize the Constructor with the Datatype 7bd4bab Supply a reasonable name (should be derived from d_name tho) 09fcd70 Use 'd_name' as the name (should be derived from d_name tho) 4d90e44 Add default case (fixes -Werror) 6d84b66 Revert accidental wip/generics-propeq-conservative merge fdc03a7 Auto-derive a few manually coded Show instances c96c64f Increase -fcontext-stack=N default to 100 ebb7334 Spelling error in flags.xml 48f17f1 Use mapAccumL (refactoring only) 2a5eb83 Typo in comment in GHC.Generics 1378ba3 Fix garbled comment wording 28059ba Define Util.leLength :: [a] -> [b] -> Bool 24e51b0 White space only 0aaf812 Clean up Coercible handling, and interaction of data families with newtypes e1c6352 Fixup overlooked `unless` occurence d48fed4 Define fixity for `Data.Foldable.{elem,notElem}` 5e300d5 Typos e76fafa Fix potential `mingw32_HOST_OS` breakage from eae19112462fe77 83c5821 Fix potential `mingw32_HOST_OS` -Werror failure 4805abf Deactive T4801 `max_bytes_used`-check & bump T3064 numbers 9f7e363 Change linker message verbosity to `-v2` (re #7863) 3daf002 Set up framework for generalising Data.List to Foldables 1812898 Turn a few existing folds into `Foldable`-methods (#9621) 05cf18f Generalise (some of) Data.List to Foldables (re #9568) ed65808 Add missing changelog entries for current state of #9586 e7c1633 Simplify import-graph a bit more bfc7195 Update haskell2010, haskell98, and array submodules 835d874 Make libffi install into a predictable directory (#9620) 5ed1281 Move `mapM` and `sequence` to GHC.Base and break import-cycles 1f7f46f Generalise Data.List/Control.Monad to Foldable/Traversable b8f5839 Export `Monoid(..)`/`Foldable(..)`/`Traversable(..)` from Prelude 27b937e Fix windows breakage from 5ed12810e0972b1e due to import cycles 38cb5ec Update haskeline submodule to avoid -Werror failure 5fa6e75 Ensure that loop breakers are computed when glomming 01906c7 Test Trac #9565 and #9583 2a743bb Delete hack when takeDirectory returns "" 330bb3e Delete all /* ! __GLASGOW_HASKELL__ */ code d5e4874 Change all hashbangs to /usr/bin/env (#9057) 165072b Adapt nofib submodule to #9586 changes 4b648be Update Cabal submodule & ghc-pkg to use new module re-export types 805ee11 `M-x delete-trailing-whitespace` & `M-x untabify` fb84817 `M-x delete-trailing-whitespace` & `M-x untabify` 6b02626 Update time submodule to 1.5.0 release f1d8841 Link from 7.6.3.4 to 7.7.2.6 in the user guide. 55e04cb Remove a few redundant `-fno-warn-tabs`s 46a5b7c Detab DataCon 3ecca02 Update `binary` submodule in an attempt to address #9630 c315702 [ci skip] iface: detabify/dewhitespace IfaceSyn 3765e21 [ci skip] simplCore: detabify/dewhitespace CoreMonad 7567ad3 [ci skip] typecheck: detabify/dewhitespace TcInstDecls c4ea319 [ci skip] typecheck: detabify/dewhitespace TcPat a3dcaa5 [ci skip] typecheck: detabify/dewhitespace TcTyDecls 18155ac [ci skip] typecheck: detabify/dewhitespace TcUnify efdf4b9 types: detabify/dewhitespace Unify dc1fce1 Refer to 'mask' instead of 'block' in Control.Exception a7ec061 Delete hack that was once needed to fix the build 2388146 User's Guide: various unfolding-related fixes c23beff Fixes cyclic import on OS X(#9635) 74ae598 Defer errors in derived instances 20632d3 Do not discard insoluble Derived constraints 8c9d0ce Wibble to implicit-parameter error message 1a88f9a Improve error messages from functional dependencies 0e16cbf Two improved error messages ac157de Complain about illegal type literals in renamer, not parser 0ef1cc6 De-tabify and remove trailing whitespace 0686897 This test should have -XDataKinds 2e4f364 Comments a74611b Merge branch 'master' into wip/new-flatten-skolems-Aug14 9b5c9af More flatten-skolem progress c5f6308 Merge branch 'wip/new-flatten-skolems-Aug14' of https://git.haskell.org/ghc into wip/new-flatten-skolems-Aug14 From git at git.haskell.org Fri Sep 26 16:48:53 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 16:48:53 +0000 (UTC) Subject: [commit: ghc] wip/new-flatten-skolems-Aug14: More progress on flatten-skolems (8505aca) Message-ID: <20140926164853.BD7CE3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/new-flatten-skolems-Aug14 Link : http://ghc.haskell.org/trac/ghc/changeset/8505aca4720649800ea3095d77e145f80346d889/ghc >--------------------------------------------------------------- commit 8505aca4720649800ea3095d77e145f80346d889 Author: Simon Peyton Jones Date: Fri Sep 26 17:45:19 2014 +0100 More progress on flatten-skolems >--------------------------------------------------------------- 8505aca4720649800ea3095d77e145f80346d889 compiler/typecheck/TcInteract.lhs | 6 +-- compiler/typecheck/TcRnTypes.lhs | 3 -- compiler/typecheck/TcRules.lhs | 2 - compiler/typecheck/TcSMonad.lhs | 28 ++----------- compiler/typecheck/TcSimplify.lhs | 47 ++++++++++------------ compiler/typecheck/TcUnify.lhs | 1 - testsuite/tests/gadt/T7293.stderr | 2 +- testsuite/tests/gadt/T7294.stderr | 2 +- .../indexed-types/should_compile/T3017.stderr | 3 +- .../tests/indexed-types/should_fail/T7729.stderr | 7 ++-- .../tests/indexed-types/should_fail/T8227.stderr | 13 ++---- .../tests/indexed-types/should_fail/T8518.stderr | 2 +- 12 files changed, 39 insertions(+), 77 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8505aca4720649800ea3095d77e145f80346d889 From git at git.haskell.org Fri Sep 26 17:36:45 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 17:36:45 +0000 (UTC) Subject: [commit: ghc] master: Update `unix` submodule to disable getlogin tests (c5f65c6) Message-ID: <20140926173645.B081D3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c5f65c6dadd3f6f3e1ba8a7d0cec25ede1561339/ghc >--------------------------------------------------------------- commit c5f65c6dadd3f6f3e1ba8a7d0cec25ede1561339 Author: Herbert Valerio Riedel Date: Fri Sep 26 19:36:28 2014 +0200 Update `unix` submodule to disable getlogin tests >--------------------------------------------------------------- c5f65c6dadd3f6f3e1ba8a7d0cec25ede1561339 libraries/unix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/unix b/libraries/unix index 832ac1d..49dda44 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit 832ac1d654762876c811ca5fd7e04c01badaa754 +Subproject commit 49dda44ebcc669751892e5b62b5230807947fa6e From git at git.haskell.org Fri Sep 26 19:12:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 19:12:30 +0000 (UTC) Subject: [commit: ghc] master: Don't re-export `Alternative(..)` from Control.Monad (re #9586) (319703e) Message-ID: <20140926191230.CE1933A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/319703ee0c97c593be514222fdee06555816cda4/ghc >--------------------------------------------------------------- commit 319703ee0c97c593be514222fdee06555816cda4 Author: Herbert Valerio Riedel Date: Fri Sep 26 21:09:56 2014 +0200 Don't re-export `Alternative(..)` from Control.Monad (re #9586) This was done in d94de87252d0fe2ae97341d186b03a2fbe136b04 to avoid orphans but since a94dc4c3067c6a0925e2e39f35ef0930771535f1 moved `Alternative` into GHC.Base, this isn't needed anymore. This is important, as otherwise this would require a non-neglectable amount of `Control.Monad hiding ((<|>), empty)` imports in user code. The Haddock submodule is updated as well Test Plan: partial local ./validate --fast, let Harbormaster doublecheck it Reviewed By: ekmett, austin Differential Revision: https://phabricator.haskell.org/D248 >--------------------------------------------------------------- 319703ee0c97c593be514222fdee06555816cda4 compiler/main/ErrUtils.lhs | 4 ---- compiler/parser/RdrHsSyn.lhs | 4 ---- compiler/prelude/PrelRules.lhs | 4 +++- compiler/typecheck/TcRnDriver.lhs | 4 ---- compiler/utils/IOEnv.hs | 2 -- ghc/InteractiveUI.hs | 2 +- libraries/base/Control/Monad.hs | 1 - testsuite/tests/typecheck/should_compile/T4524.hs | 3 ++- testsuite/tests/typecheck/should_compile/tc213.hs | 2 +- utils/haddock | 2 +- 10 files changed, 8 insertions(+), 20 deletions(-) diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index b06f5bc..c43064e 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -55,11 +55,7 @@ import qualified Data.Set as Set import Data.IORef import Data.Ord import Data.Time -#if __GLASGOW_HASKELL__ >= 709 -import Control.Monad hiding (empty) -#else import Control.Monad -#endif import Control.Monad.IO.Class import System.IO diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 6bd5d27..e6969e7 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -86,11 +86,7 @@ import Maybes import Util import Control.Applicative ((<$>)) -#if __GLASGOW_HASKELL__ >= 709 -import Control.Monad hiding (empty, many) -#else import Control.Monad -#endif import Text.ParserCombinators.ReadP as ReadP import Data.Char diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs index a91d3f7..1e5f259 100644 --- a/compiler/prelude/PrelRules.lhs +++ b/compiler/prelude/PrelRules.lhs @@ -48,7 +48,9 @@ import Platform import Util import Coercion (mkUnbranchedAxInstCo,mkSymCo,Role(..)) -#if __GLASGOW_HASKELL__ < 709 +#if __GLASGOW_HASKELL__ >= 709 +import Control.Applicative ( Alternative(..) ) +#else import Control.Applicative ( Applicative(..), Alternative(..) ) #endif diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 4927684..9898b46 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -100,11 +100,7 @@ import Maybes import Util import Bag -#if __GLASGOW_HASKELL__ >= 709 -import Control.Monad hiding (empty) -#else import Control.Monad -#endif #include "HsVersions.h" \end{code} diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs index 8193beb..46f6e46 100644 --- a/compiler/utils/IOEnv.hs +++ b/compiler/utils/IOEnv.hs @@ -44,9 +44,7 @@ import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO ( fixIO ) import Control.Monad import MonadUtils -#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Alternative(..)) -#endif ---------------------------------------------------------------------- -- Defining the monad type diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 0bcecd3..3192d20 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -63,7 +63,7 @@ import Util -- Haskell Libraries import System.Console.Haskeline as Haskeline -import Control.Monad as Monad hiding (empty) +import Control.Monad as Monad import Control.Applicative hiding (empty) import Control.Monad.Trans.Class diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 889f91a..3fe4450 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -20,7 +20,6 @@ module Control.Monad Functor(fmap) , Monad((>>=), (>>), return, fail) - , Alternative(empty, (<|>), some, many) , MonadPlus(mzero, mplus) -- * Functions diff --git a/testsuite/tests/typecheck/should_compile/T4524.hs b/testsuite/tests/typecheck/should_compile/T4524.hs index 0b2e538..27cbb1f 100644 --- a/testsuite/tests/typecheck/should_compile/T4524.hs +++ b/testsuite/tests/typecheck/should_compile/T4524.hs @@ -28,7 +28,8 @@ module T4524 where import Data.Maybe ( mapMaybe ) -import Control.Monad (Alternative(..), MonadPlus(..), msum, ap, liftM ) +import Control.Applicative ( Alternative(..) ) +import Control.Monad ( MonadPlus(..), msum, ap, liftM ) import Unsafe.Coerce (unsafeCoerce) newtype FileName = FN FilePath deriving ( Eq, Ord ) diff --git a/testsuite/tests/typecheck/should_compile/tc213.hs b/testsuite/tests/typecheck/should_compile/tc213.hs index 8034606..1f0b464 100644 --- a/testsuite/tests/typecheck/should_compile/tc213.hs +++ b/testsuite/tests/typecheck/should_compile/tc213.hs @@ -5,7 +5,7 @@ -- type signature in t1 and t2 module Foo7 where -import Control.Monad hiding (empty) +import Control.Monad import Control.Monad.ST import Data.Array.MArray import Data.Array.ST diff --git a/utils/haddock b/utils/haddock index 12dc730..a65d213 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 12dc730e62236e15f1194ddc8260affc24928bd1 +Subproject commit a65d2131647e010608d2a1956116a0012946838f From git at git.haskell.org Fri Sep 26 19:43:22 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Sep 2014 19:43:22 +0000 (UTC) Subject: [commit: ghc] master: Update Cabal submodule to latest master branch tip (4b9c92b) Message-ID: <20140926194322.3E7153A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4b9c92b072289290a0dffc8d66baf47b992c7f8c/ghc >--------------------------------------------------------------- commit 4b9c92b072289290a0dffc8d66baf47b992c7f8c Author: Herbert Valerio Riedel Date: Fri Sep 26 21:42:55 2014 +0200 Update Cabal submodule to latest master branch tip >--------------------------------------------------------------- 4b9c92b072289290a0dffc8d66baf47b992c7f8c libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 5cf626d..02dc4a7 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 5cf626df3039c8746bff814a7b97988d25707d96 +Subproject commit 02dc4a7d84ba900be241a32a8ff9de22e6c67d12 From git at git.haskell.org Sat Sep 27 07:56:49 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Sep 2014 07:56:49 +0000 (UTC) Subject: [commit: packages/old-time] master: Replace obsolete `defaultUserHooks` by `autoconfUserHooks` (539e4ec) Message-ID: <20140927075649.013B33A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/old-time On branch : master Link : http://git.haskell.org/packages/old-time.git/commitdiff/539e4ec39368177b83398f9a3cdf7f63814e883d >--------------------------------------------------------------- commit 539e4ec39368177b83398f9a3cdf7f63814e883d Author: Herbert Valerio Riedel Date: Sat Sep 27 09:56:40 2014 +0200 Replace obsolete `defaultUserHooks` by `autoconfUserHooks` >--------------------------------------------------------------- 539e4ec39368177b83398f9a3cdf7f63814e883d Setup.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Setup.hs b/Setup.hs index 7cf9bfd..54f57d6 100644 --- a/Setup.hs +++ b/Setup.hs @@ -3,4 +3,4 @@ module Main (main) where import Distribution.Simple main :: IO () -main = defaultMainWithHooks defaultUserHooks +main = defaultMainWithHooks autoconfUserHooks From git at git.haskell.org Sat Sep 27 08:08:51 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Sep 2014 08:08:51 +0000 (UTC) Subject: [commit: ghc] master: Replace obsolete `defaultUserHooks` by `autoconfUserHooks` (b3aa6e4) Message-ID: <20140927080851.D2C723A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b3aa6e486d158a2a5afbc463f06ad6d04c47b7fe/ghc >--------------------------------------------------------------- commit b3aa6e486d158a2a5afbc463f06ad6d04c47b7fe Author: Herbert Valerio Riedel Date: Sat Sep 27 09:57:24 2014 +0200 Replace obsolete `defaultUserHooks` by `autoconfUserHooks` This also updates a few submodules >--------------------------------------------------------------- b3aa6e486d158a2a5afbc463f06ad6d04c47b7fe libraries/base/Setup.hs | 2 +- libraries/directory | 2 +- libraries/old-time | 2 +- libraries/process | 2 +- libraries/unix | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/libraries/base/Setup.hs b/libraries/base/Setup.hs index 7cf9bfd..54f57d6 100644 --- a/libraries/base/Setup.hs +++ b/libraries/base/Setup.hs @@ -3,4 +3,4 @@ module Main (main) where import Distribution.Simple main :: IO () -main = defaultMainWithHooks defaultUserHooks +main = defaultMainWithHooks autoconfUserHooks diff --git a/libraries/directory b/libraries/directory index 3294737..bcb8c40 160000 --- a/libraries/directory +++ b/libraries/directory @@ -1 +1 @@ -Subproject commit 329473730c36827f06358e137b469c59b490aaa8 +Subproject commit bcb8c40b5e0a17030bcc085b46bf8718ea713107 diff --git a/libraries/old-time b/libraries/old-time index 12b029f..539e4ec 160000 --- a/libraries/old-time +++ b/libraries/old-time @@ -1 +1 @@ -Subproject commit 12b029fb767c1e25860aacdf0286ba81fd4cbbf5 +Subproject commit 539e4ec39368177b83398f9a3cdf7f63814e883d diff --git a/libraries/process b/libraries/process index ec5df5c..7b3ede7 160000 --- a/libraries/process +++ b/libraries/process @@ -1 +1 @@ -Subproject commit ec5df5c5752e1cfa02d13685d912a26809ce6c81 +Subproject commit 7b3ede7dbbb2de80b906c76f747d0b3196c4669a diff --git a/libraries/unix b/libraries/unix index 49dda44..c46a7fe 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit 49dda44ebcc669751892e5b62b5230807947fa6e +Subproject commit c46a7fecc212573cc7864a25a762e9e6849f7257 From git at git.haskell.org Sat Sep 27 11:58:19 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Sep 2014 11:58:19 +0000 (UTC) Subject: [commit: ghc] master: Stop exporting, and stop using, functions marked as deprecated (51aa2fa) Message-ID: <20140927115819.37D7A3A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/51aa2fa3e65a960c1432dba9acc29db719964618/ghc >--------------------------------------------------------------- commit 51aa2fa3e65a960c1432dba9acc29db719964618 Author: Thomas Miedema Date: Sat Sep 27 13:55:48 2014 +0200 Stop exporting, and stop using, functions marked as deprecated Don't export `getUs` and `getUniqueUs`. `UniqSM` has a `MonadUnique` instance: instance MonadUnique UniqSM where getUniqueSupplyM = getUs getUniqueM = getUniqueUs getUniquesM = getUniquesUs Commandline-fu used: git grep -l 'getUs\>' | grep -v compiler/basicTypes/UniqSupply.lhs | xargs sed -i 's/getUs/getUniqueSupplyM/g git grep -l 'getUniqueUs\>' | grep -v combiler/basicTypes/UniqSupply.lhs | xargs sed -i 's/getUniqueUs/getUniqueM/g' Follow up on b522d3a3f970a043397a0d6556ca555648e7a9c3 Reviewed By: austin, hvr Differential Revision: https://phabricator.haskell.org/D220 >--------------------------------------------------------------- 51aa2fa3e65a960c1432dba9acc29db719964618 compiler/basicTypes/MkId.lhs | 2 +- compiler/basicTypes/UniqSupply.lhs | 3 --- compiler/cmm/CmmInfo.hs | 4 ++-- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 2 +- compiler/nativeGen/AsmCodeGen.lhs | 2 +- compiler/nativeGen/PPC/Instr.hs | 2 +- compiler/nativeGen/RegAlloc/Graph/Spill.hs | 2 +- compiler/nativeGen/RegAlloc/Linear/Main.hs | 2 +- compiler/nativeGen/X86/Instr.hs | 2 +- compiler/simplCore/SAT.lhs | 2 +- compiler/specialise/SpecConstr.lhs | 6 +++--- 11 files changed, 13 insertions(+), 16 deletions(-) diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index 5a317e2..bf1c199 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -576,7 +576,7 @@ mkDataConRep dflags fam_envs wrap_name data_con ------------------------- newLocal :: Type -> UniqSM Var -newLocal ty = do { uniq <- getUniqueUs +newLocal ty = do { uniq <- getUniqueM ; return (mkSysLocal (fsLit "dt") uniq ty) } ------------------------- diff --git a/compiler/basicTypes/UniqSupply.lhs b/compiler/basicTypes/UniqSupply.lhs index 6ceee20..401d69b 100644 --- a/compiler/basicTypes/UniqSupply.lhs +++ b/compiler/basicTypes/UniqSupply.lhs @@ -23,9 +23,6 @@ module UniqSupply ( -- ** Operations on the monad initUs, initUs_, lazyThenUs, lazyMapUs, - - -- ** Deprecated operations on 'UniqSM' - getUniqueUs, getUs, ) where import Unique diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index 3bfc728..ce8b9f8 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/compiler/cmm/CmmInfo.hs @@ -323,7 +323,7 @@ mkLivenessBits :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl]) mkLivenessBits dflags liveness | n_bits > mAX_SMALL_BITMAP_SIZE dflags -- does not fit in one word - = do { uniq <- getUniqueUs + = do { uniq <- getUniqueM ; let bitmap_lbl = mkBitmapLabel uniq ; return (CmmLabel bitmap_lbl, [mkRODataLits bitmap_lbl lits]) } @@ -398,7 +398,7 @@ mkProfLits _ (ProfilingInfo td cd) newStringLit :: [Word8] -> UniqSM (CmmLit, GenCmmDecl CmmStatics info stmt) newStringLit bytes - = do { uniq <- getUniqueUs + = do { uniq <- getUniqueM ; return (mkByteStringCLit uniq bytes) } diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index a8869d1..6703801 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -1636,7 +1636,7 @@ getHsFunc' name fty -- | Create a new local var mkLocalVar :: LlvmType -> LlvmM LlvmVar mkLocalVar ty = do - un <- runUs getUniqueUs + un <- runUs getUniqueM return $ LMLocalVar un ty diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index 94d64b1..5b4a517 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -836,7 +836,7 @@ genMachCode , [CLabel]) genMachCode dflags this_mod cmmTopCodeGen cmm_top - = do { initial_us <- getUs + = do { initial_us <- getUniqueSupplyM ; let initial_st = mkNatM_State initial_us 0 dflags this_mod (new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top) final_delta = natm_delta final_st diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs index 3756c64..f5b9506 100644 --- a/compiler/nativeGen/PPC/Instr.hs +++ b/compiler/nativeGen/PPC/Instr.hs @@ -104,7 +104,7 @@ allocMoreStack platform slots (CmmProc info lbl live (ListGraph code)) = do | entry `elem` infos -> infos | otherwise -> entry : infos - uniqs <- replicateM (length entries) getUniqueUs + uniqs <- replicateM (length entries) getUniqueM let delta = ((x + stackAlign - 1) `quot` stackAlign) * stackAlign -- round up diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs index 802046c..7267ef8 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs @@ -67,7 +67,7 @@ regSpill platform code slotsFree regs $ zip (uniqSetToList regs) slots -- Grab the unique supply from the monad. - us <- getUs + us <- getUniqueSupplyM -- Run the spiller on all the blocks. let (code', state') = diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs index fa47a17..12dc8f0 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Main.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs @@ -231,7 +231,7 @@ linearRegAlloc' -> UniqSM ([NatBasicBlock instr], RegAllocStats, Int) linearRegAlloc' dflags initFreeRegs entry_ids block_live sccs - = do us <- getUs + = do us <- getUniqueSupplyM let (_, stack, stats, blocks) = runR dflags emptyBlockMap initFreeRegs emptyRegMap (emptyStackMap dflags) us $ linearRA_SCCs entry_ids block_live [] sccs diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index 7d38245..2f61962 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -947,7 +947,7 @@ allocMoreStack _ _ top@(CmmData _ _) = return top allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do let entries = entryBlocks proc - uniqs <- replicateM (length entries) getUniqueUs + uniqs <- replicateM (length entries) getUniqueM let delta = ((x + stackAlign - 1) `quot` stackAlign) * stackAlign -- round up diff --git a/compiler/simplCore/SAT.lhs b/compiler/simplCore/SAT.lhs index a0b3151..f973c35 100644 --- a/compiler/simplCore/SAT.lhs +++ b/compiler/simplCore/SAT.lhs @@ -255,7 +255,7 @@ runSAT :: UniqSupply -> SatM a -> a runSAT = initUs_ newUnique :: SatM Unique -newUnique = getUniqueUs +newUnique = getUniqueM \end{code} diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs index 1e7cbb6..6cc8b04 100644 --- a/compiler/specialise/SpecConstr.lhs +++ b/compiler/specialise/SpecConstr.lhs @@ -1584,7 +1584,7 @@ spec_one :: ScEnv -} spec_one env fn arg_bndrs body (call_pat@(qvars, pats), rule_number) - = do { spec_uniq <- getUniqueUs + = do { spec_uniq <- getUniqueM ; let spec_env = extendScSubstList (extendScInScope env qvars) (arg_bndrs `zip` pats) fn_name = idName fn @@ -1860,7 +1860,7 @@ argToPat env in_scope val_env (Cast arg co) arg_occ wildCardPat ty2 else do { -- Make a wild-card pattern for the coercion - uniq <- getUniqueUs + uniq <- getUniqueM ; let co_name = mkSysTvName uniq (fsLit "sg") co_var = mkCoVar co_name (mkCoercionType Representational ty1 ty2) ; return (interesting, Cast arg' (mkCoVarCo co_var)) } } @@ -1941,7 +1941,7 @@ argToPat _env _in_scope _val_env arg _arg_occ wildCardPat :: Type -> UniqSM (Bool, CoreArg) wildCardPat ty - = do { uniq <- getUniqueUs + = do { uniq <- getUniqueM ; let id = mkSysLocal (fsLit "sc") uniq ty ; return (False, varToCoreExpr id) } From git at git.haskell.org Sat Sep 27 21:07:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Sep 2014 21:07:32 +0000 (UTC) Subject: [commit: ghc] master: Set default-impl of `mapM`/`sequence` methods to `traverse`/`sequenceA` (f636faa) Message-ID: <20140927210732.436603A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f636faa7b2b7fc1d0663f994ad08f365d39a746d/ghc >--------------------------------------------------------------- commit f636faa7b2b7fc1d0663f994ad08f365d39a746d Author: Herbert Valerio Riedel Date: Sat Sep 27 22:55:19 2014 +0200 Set default-impl of `mapM`/`sequence` methods to `traverse`/`sequenceA` This is made possible by the AMP, as we don't need the `WrappedMonad` helper for that anymore. Approved-by: Edward Kmett >--------------------------------------------------------------- f636faa7b2b7fc1d0663f994ad08f365d39a746d libraries/base/Data/Traversable.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index eb5123d..1c8b605 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -46,7 +46,7 @@ module Data.Traversable ( foldMapDefault, ) where -import Control.Applicative ( Const(..), WrappedMonad(..) ) +import Control.Applicative ( Const(..) ) import Data.Either ( Either(..) ) import Data.Foldable ( Foldable ) import Data.Functor @@ -157,12 +157,12 @@ class (Functor t, Foldable t) => Traversable t where -- | Map each element of a structure to a monadic action, evaluate -- these actions from left to right, and collect the results. mapM :: Monad m => (a -> m b) -> t a -> m (t b) - mapM f = unwrapMonad . traverse (WrapMonad . f) + mapM = traverse -- | Evaluate each monadic action in the structure from left to right, -- and collect the results. sequence :: Monad m => t (m a) -> m (t a) - sequence = mapM id + sequence = sequenceA {-# MINIMAL traverse | sequenceA #-} -- instances for Prelude types From git at git.haskell.org Sun Sep 28 02:48:29 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Sep 2014 02:48:29 +0000 (UTC) Subject: [commit: ghc] master: User's Guide: Fix compiler plugin example (#9641, #7682) (071167c) Message-ID: <20140928024829.05EE33A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/071167c793489f4071c348223f9591d20dbe11a3/ghc >--------------------------------------------------------------- commit 071167c793489f4071c348223f9591d20dbe11a3 Author: Reid Barton Date: Sat Sep 27 22:13:10 2014 -0400 User's Guide: Fix compiler plugin example (#9641, #7682) The previous fix was incorrectly eta-reduced. >--------------------------------------------------------------- 071167c793489f4071c348223f9591d20dbe11a3 docs/users_guide/extending_ghc.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/extending_ghc.xml b/docs/users_guide/extending_ghc.xml index 1b5bbfa..12e598b 100644 --- a/docs/users_guide/extending_ghc.xml +++ b/docs/users_guide/extending_ghc.xml @@ -226,8 +226,8 @@ install _ todo = do return (CoreDoPluginPass "Say name" pass : todo) pass :: ModGuts -> CoreM ModGuts -pass = do dflags <- getDynFlags - bindsOnlyPass (mapM (printBind dflags)) +pass guts = do dflags <- getDynFlags + bindsOnlyPass (mapM (printBind dflags)) guts where printBind :: DynFlags -> CoreBind -> CoreM CoreBind printBind dflags bndr@(NonRec b _) = do putMsgS $ "Non-recursive binding named " ++ showSDoc dflags (ppr b) From git at git.haskell.org Sun Sep 28 06:53:34 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Sep 2014 06:53:34 +0000 (UTC) Subject: [commit: ghc] master: Generalise `Control.Monad.{when, unless, guard}` (a07ce16) Message-ID: <20140928065334.18BB33A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a07ce1654ac5b8033f2daf9270c6e182415b69ca/ghc >--------------------------------------------------------------- commit a07ce1654ac5b8033f2daf9270c6e182415b69ca Author: Herbert Valerio Riedel Date: Sun Sep 28 08:46:07 2014 +0200 Generalise `Control.Monad.{when,unless,guard}` Generalise `when`/`unless`from `Monad` to `Applicative` and `guard` from `MonadPlus` to `Alternative` respectively. This was made possible by the AMP and is somewhat related to #9586 (but generalising in the context of the AMP instead of the FTP) Reviewed By: ekmett, austin Differential Revision: https://phabricator.haskell.org/D253 >--------------------------------------------------------------- a07ce1654ac5b8033f2daf9270c6e182415b69ca libraries/base/Control/Monad.hs | 12 ++++++------ libraries/base/GHC/Base.lhs | 6 +++--- libraries/base/changelog.md | 3 +++ 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 3fe4450..94318be 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -85,11 +85,11 @@ import GHC.List ( zipWith, unzip, replicate ) -- ----------------------------------------------------------------------------- -- Functions mandated by the Prelude --- | @'guard' b@ is @'return' ()@ if @b@ is 'True', --- and 'mzero' if @b@ is 'False'. +-- | @'guard' b@ is @'pure' ()@ if @b@ is 'True', +-- and 'empty' if @b@ is 'False'. guard :: (MonadPlus m) => Bool -> m () -guard True = return () -guard False = mzero +guard True = pure () +guard False = empty -- | This generalizes the list-based 'filter' function. @@ -186,11 +186,11 @@ replicateM_ :: (Monad m) => Int -> m a -> m () replicateM_ n x = sequence_ (replicate n x) -- | The reverse of 'when'. -unless :: (Monad m) => Bool -> m () -> m () +unless :: (Applicative f) => Bool -> f () -> f () {-# INLINEABLE unless #-} {-# SPECIALISE unless :: Bool -> IO () -> IO () #-} {-# SPECIALISE unless :: Bool -> Maybe () -> Maybe () #-} -unless p s = if p then return () else s +unless p s = if p then pure () else s infixl 4 <$!> diff --git a/libraries/base/GHC/Base.lhs b/libraries/base/GHC/Base.lhs index e6e35f3..8b51c07 100644 --- a/libraries/base/GHC/Base.lhs +++ b/libraries/base/GHC/Base.lhs @@ -493,17 +493,17 @@ original default. (=<<) :: Monad m => (a -> m b) -> m a -> m b f =<< x = x >>= f --- | Conditional execution of monadic expressions. For example, +-- | Conditional execution of 'Applicative' expressions. For example, -- -- > when debug (putStrLn "Debugging") -- -- will output the string @Debugging@ if the Boolean value @debug@ -- is 'True', and otherwise do nothing. -when :: (Monad m) => Bool -> m () -> m () +when :: (Applicative f) => Bool -> f () -> f () {-# INLINEABLE when #-} {-# SPECIALISE when :: Bool -> IO () -> IO () #-} {-# SPECIALISE when :: Bool -> Maybe () -> Maybe () #-} -when p s = if p then s else return () +when p s = if p then s else pure () -- | Evaluate each action in the sequence from left to right, -- and collect the results. diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 1afcb0e..7b168fe 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -66,6 +66,9 @@ and `Data.Foldable`/`Data.Traversable` no longer lead to conflicting definitions. (#9586) + * Generalise `Control.Monad.{when,unless,guard}` from `Monad` to + `Applicative` and from `MonadPlus` to `Alternative` respectively. + * New module `Data.OldList` containing only list-specialised versions of the functions from `Data.List` (in other words, `Data.OldList` corresponds to `base-4.7.0.1`'s `Data.List`) From git at git.haskell.org Sun Sep 28 10:02:03 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Sep 2014 10:02:03 +0000 (UTC) Subject: [commit: ghc] master: Generalise `guard` for real this time (bf33291) Message-ID: <20140928100203.388B03A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bf3329104c971c84ab178f3ded88254b9594f9cc/ghc >--------------------------------------------------------------- commit bf3329104c971c84ab178f3ded88254b9594f9cc Author: Herbert Valerio Riedel Date: Sun Sep 28 12:01:13 2014 +0200 Generalise `guard` for real this time This was missed in D253 / a07ce1654ac5b8033f2daf9270c6e182415b69ca >--------------------------------------------------------------- bf3329104c971c84ab178f3ded88254b9594f9cc libraries/base/Control/Monad.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 94318be..619a2ba 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -87,7 +87,7 @@ import GHC.List ( zipWith, unzip, replicate ) -- | @'guard' b@ is @'pure' ()@ if @b@ is 'True', -- and 'empty' if @b@ is 'False'. -guard :: (MonadPlus m) => Bool -> m () +guard :: (Alternative f) => Bool -> f () guard True = pure () guard False = empty From git at git.haskell.org Sun Sep 28 13:07:39 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Sep 2014 13:07:39 +0000 (UTC) Subject: [commit: ghc] master: Extend `Foldable` class with `length` and `null` methods (e5cca4a) Message-ID: <20140928130739.F35543A002@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e5cca4ab246ca2d1ecdd7c39eefd3157547cb6aa/ghc >--------------------------------------------------------------- commit e5cca4ab246ca2d1ecdd7c39eefd3157547cb6aa Author: Herbert Valerio Riedel Date: Sun Sep 28 13:02:53 2014 +0200 Extend `Foldable` class with `length` and `null` methods This completes the `Foldable` class by two important operations which this way can be optimised for the underlying structure more easily. A minor fix for the `containers` submodule was needed to due name clash Addresses #9621 Reviewed By: ekmett, dfeuer, austin Differential Revision: https://phabricator.haskell.org/D250 >--------------------------------------------------------------- e5cca4ab246ca2d1ecdd7c39eefd3157547cb6aa compiler/ghci/Debugger.hs | 2 +- libraries/base/Data/Foldable.hs | 10 ++++++++++ libraries/base/Data/List.hs | 2 +- libraries/containers | 2 +- testsuite/tests/ghci/scripts/ghci025.stdout | 4 +++- testsuite/tests/module/mod106.hs | 2 +- testsuite/tests/parser/should_fail/readFail003.hs | 2 +- testsuite/tests/simplCore/should_compile/T7360.hs | 6 ++++-- testsuite/tests/typecheck/should_compile/faxen.hs | 3 +++ testsuite/tests/typecheck/should_fail/mc21.hs | 4 ++-- testsuite/tests/typecheck/should_fail/mc24.hs | 4 ++-- 11 files changed, 29 insertions(+), 12 deletions(-) diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs index 4966714..bd15329 100644 --- a/compiler/ghci/Debugger.hs +++ b/compiler/ghci/Debugger.hs @@ -172,7 +172,7 @@ showTerm term = do txt_ <- withExtendedLinkEnv [(bname, val)] (GHC.compileExpr expr) let myprec = 10 -- application precedence. TODO Infix constructors - let txt = unsafeCoerce# txt_ + let txt = unsafeCoerce# txt_ :: [a] if not (null txt) then return $ Just $ cparen (prec >= myprec && needsParens txt) (text txt) diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index 688fd06..d8310ca 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -149,6 +149,14 @@ class Foldable t where {-# INLINE toList #-} toList t = build (\ c n -> foldr c n t) + -- | Test whether the structure is empty. + null :: Foldable t => t a -> Bool + null = foldr (\_ _ -> False) True + + -- | Returns the size/length of a finite structure as an 'Int'. + length :: Foldable t => t a -> Int + length = foldl' (\c _ -> c+1) 0 + -- | Does the element occur in the structure? elem :: (Foldable t, Eq a) => a -> t a -> Bool elem = any . (==) @@ -186,8 +194,10 @@ instance Foldable [] where foldl1 = List.foldl1 foldr = List.foldr foldr1 = List.foldr1 + length = List.length maximum = List.maximum minimum = List.minimum + null = List.null product = List.product sum = List.sum toList = id diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs index 795baec..193ebbc 100644 --- a/libraries/base/Data/List.hs +++ b/libraries/base/Data/List.hs @@ -213,4 +213,4 @@ import Data.Traversable import Data.OldList hiding ( all, and, any, concat, concatMap, elem, find, foldl, foldl1, foldl', foldr, foldr1, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, - notElem, or, product, sum ) + length, notElem, null, or, product, sum ) diff --git a/libraries/containers b/libraries/containers index e84c5d2..085e1b8 160000 --- a/libraries/containers +++ b/libraries/containers @@ -1 +1 @@ -Subproject commit e84c5d2145415cb0beacce0909a551ae5e28d396 +Subproject commit 085e1b8b2cfbd1159bbc9f8cbf6a4127cc32227b diff --git a/testsuite/tests/ghci/scripts/ghci025.stdout b/testsuite/tests/ghci/scripts/ghci025.stdout index e6b012a..4d21c5f 100644 --- a/testsuite/tests/ghci/scripts/ghci025.stdout +++ b/testsuite/tests/ghci/scripts/ghci025.stdout @@ -52,7 +52,9 @@ class Eq a where (GHC.Classes.==) :: a -> a -> GHC.Types.Bool (GHC.Classes./=) :: a -> a -> GHC.Types.Bool -- imported via Prelude, T -Prelude.length :: [a] -> GHC.Types.Int +Prelude.length :: + Data.Foldable.Foldable t => + forall a. Data.Foldable.Foldable t => t a -> GHC.Types.Int -- imported via T data T.Integer = integer-gmp-0.5.1.0:GHC.Integer.Type.S# GHC.Prim.Int# diff --git a/testsuite/tests/module/mod106.hs b/testsuite/tests/module/mod106.hs index a871377..b505971 100644 --- a/testsuite/tests/module/mod106.hs +++ b/testsuite/tests/module/mod106.hs @@ -1,7 +1,7 @@ -- !!! local aliases module M where -import qualified Data.List as M +import qualified Data.OldList as M import qualified Data.Maybe as M x = M.length diff --git a/testsuite/tests/parser/should_fail/readFail003.hs b/testsuite/tests/parser/should_fail/readFail003.hs index 8595312..343e1f0 100644 --- a/testsuite/tests/parser/should_fail/readFail003.hs +++ b/testsuite/tests/parser/should_fail/readFail003.hs @@ -1,6 +1,6 @@ -- !!! Irrefutable patterns + guards module Read003 where - +import Data.OldList; import Prelude hiding (null) ~(a,b,c) | nullity b = a | nullity c = a | otherwise = a diff --git a/testsuite/tests/simplCore/should_compile/T7360.hs b/testsuite/tests/simplCore/should_compile/T7360.hs index 9225bd1..67c5e72 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.hs +++ b/testsuite/tests/simplCore/should_compile/T7360.hs @@ -3,6 +3,8 @@ module T7360 where +import Data.OldList as L + data Foo = Foo1 | Foo2 | Foo3 !Int fun1 :: Foo -> () @@ -15,5 +17,5 @@ fun1 x = case x of fun2 x = (fun1 Foo1, -- Keep -ddump-simpl output -- in a predicatable order case x of - [] -> length x - (_:_) -> length x) + [] -> L.length x + (_:_) -> L.length x) diff --git a/testsuite/tests/typecheck/should_compile/faxen.hs b/testsuite/tests/typecheck/should_compile/faxen.hs index ddc8f7b..f65ee71 100644 --- a/testsuite/tests/typecheck/should_compile/faxen.hs +++ b/testsuite/tests/typecheck/should_compile/faxen.hs @@ -6,6 +6,9 @@ module ShouldCompile where +import Data.OldList (null) +import Prelude hiding (null) + class HasEmpty a where isEmpty :: a -> Bool diff --git a/testsuite/tests/typecheck/should_fail/mc21.hs b/testsuite/tests/typecheck/should_fail/mc21.hs index 601403a..adb4b91 100644 --- a/testsuite/tests/typecheck/should_fail/mc21.hs +++ b/testsuite/tests/typecheck/should_fail/mc21.hs @@ -1,13 +1,13 @@ -- Checks that the correct type is used checking the using clause of the group {-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-} - module ShouldFail where import GHC.Exts( the ) +import Data.OldList data Unorderable = Gnorf | Pinky | Brain -foo = [ length x +foo = [ Data.OldList.length x | x <- [Gnorf, Brain] , then group using take 5 ] diff --git a/testsuite/tests/typecheck/should_fail/mc24.hs b/testsuite/tests/typecheck/should_fail/mc24.hs index 9186721..281f4ad 100644 --- a/testsuite/tests/typecheck/should_fail/mc24.hs +++ b/testsuite/tests/typecheck/should_fail/mc24.hs @@ -2,10 +2,10 @@ -- the group when a by clause is present {-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-} - module ShouldFail where +import Data.OldList -foo = [ length x +foo = [ Data.OldList.length x | x <- [1..10] , then group by x using take 2 ] From git at git.haskell.org Mon Sep 29 09:52:23 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Sep 2014 09:52:23 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T5462' created Message-ID: <20140929095223.39A193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T5462 Referencing: 7a4cdef85b0fa03a22fda595ac92870465d8c727 From git at git.haskell.org Mon Sep 29 09:52:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Sep 2014 09:52:26 +0000 (UTC) Subject: [commit: ghc] wip/T5462: Implement #5462 (deriving clause for arbitrary classes) (7a4cdef) Message-ID: <20140929095226.D077C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T5462 Link : http://ghc.haskell.org/trac/ghc/changeset/7a4cdef85b0fa03a22fda595ac92870465d8c727/ghc >--------------------------------------------------------------- commit 7a4cdef85b0fa03a22fda595ac92870465d8c727 Author: Jose Pedro Magalhaes Date: Mon Sep 29 10:38:00 2014 +0100 Implement #5462 (deriving clause for arbitrary classes) >--------------------------------------------------------------- 7a4cdef85b0fa03a22fda595ac92870465d8c727 compiler/basicTypes/BasicTypes.lhs | 1 + compiler/main/DynFlags.hs | 2 + compiler/typecheck/TcDeriv.lhs | 76 ++++++++++++++++++++++++---- compiler/typecheck/TcGenDeriv.lhs | 31 +++++++++++- testsuite/tests/generics/GEnum/Enum.hs | 87 ++++++++++++++++++++++++++++++++ testsuite/tests/generics/GEq/GEq1A.hs | 3 +- testsuite/tests/generics/T5462No1.hs | 25 +++++++++ testsuite/tests/generics/T5462No1.stderr | 19 +++++++ testsuite/tests/generics/T5462No2.hs | 26 ++++++++++ testsuite/tests/generics/T5462No2.stderr | 19 +++++++ testsuite/tests/generics/T5462Yes.hs | 48 ++++++++++++++++++ testsuite/tests/generics/T5462Yes.stdout | 1 + testsuite/tests/generics/all.T | 12 +++-- testsuite/tests/module/mod53.stderr | 1 + 14 files changed, 333 insertions(+), 18 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7a4cdef85b0fa03a22fda595ac92870465d8c727 From git at git.haskell.org Mon Sep 29 10:41:11 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Sep 2014 10:41:11 +0000 (UTC) Subject: [commit: nofib] master: Add type-signature in spectral/para to help type-inf (69bae89) Message-ID: <20140929104111.B6C733A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/69bae89103aca6e498b811d562f387830fbcb959/nofib >--------------------------------------------------------------- commit 69bae89103aca6e498b811d562f387830fbcb959 Author: Herbert Valerio Riedel Date: Mon Sep 29 12:37:26 2014 +0200 Add type-signature in spectral/para to help type-inf This testcase broke due to the generalised `Data.Foldable.length` >--------------------------------------------------------------- 69bae89103aca6e498b811d562f387830fbcb959 spectral/para/Main.lhs | 1 + 1 file changed, 1 insertion(+) diff --git a/spectral/para/Main.lhs b/spectral/para/Main.lhs index 3ae76b0..05b58a3 100644 --- a/spectral/para/Main.lhs +++ b/spectral/para/Main.lhs @@ -513,6 +513,7 @@ we stipulate also that \verb"cost [] = 0".) The program resulting from this data refinement is as follows. \begin{mcode} +>par1' :: [[a]] -> [[[a]]] >par1' > = the . minWith cost . fold1 step start > where From git at git.haskell.org Mon Sep 29 10:41:26 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Sep 2014 10:41:26 +0000 (UTC) Subject: [commit: ghc] master: Fixup nofib submodule to cope with e5cca4ab246ca2 (ee15686) Message-ID: <20140929104126.BF70D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ee15686acb63d7dfabff874e2adf5b1ba211f54c/ghc >--------------------------------------------------------------- commit ee15686acb63d7dfabff874e2adf5b1ba211f54c Author: Herbert Valerio Riedel Date: Mon Sep 29 12:40:19 2014 +0200 Fixup nofib submodule to cope with e5cca4ab246ca2 >--------------------------------------------------------------- ee15686acb63d7dfabff874e2adf5b1ba211f54c nofib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nofib b/nofib index 5c9562c..69bae89 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit 5c9562cfb48431c73d81be613d594a345e7ef73c +Subproject commit 69bae89103aca6e498b811d562f387830fbcb959 From git at git.haskell.org Mon Sep 29 13:40:24 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Sep 2014 13:40:24 +0000 (UTC) Subject: [commit: ghc] master: Revert "rts: add Emacs 'Local Variables' to every .c file" (7371d7e) Message-ID: <20140929134024.CA38F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7371d7e2a7f84a0840683d3db9f4556bc358088e/ghc >--------------------------------------------------------------- commit 7371d7e2a7f84a0840683d3db9f4556bc358088e Author: Simon Marlow Date: Fri Sep 26 20:11:25 2014 +0100 Revert "rts: add Emacs 'Local Variables' to every .c file" This reverts commit 39b5c1cbd8950755de400933cecca7b8deb4ffcd. >--------------------------------------------------------------- 7371d7e2a7f84a0840683d3db9f4556bc358088e rts/Adjustor.c | 8 -------- rts/Apply.h | 8 -------- rts/Arena.c | 8 -------- rts/Arena.h | 8 -------- rts/AutoApply.h | 8 -------- rts/AwaitEvent.h | 8 -------- rts/BeginPrivate.h | 8 -------- rts/Capability.c | 8 -------- rts/Capability.h | 8 -------- rts/CheckUnload.c | 8 -------- rts/CheckUnload.h | 8 -------- rts/ClosureFlags.c | 8 -------- rts/Disassembler.c | 8 -------- rts/Disassembler.h | 8 -------- rts/EndPrivate.h | 8 -------- rts/FileLock.c | 8 -------- rts/FileLock.h | 8 -------- rts/GetEnv.h | 8 -------- rts/GetTime.h | 8 -------- rts/Globals.c | 8 -------- rts/Globals.h | 8 -------- rts/Hash.c | 8 -------- rts/Hash.h | 8 -------- rts/Hpc.c | 8 -------- rts/HsFFI.c | 8 -------- rts/Inlines.c | 8 -------- rts/Interpreter.c | 8 -------- rts/Interpreter.h | 8 -------- rts/LdvProfile.c | 8 -------- rts/LdvProfile.h | 8 -------- rts/Linker.c | 8 -------- rts/LinkerInternals.h | 8 -------- rts/Messages.c | 8 -------- rts/Messages.h | 8 -------- rts/OldARMAtomic.c | 8 -------- rts/Papi.c | 8 -------- rts/Papi.h | 8 -------- rts/PosixSource.h | 8 -------- rts/Prelude.h | 8 -------- rts/Printer.c | 8 -------- rts/Printer.h | 8 -------- rts/ProfHeap.c | 8 -------- rts/ProfHeap.h | 8 -------- rts/Profiling.c | 8 -------- rts/Profiling.h | 8 -------- rts/Proftimer.c | 8 -------- rts/Proftimer.h | 8 -------- rts/RaiseAsync.c | 8 -------- rts/RaiseAsync.h | 8 -------- rts/RetainerProfile.c | 8 -------- rts/RetainerProfile.h | 8 -------- rts/RetainerSet.c | 8 -------- rts/RetainerSet.h | 8 -------- rts/RtsAPI.c | 8 -------- rts/RtsDllMain.c | 8 -------- rts/RtsDllMain.h | 8 -------- rts/RtsFlags.c | 8 -------- rts/RtsFlags.h | 8 -------- rts/RtsMain.c | 8 -------- rts/RtsMessages.c | 8 -------- rts/RtsSignals.h | 8 -------- rts/RtsStartup.c | 8 -------- rts/RtsUtils.c | 8 -------- rts/RtsUtils.h | 8 -------- rts/STM.c | 8 -------- rts/STM.h | 8 -------- rts/Schedule.c | 8 -------- rts/Schedule.h | 8 -------- rts/Sparks.c | 8 -------- rts/Sparks.h | 8 -------- rts/Stable.c | 8 -------- rts/Stable.h | 8 -------- rts/Stats.c | 8 -------- rts/Stats.h | 8 -------- rts/StgCRun.c | 8 -------- rts/StgPrimFloat.c | 8 -------- rts/StgPrimFloat.h | 8 -------- rts/StgRun.h | 8 -------- rts/Task.c | 8 -------- rts/Task.h | 8 -------- rts/ThreadLabels.c | 8 -------- rts/ThreadLabels.h | 8 -------- rts/ThreadPaused.c | 8 -------- rts/ThreadPaused.h | 8 -------- rts/Threads.c | 8 -------- rts/Threads.h | 8 -------- rts/Ticker.h | 8 -------- rts/Ticky.c | 8 -------- rts/Ticky.h | 8 -------- rts/Timer.c | 8 -------- rts/Timer.h | 8 -------- rts/Trace.c | 8 -------- rts/Trace.h | 8 -------- rts/Updates.h | 8 -------- rts/WSDeque.c | 8 -------- rts/WSDeque.h | 8 -------- rts/Weak.c | 8 -------- rts/Weak.h | 8 -------- rts/eventlog/EventLog.c | 8 -------- rts/eventlog/EventLog.h | 8 -------- rts/hooks/FlagDefaults.c | 8 -------- rts/hooks/MallocFail.c | 8 -------- rts/hooks/OnExit.c | 8 -------- rts/hooks/OutOfHeap.c | 8 -------- rts/hooks/StackOverflow.c | 8 -------- rts/posix/Clock.h | 8 -------- rts/posix/GetEnv.c | 8 -------- rts/posix/GetTime.c | 8 -------- rts/posix/Itimer.c | 8 -------- rts/posix/Itimer.h | 8 -------- rts/posix/OSMem.c | 8 -------- rts/posix/OSThreads.c | 8 -------- rts/posix/Select.c | 8 -------- rts/posix/Select.h | 8 -------- rts/posix/Signals.c | 8 -------- rts/posix/Signals.h | 8 -------- rts/posix/TTY.c | 8 -------- rts/posix/TTY.h | 8 -------- rts/sm/BlockAlloc.c | 8 -------- rts/sm/BlockAlloc.h | 8 -------- rts/sm/Compact.c | 8 -------- rts/sm/Compact.h | 8 -------- rts/sm/Evac.c | 8 -------- rts/sm/Evac.h | 8 -------- rts/sm/GC.c | 8 -------- rts/sm/GC.h | 8 -------- rts/sm/GCAux.c | 8 -------- rts/sm/GCTDecl.h | 8 -------- rts/sm/GCThread.h | 8 -------- rts/sm/GCUtils.c | 8 -------- rts/sm/GCUtils.h | 8 -------- rts/sm/MBlock.c | 8 -------- rts/sm/MarkStack.h | 8 -------- rts/sm/MarkWeak.c | 8 -------- rts/sm/MarkWeak.h | 8 -------- rts/sm/OSMem.h | 8 -------- rts/sm/Sanity.c | 8 -------- rts/sm/Sanity.h | 8 -------- rts/sm/Scav.c | 8 -------- rts/sm/Scav.h | 8 -------- rts/sm/Storage.c | 8 -------- rts/sm/Storage.h | 8 -------- rts/sm/Sweep.c | 8 -------- rts/sm/Sweep.h | 8 -------- rts/win32/AsyncIO.c | 8 -------- rts/win32/AsyncIO.h | 8 -------- rts/win32/AwaitEvent.c | 8 -------- rts/win32/ConsoleHandler.c | 8 -------- rts/win32/ConsoleHandler.h | 8 -------- rts/win32/GetEnv.c | 8 -------- rts/win32/GetTime.c | 8 -------- rts/win32/IOManager.c | 8 -------- rts/win32/IOManager.h | 8 -------- rts/win32/OSMem.c | 8 -------- rts/win32/OSThreads.c | 8 -------- rts/win32/ThrIOManager.c | 8 -------- rts/win32/Ticker.c | 8 -------- rts/win32/WorkQueue.c | 8 -------- rts/win32/WorkQueue.h | 8 -------- rts/win32/seh_excn.c | 8 -------- rts/win32/seh_excn.h | 8 -------- 161 files changed, 1288 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 7371d7e2a7f84a0840683d3db9f4556bc358088e From git at git.haskell.org Mon Sep 29 13:40:27 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Sep 2014 13:40:27 +0000 (UTC) Subject: [commit: ghc] master: bugfix: EventCapsetID should be EventThreadID (e97234d) Message-ID: <20140929134027.5CAC33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e97234ddeed54c41b0c706b6b3bf6f236e451c7d/ghc >--------------------------------------------------------------- commit e97234ddeed54c41b0c706b6b3bf6f236e451c7d Author: Simon Marlow Date: Sat Jul 5 20:56:17 2014 +0100 bugfix: EventCapsetID should be EventThreadID >--------------------------------------------------------------- e97234ddeed54c41b0c706b6b3bf6f236e451c7d rts/eventlog/EventLog.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c index a5a100e..b06f824 100644 --- a/rts/eventlog/EventLog.c +++ b/rts/eventlog/EventLog.c @@ -1117,7 +1117,7 @@ void postThreadLabel(Capability *cap, { EventsBuf *eb; int strsize = strlen(label); - int size = strsize + sizeof(EventCapsetID); + int size = strsize + sizeof(EventThreadID); eb = &capEventBuf[cap->no]; From git at git.haskell.org Mon Sep 29 13:40:30 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Sep 2014 13:40:30 +0000 (UTC) Subject: [commit: ghc] master: Add emacs indentation/line-length settings (23bb904) Message-ID: <20140929134030.609993A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23bb90460d7c963ee617d250fa0a33c6ac7bbc53/ghc >--------------------------------------------------------------- commit 23bb90460d7c963ee617d250fa0a33c6ac7bbc53 Author: Simon Marlow Date: Fri Sep 26 20:16:37 2014 +0100 Add emacs indentation/line-length settings >--------------------------------------------------------------- 23bb90460d7c963ee617d250fa0a33c6ac7bbc53 includes/.dir-locals.el | 12 ++++++++++++ rts/.dir-locals.el | 12 ++++++++++++ 2 files changed, 24 insertions(+) diff --git a/includes/.dir-locals.el b/includes/.dir-locals.el new file mode 100644 index 0000000..c97af77 --- /dev/null +++ b/includes/.dir-locals.el @@ -0,0 +1,12 @@ +;;; Directory Local Variables +;;; See Info node `(emacs) Directory Variables' for more information. + +((c-mode + (fill-column . 80)) + (emacs-lisp-mode + (buffer-file-coding-system . utf-8-unix) + (c-basic-offset . 4) + (indent-tabs-mode))) + + + diff --git a/rts/.dir-locals.el b/rts/.dir-locals.el new file mode 100644 index 0000000..c97af77 --- /dev/null +++ b/rts/.dir-locals.el @@ -0,0 +1,12 @@ +;;; Directory Local Variables +;;; See Info node `(emacs) Directory Variables' for more information. + +((c-mode + (fill-column . 80)) + (emacs-lisp-mode + (buffer-file-coding-system . utf-8-unix) + (c-basic-offset . 4) + (indent-tabs-mode))) + + + From git at git.haskell.org Mon Sep 29 13:40:32 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Sep 2014 13:40:32 +0000 (UTC) Subject: [commit: ghc] master: Document that -dynamic is needed for loading compiled code into GHCi (aeb9c93) Message-ID: <20140929134032.ECDA03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aeb9c936076da2536310c5aee0234270186f54b5/ghc >--------------------------------------------------------------- commit aeb9c936076da2536310c5aee0234270186f54b5 Author: Simon Marlow Date: Tue Sep 2 09:01:45 2014 +0100 Document that -dynamic is needed for loading compiled code into GHCi >--------------------------------------------------------------- aeb9c936076da2536310c5aee0234270186f54b5 docs/users_guide/ghci.xml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/ghci.xml b/docs/users_guide/ghci.xml index 729f96f..cbf5b76 100644 --- a/docs/users_guide/ghci.xml +++ b/docs/users_guide/ghci.xml @@ -226,7 +226,7 @@ Ok, modules loaded: Main. We can compile D, then load the whole program, like this: -Prelude> :! ghc -c D.hs +Prelude> :! ghc -c -dynamic D.hs Prelude> :load A Compiling B ( B.hs, interpreted ) Compiling C ( C.hs, interpreted ) @@ -241,6 +241,11 @@ Ok, modules loaded: A, B, C, D. because the source and everything it depends on is unchanged since the last compilation. + Note the -dynamic flag to GHC: GHCi uses + dynamically-linked object code (if you are on a platform that + supports it), and so in order to use compiled code with GHCi it + must be compiled for dynamic linking. + At any time you can use the command :show modules to get a list of the modules currently loaded From git at git.haskell.org Tue Sep 30 11:00:10 2014 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Sep 2014 11:00:10 +0000 (UTC) Subject: [commit: ghc] wip/new-flatten-skolems-Aug14: Wibbles (fc0694c) Message-ID: <20140930110010.DB2333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/new-flatten-skolems-Aug14 Link : http://ghc.haskell.org/trac/ghc/changeset/fc0694c6fb97b1c6c4b4357a972d9bb59c6e8578/ghc >--------------------------------------------------------------- commit fc0694c6fb97b1c6c4b4357a972d9bb59c6e8578 Author: Simon Peyton Jones Date: Tue Sep 30 11:59:47 2014 +0100 Wibbles >--------------------------------------------------------------- fc0694c6fb97b1c6c4b4357a972d9bb59c6e8578 compiler/typecheck/TcSimplify.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index b99a2e8..e34f89d 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -1162,9 +1162,9 @@ floatEqualities skols no_given_eqs wanteds@(WC { wc_flat = flats }) (float_eqs, remaining_flats) = partitionBag float_me flats float_me :: Ct -> Bool float_me ct - | EqPred ty1 ty2 <- classifyPred pred + | EqPred ty1 ty2 <- classifyPredType pred , skol_set `disjointVarSet` tyVarsOfType pred - , typeKind ty1 `eqKind` typeKind ty2 -- See Note [Do not float kind-incompatible equalities] + , typeKind ty1 `tcEqKind` typeKind ty2 -- See Note [Do not float kind-incompatible equalities] = True | otherwise = False