From git at git.haskell.org Fri Nov 1 09:31:36 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Nov 2013 09:31:36 +0000 (UTC) Subject: [commit: packages/base] master: Add a couple of `/Since: 4.7.0.0/` annotations (cad7219) Message-ID: <20131101093136.59D4A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cad7219d7a149c8bb3e8eeb0467c437f59715506/base >--------------------------------------------------------------- commit cad7219d7a149c8bb3e8eeb0467c437f59715506 Author: Herbert Valerio Riedel Date: Fri Nov 1 10:07:44 2013 +0100 Add a couple of `/Since: 4.7.0.0/` annotations Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- cad7219d7a149c8bb3e8eeb0467c437f59715506 Data/Typeable.hs | 2 ++ GHC/TypeLits.hs | 12 ++++++++++++ System/Mem.hs | 4 ++++ 3 files changed, 18 insertions(+) diff --git a/Data/Typeable.hs b/Data/Typeable.hs index 15aeccb..2f122b9 100644 --- a/Data/Typeable.hs +++ b/Data/Typeable.hs @@ -105,6 +105,8 @@ cast x = if typeRep (Proxy :: Proxy a) == typeRep (Proxy :: Proxy b) else Nothing -- | Extract a witness of equality of two types +-- +-- /Since: 4.7.0.0/ eqT :: forall a b. (Typeable a, Typeable b) => Maybe (a :~: b) eqT = if typeRep (Proxy :: Proxy a) == typeRep (Proxy :: Proxy b) then Just $ unsafeCoerce Refl diff --git a/GHC/TypeLits.hs b/GHC/TypeLits.hs index 41607c3..f3ba70e 100644 --- a/GHC/TypeLits.hs +++ b/GHC/TypeLits.hs @@ -53,18 +53,24 @@ data Symbol -- | This class gives the integer associated with a type-level natural. -- There are instances of the class for every concrete literal: 0, 1, 2, etc. +-- +-- /Since: 4.7.0.0/ class KnownNat (n :: Nat) where natSing :: SNat n -- | This class gives the integer associated with a type-level symbol. -- There are instances of the class for every concrete literal: "hello", etc. +-- +-- /Since: 4.7.0.0/ class KnownSymbol (n :: Symbol) where symbolSing :: SSymbol n +-- | /Since: 4.7.0.0/ natVal :: forall n proxy. KnownNat n => proxy n -> Integer natVal _ = case natSing :: SNat n of SNat x -> x +-- | /Since: 4.7.0.0/ symbolVal :: forall n proxy. KnownSymbol n => proxy n -> String symbolVal _ = case symbolSing :: SSymbol n of SSymbol x -> x @@ -73,17 +79,23 @@ symbolVal _ = case symbolSing :: SSymbol n of -- | This type represents unknown type-level natural numbers. data SomeNat = forall n. KnownNat n => SomeNat (Proxy n) + -- ^ /Since: 4.7.0.0/ -- | This type represents unknown type-level symbols. data SomeSymbol = forall n. KnownSymbol n => SomeSymbol (Proxy n) + -- ^ /Since: 4.7.0.0/ -- | Convert an integer into an unknown type-level natural. +-- +-- /Since: 4.7.0.0/ someNatVal :: Integer -> Maybe SomeNat someNatVal n | n >= 0 = Just (withSNat SomeNat (SNat n) Proxy) | otherwise = Nothing -- | Convert a string into an unknown type-level symbol. +-- +-- /Since: 4.7.0.0/ someSymbolVal :: String -> SomeSymbol someSymbolVal n = withSSymbol SomeSymbol (SSymbol n) Proxy diff --git a/System/Mem.hs b/System/Mem.hs index d46e67e..3674dcb 100644 --- a/System/Mem.hs +++ b/System/Mem.hs @@ -26,7 +26,11 @@ performGC :: IO () performGC = performMajorGC -- | Triggers an immediate garbage collection. +-- +-- /Since: 4.7.0.0/ foreign import ccall "performMajorGC" performMajorGC :: IO () -- | Triggers an immediate minor garbage collection. +-- +-- /Since: 4.7.0.0/ foreign import ccall "performGC" performMinorGC :: IO () From git at git.haskell.org Fri Nov 1 09:31:38 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Nov 2013 09:31:38 +0000 (UTC) Subject: [commit: packages/base] master: Export abstract `Text.Read.Lex.Number` type (1fbfbf8) Message-ID: <20131101093138.5FE632406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1fbfbf8fcbdb2ea218585cb4db3953b4fdbcbfbb/base >--------------------------------------------------------------- commit 1fbfbf8fcbdb2ea218585cb4db3953b4fdbcbfbb Author: Herbert Valerio Riedel Date: Fri Nov 1 10:14:04 2013 +0100 Export abstract `Text.Read.Lex.Number` type This fixes some "could not find link destinations" Haddock warnings and seems to the "right thing to do". The since-annotation for `Number` is changed as the `Number` has becomes referencable in user code only w/ 4.7.0.0 even though it existed already in 4.6.0.0. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 1fbfbf8fcbdb2ea218585cb4db3953b4fdbcbfbb Text/Read/Lex.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Text/Read/Lex.hs b/Text/Read/Lex.hs index ed049f8..557637d 100644 --- a/Text/Read/Lex.hs +++ b/Text/Read/Lex.hs @@ -17,7 +17,7 @@ module Text.Read.Lex -- lexing types - ( Lexeme(..) + ( Lexeme(..), Number , numberToInteger, numberToFixed, numberToRational, numberToRangedRational @@ -61,7 +61,7 @@ data Lexeme | EOF deriving (Eq, Show) --- | /Since: 4.6.0.0/ +-- | /Since: 4.7.0.0/ data Number = MkNumber Int -- Base Digits -- Integral part | MkDecimal Digits -- Integral part From git at git.haskell.org Fri Nov 1 11:18:33 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Nov 2013 11:18:33 +0000 (UTC) Subject: [commit: packages/process] master: Add Hackage2-supported `changelog` file (e3abe50) Message-ID: <20131101111833.B65542406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/process On branch : master Link : http://git.haskell.org/packages/process.git/commitdiff/e3abe50268dc7c0b01c65d5c62f4e1d0c34dcd6f >--------------------------------------------------------------- commit e3abe50268dc7c0b01c65d5c62f4e1d0c34dcd6f Author: Herbert Valerio Riedel Date: Fri Nov 1 12:15:19 2013 +0100 Add Hackage2-supported `changelog` file Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- e3abe50268dc7c0b01c65d5c62f4e1d0c34dcd6f changelog | 11 +++++++++++ process.cabal | 1 + 2 files changed, 12 insertions(+) diff --git a/changelog b/changelog new file mode 100644 index 0000000..fc6a9a1 --- /dev/null +++ b/changelog @@ -0,0 +1,11 @@ +1.2.0.0 Nov 2013 + + * Update to Cabal 1.10 format + * Remove NHC specific code + * Add support for `base-4.7.0.0` + * Improve `showCommandForUser` to reduce redundant quoting + * Use `ExitFailure (128+signal)` on Unix when a proc terminates due to a signal + * Deprecate `module System.Cmd` + * On non-Windows, the child thread now comunicates any errors back + to the parent thread via pipes. + * Fix deadlocks in `readProcess` and `readProcessWithExitCode` diff --git a/process.cabal b/process.cabal index 5b8d8f6..31cb223 100644 --- a/process.cabal +++ b/process.cabal @@ -14,6 +14,7 @@ description: extra-source-files: aclocal.m4 + changelog configure configure.ac include/HsProcessConfig.h.in From git at git.haskell.org Fri Nov 1 11:18:35 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Nov 2013 11:18:35 +0000 (UTC) Subject: [commit: packages/process] master: Add `cabal install` step to Travis-CI script (93f10fb) Message-ID: <20131101111835.B17552406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/process On branch : master Link : http://git.haskell.org/packages/process.git/commitdiff/93f10fb3ba279b6e17b009531a54765850cceb3d >--------------------------------------------------------------- commit 93f10fb3ba279b6e17b009531a54765850cceb3d Author: Herbert Valerio Riedel Date: Fri Nov 1 12:16:00 2013 +0100 Add `cabal install` step to Travis-CI script Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 93f10fb3ba279b6e17b009531a54765850cceb3d .travis.yml | 10 ++++++++++ process.cabal | 2 +- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 36ceec3..17b5adf 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,3 +24,13 @@ script: - cabal-1.18 build - cabal-1.18 check - cabal-1.18 sdist + +# The following scriptlet checks that the resulting source distribution can be built & installed + - export SRC_TGZ=$(cabal-1.18 info . | awk '{print $2 ".tar.gz";exit}') ; + cd dist/; + if [ -f "$SRC_TGZ" ]; then + cabal-1.18 install "$SRC_TGZ"; + else + echo "expected '$SRC_TGZ' not found"; + exit 1; + fi diff --git a/process.cabal b/process.cabal index 31cb223..11279cf 100644 --- a/process.cabal +++ b/process.cabal @@ -62,7 +62,7 @@ library ghc-options: -Wall - build-depends: base >= 4.4 && < 5, + build-depends: base >= 4.4 && < 4.8, directory >= 1.1 && < 1.3, filepath >= 1.2 && < 1.4, deepseq >= 1.1 && < 1.4 From git at git.haskell.org Fri Nov 1 12:21:11 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Nov 2013 12:21:11 +0000 (UTC) Subject: [commit: ghc] master: Remove remains of _scc_ (#8170) (61c8558) Message-ID: <20131101122111.D615B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/61c855803f9d4319e2394e151ddd46089192d84a/ghc >--------------------------------------------------------------- commit 61c855803f9d4319e2394e151ddd46089192d84a Author: Krzysztof Gogolewski Date: Fri Nov 1 12:26:47 2013 +0100 Remove remains of _scc_ (#8170) >--------------------------------------------------------------- 61c855803f9d4319e2394e151ddd46089192d84a compiler/parser/Lexer.x | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 1ace315..49f6dcd 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -469,7 +469,6 @@ data Token | ITthen | ITtype | ITwhere - | ITscc -- ToDo: remove (we use {-# SCC "..." #-} now) | ITforall -- GHC extension keywords | ITforeign From git at git.haskell.org Fri Nov 1 12:21:13 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Nov 2013 12:21:13 +0000 (UTC) Subject: [commit: ghc] master: Remove debugging output (#8356) (eaa4682) Message-ID: <20131101122113.BE67C2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eaa4682b68348eb3b49a0bf2700abc58be820555/ghc >--------------------------------------------------------------- commit eaa4682b68348eb3b49a0bf2700abc58be820555 Author: Krzysztof Gogolewski Date: Fri Nov 1 12:36:28 2013 +0100 Remove debugging output (#8356) >--------------------------------------------------------------- eaa4682b68348eb3b49a0bf2700abc58be820555 compiler/types/FunDeps.lhs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/compiler/types/FunDeps.lhs b/compiler/types/FunDeps.lhs index bd0f7d7..c91a293 100644 --- a/compiler/types/FunDeps.lhs +++ b/compiler/types/FunDeps.lhs @@ -466,8 +466,7 @@ checkInstCoverage be_liberal clas theta inst_taus | if be_liberal then liberal_ok else conservative_ok = Nothing | otherwise - = pprTrace "cic" (vcat [ppr clas <+> ppr inst_taus, ppr fd, ppr ls_tvs, ppr rs_tvs, ppr (oclose theta ls_tvs), ppr theta]) $ - Just msg + = Just msg where (ls,rs) = instFD fd tyvars inst_taus ls_tvs = closeOverKinds (tyVarsOfTypes ls) -- See Note [Closing over kinds in coverage] From git at git.haskell.org Fri Nov 1 12:22:10 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Nov 2013 12:22:10 +0000 (UTC) Subject: [commit: testsuite] master: Test #8492 (d5872bb) Message-ID: <20131101122210.83E8D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d5872bb88d77ecc579f0e2feb95a2ffcfeea9bbb/testsuite >--------------------------------------------------------------- commit d5872bb88d77ecc579f0e2feb95a2ffcfeea9bbb Author: Krzysztof Gogolewski Date: Fri Nov 1 12:34:48 2013 +0100 Test #8492 >--------------------------------------------------------------- d5872bb88d77ecc579f0e2feb95a2ffcfeea9bbb tests/typecheck/should_run/T8492.hs | 6 ++++++ .../cgrun033.stdout => typecheck/should_run/T8492.stdout} | 0 tests/typecheck/should_run/all.T | 1 + 3 files changed, 7 insertions(+) diff --git a/tests/typecheck/should_run/T8492.hs b/tests/typecheck/should_run/T8492.hs new file mode 100644 index 0000000..0fe5a14 --- /dev/null +++ b/tests/typecheck/should_run/T8492.hs @@ -0,0 +1,6 @@ +module Main where + +x :: ((->) Int) Bool +x = (==0) + +main = print $ x 0 diff --git a/tests/codeGen/should_run/cgrun033.stdout b/tests/typecheck/should_run/T8492.stdout similarity index 100% copy from tests/codeGen/should_run/cgrun033.stdout copy to tests/typecheck/should_run/T8492.stdout diff --git a/tests/typecheck/should_run/all.T b/tests/typecheck/should_run/all.T index 410a199..fe87cec 100755 --- a/tests/typecheck/should_run/all.T +++ b/tests/typecheck/should_run/all.T @@ -113,3 +113,4 @@ test('T7861', exit_code(1), compile_and_run, ['']) test('TcTypeNatSimpleRun', normal, compile_and_run, ['']) test('TcCoercible', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, ['']) test('T8119', normal, ghci_script, ['T8119.script']) +test('T8492', normal, compile_and_run, ['']) From git at git.haskell.org Fri Nov 1 14:32:14 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Nov 2013 14:32:14 +0000 (UTC) Subject: [commit: packages/base] master: Add Ord instances for GHC.Generics (#7263) (fe70999) Message-ID: <20131101143214.5AF562406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fe70999f28f0f658ba00647c1178138eeaf4462c/base >--------------------------------------------------------------- commit fe70999f28f0f658ba00647c1178138eeaf4462c Author: Krzysztof Gogolewski Date: Fri Nov 1 15:29:15 2013 +0100 Add Ord instances for GHC.Generics (#7263) >--------------------------------------------------------------- fe70999f28f0f658ba00647c1178138eeaf4462c GHC/Generics.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/GHC/Generics.hs b/GHC/Generics.hs index 4cc5dc0..6480eb1 100644 --- a/GHC/Generics.hs +++ b/GHC/Generics.hs @@ -580,38 +580,38 @@ data V1 p -- | Unit: used for constructors without arguments data U1 p = U1 - deriving (Eq, Read, Show, Generic) + deriving (Eq, Ord, Read, Show, Generic) -- | Used for marking occurrences of the parameter newtype Par1 p = Par1 { unPar1 :: p } - deriving (Eq, Read, Show, Generic) + deriving (Eq, Ord, Read, Show, Generic) -- | Recursive calls of kind * -> * newtype Rec1 f p = Rec1 { unRec1 :: f p } - deriving (Eq, Read, Show, Generic) + deriving (Eq, Ord, Read, Show, Generic) -- | Constants, additional parameters and recursion of kind * newtype K1 i c p = K1 { unK1 :: c } - deriving (Eq, Read, Show, Generic) + deriving (Eq, Ord, Read, Show, Generic) -- | Meta-information (constructor names, etc.) newtype M1 i c f p = M1 { unM1 :: f p } - deriving (Eq, Read, Show, Generic) + deriving (Eq, Ord, Read, Show, Generic) -- | Sums: encode choice between constructors infixr 5 :+: data (:+:) f g p = L1 (f p) | R1 (g p) - deriving (Eq, Read, Show, Generic) + deriving (Eq, Ord, Read, Show, Generic) -- | Products: encode multiple arguments to constructors infixr 6 :*: data (:*:) f g p = f p :*: g p - deriving (Eq, Read, Show, Generic) + deriving (Eq, Ord, Read, Show, Generic) -- | Composition of functors infixr 7 :.: newtype (:.:) f g p = Comp1 { unComp1 :: f (g p) } - deriving (Eq, Read, Show, Generic) + deriving (Eq, Ord, Read, Show, Generic) -- | Tag for K1: recursion (of kind *) data R From git at git.haskell.org Fri Nov 1 15:32:08 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Nov 2013 15:32:08 +0000 (UTC) Subject: [commit: ghc] master: Minor typos (fixes #8496) (d943aff) Message-ID: <20131101153209.041152406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d943affc9121b91bc14e3798c6a2f1a5da38aef0/ghc >--------------------------------------------------------------- commit d943affc9121b91bc14e3798c6a2f1a5da38aef0 Author: Kirill Boltaev Date: Fri Nov 1 19:13:39 2013 +0400 Minor typos (fixes #8496) >--------------------------------------------------------------- d943affc9121b91bc14e3798c6a2f1a5da38aef0 rts/STM.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/rts/STM.c b/rts/STM.c index 8f4bdfb..e342ebf 100644 --- a/rts/STM.c +++ b/rts/STM.c @@ -7,7 +7,7 @@ * -------- * * See the PPoPP 2005 paper "Composable memory transactions". In summary, - * each transcation has a TRec (transaction record) holding entries for each of the + * each transaction has a TRec (transaction record) holding entries for each of the * TVars (transactional variables) that it has accessed. Each entry records * (a) the TVar, (b) the expected value seen in the TVar, (c) the new value that * the transaction wants to write to the TVar, (d) during commit, the identity of @@ -54,7 +54,7 @@ * * lock_tvar / cond_lock_tvar and unlock_tvar are more complex because they * have other effects (present in STM_UNIPROC and STM_CG_LOCK builds) as well - * as the actual business of maniupultaing a lock (present only in STM_FG_LOCKS + * as the actual business of manipulating a lock (present only in STM_FG_LOCKS * builds). This is because locking a TVar is implemented by writing the lock * holder's TRec into the TVar's current_value field: * @@ -68,7 +68,7 @@ * unlock_tvar - release the lock on a specified TVar (STM_FG_LOCKS only), * storing a specified value in place of the lock entry. * - * Using these operations, the typcial pattern of a commit/validate/wait operation + * Using these operations, the typical pattern of a commit/validate/wait operation * is to (a) lock the STM, (b) lock all the TVars being updated, (c) check that * the TVars that were only read from still contain their expected values, * (d) release the locks on the TVars, writing updates to them in the case of a From git at git.haskell.org Fri Nov 1 23:16:05 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Nov 2013 23:16:05 +0000 (UTC) Subject: [commit: packages/haskeline] ghc-head: Fix #124: git import had the wrong encoding for test filenames. (6d890a6) Message-ID: <20131101231605.C3E6B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : ghc-head Link : http://git.haskell.org/packages/haskeline.git/commitdiff/6d890a6bb263999cd3967cb05c1034f66f570ecf >--------------------------------------------------------------- commit 6d890a6bb263999cd3967cb05c1034f66f570ecf Author: Judah Jacobson Date: Wed Oct 30 22:15:05 2013 -0700 Fix #124: git import had the wrong encoding for test filenames. >--------------------------------------------------------------- 6d890a6bb263999cd3967cb05c1034f66f570ecf .../bar" => "tests/dummy-\316\274\316\261\317\203/bar" | 0 .../dummy-\316\274\316\261\317\203/\317\202\316\265\317\201\317\204" | 0 2 files changed, 0 insertions(+), 0 deletions(-) diff --git "a/tests/dummy-\303\216\302\274\303\216\302\261\303\217\302\203/bar" "b/tests/dummy-\316\274\316\261\317\203/bar" similarity index 100% rename from "tests/dummy-\303\216\302\274\303\216\302\261\303\217\302\203/bar" rename to "tests/dummy-\316\274\316\261\317\203/bar" diff --git "a/tests/dummy-\303\216\302\274\303\216\302\261\303\217\302\203/\303\217\302\202\303\216\302\265\303\217\302\201\303\217\302\204" "b/tests/dummy-\316\274\316\261\317\203/\317\202\316\265\317\201\317\204" similarity index 100% rename from "tests/dummy-\303\216\302\274\303\216\302\261\303\217\302\203/\303\217\302\202\303\216\302\265\303\217\302\201\303\217\302\204" rename to "tests/dummy-\316\274\316\261\317\203/\317\202\316\265\317\201\317\204" From git at git.haskell.org Fri Nov 1 23:16:07 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Nov 2013 23:16:07 +0000 (UTC) Subject: [commit: packages/haskeline] ghc-head: Update unit test instructions to compile Unit.hs. (3734dd1) Message-ID: <20131101231607.C9FB02406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : ghc-head Link : http://git.haskell.org/packages/haskeline.git/commitdiff/3734dd146f494094ba76d92fdebb38d7c18bbccc >--------------------------------------------------------------- commit 3734dd146f494094ba76d92fdebb38d7c18bbccc Author: Judah Jacobson Date: Wed Oct 30 22:23:00 2013 -0700 Update unit test instructions to compile Unit.hs. The unit tests are pretty flaky with respect to timing. Compiling Unit.hs seems to help (rather than "runghc Unit.hs" as it was before). >--------------------------------------------------------------- 3734dd146f494094ba76d92fdebb38d7c18bbccc tests/Unit.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/Unit.hs b/tests/Unit.hs index 24a0bbe..2346ebd 100644 --- a/tests/Unit.hs +++ b/tests/Unit.hs @@ -1,7 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} -- Usage: -- ghc ../examples/Test.hs --- runghc Unit.hs ../examples/Test +-- ghc Unit.hs +-- ./Unit ../examples/Test -- Requirements: -- - Empty ~/.haskeline (or set to defaults) -- - Assumes the dummy folder is in the current folder From git at git.haskell.org Fri Nov 1 23:19:21 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Nov 2013 23:19:21 +0000 (UTC) Subject: [commit: ghc] master: Sync up to `haskeline` upstream's HEAD (c4d5289) Message-ID: <20131101231922.453C02406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c4d5289d1c6e453a07bc1240634579b09ef66632/ghc >--------------------------------------------------------------- commit c4d5289d1c6e453a07bc1240634579b09ef66632 Author: Herbert Valerio Riedel Date: Sat Nov 2 00:17:16 2013 +0100 Sync up to `haskeline` upstream's HEAD This contains the Haskeline commit fixing #7768 Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- c4d5289d1c6e453a07bc1240634579b09ef66632 libraries/haskeline | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/haskeline b/libraries/haskeline index 0f23cdd..3734dd1 160000 --- a/libraries/haskeline +++ b/libraries/haskeline @@ -1 +1 @@ -Subproject commit 0f23cdd341f0d72fc86e63198c6f48cbedbd3d16 +Subproject commit 3734dd146f494094ba76d92fdebb38d7c18bbccc From git at git.haskell.org Sat Nov 2 20:58:26 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Nov 2013 20:58:26 +0000 (UTC) Subject: [commit: ghc] master: Load all modules before reporting errors (#8322) (63b8147) Message-ID: <20131102205826.E21E82406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/63b8147f01bd7bd4a46fb013998f138bce3139be/ghc >--------------------------------------------------------------- commit 63b8147f01bd7bd4a46fb013998f138bce3139be Author: Joachim Breitner Date: Tue Sep 17 23:37:02 2013 +0200 Load all modules before reporting errors (#8322) Instead of reporting only one "module not found"" error. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 63b8147f01bd7bd4a46fb013998f138bce3139be compiler/main/GHC.hs | 6 ++-- compiler/main/GhcMake.hs | 73 ++++++++++++++++++++++---------------- compiler/rename/RnNames.lhs | 4 +-- compiler/typecheck/TcRnMonad.lhs | 4 +++ 4 files changed, 52 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 63b8147f01bd7bd4a46fb013998f138bce3139be From git at git.haskell.org Sat Nov 2 20:58:29 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Nov 2013 20:58:29 +0000 (UTC) Subject: [commit: ghc] master: Fix loop on 64bit Big-Endian platforms (#8134) (a4b1a43) Message-ID: <20131102205829.1A7EE2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a4b1a43542b11d09dd3b603d82c5a0e99da67d74/ghc >--------------------------------------------------------------- commit a4b1a43542b11d09dd3b603d82c5a0e99da67d74 Author: Austin Seipp Date: Fri Nov 1 22:17:01 2013 -0500 Fix loop on 64bit Big-Endian platforms (#8134) This is a fun one. In the RTS, `cas` expects a pointer to StgWord which will translate to unsigned long (8 bytes under LP64.) But we had previously declared token_locked as *StgBool* - which evaluates to 'int' (4 bytes under LP64.) That means we fail to provide enough storage for the cas primitive, causing it to corrupt memory on a 64bit platform. Hilariously, this somehow did not affect little-endian platforms (ARM, x86, etc) before. That's because to clear our lock token, we would say: token_locked = 0; But because token_locked is 32bits technically, this only writes to half of the 64bit quantity. On a Big-Endian machine, this won't do anything. That is, token_locked starts as 0: / token_locked | v 0x00000000 and the first cas modifies the memory to: / valid / corrupted | | v v 0x00000000 0x00000001 We then clear token_locked, but this doesn't change the corrupted 4 bytes of memory. And then we try to lock the token again, spinning until it is released - clearly a deadlock. Related: Windows (amd64) doesn't follow LP64, but LLP64, where both int and long are 4 bytes, so this shouldn't change anything on these platforms. Thanks to Reid Barton for helping the diagnosis. Also, thanks to Jens Peterson who confirmed this also fixes building GHC on Fedora/ppc64 and Fedora/s390x. Authored-by: Gustavo Luiz Duarte Signed-off-by: Austin Seipp >--------------------------------------------------------------- a4b1a43542b11d09dd3b603d82c5a0e99da67d74 rts/STM.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/STM.c b/rts/STM.c index e342ebf..bea0356 100644 --- a/rts/STM.c +++ b/rts/STM.c @@ -949,7 +949,7 @@ void stmPreGCHook (Capability *cap) { static volatile StgInt64 max_commits = 0; #if defined(THREADED_RTS) -static volatile StgBool token_locked = FALSE; +static volatile StgWord token_locked = FALSE; static void getTokenBatch(Capability *cap) { while (cas((void *)&token_locked, FALSE, TRUE) == TRUE) { /* nothing */ } From git at git.haskell.org Sat Nov 2 20:58:30 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Nov 2013 20:58:30 +0000 (UTC) Subject: [commit: testsuite] master: Update tcfail082 output (#8322 fallout) (88fd25a) Message-ID: <20131102205831.1A51F2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/88fd25a6085c10ec769ebd2e0b8abc0630817516/testsuite >--------------------------------------------------------------- commit 88fd25a6085c10ec769ebd2e0b8abc0630817516 Author: Austin Seipp Date: Sat Nov 2 02:26:32 2013 -0500 Update tcfail082 output (#8322 fallout) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 88fd25a6085c10ec769ebd2e0b8abc0630817516 tests/typecheck/should_fail/tcfail082.stderr | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tests/typecheck/should_fail/tcfail082.stderr b/tests/typecheck/should_fail/tcfail082.stderr index b34c6d1..11823fe 100644 --- a/tests/typecheck/should_fail/tcfail082.stderr +++ b/tests/typecheck/should_fail/tcfail082.stderr @@ -2,3 +2,11 @@ tcfail082.hs:2:1: Failed to load interface for ?Data82? Use -v to see a list of the files searched for. + +tcfail082.hs:3:1: + Failed to load interface for ?Inst82_1? + Use -v to see a list of the files searched for. + +tcfail082.hs:4:1: + Failed to load interface for ?Inst82_2? + Use -v to see a list of the files searched for. From git at git.haskell.org Sat Nov 2 20:58:31 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Nov 2013 20:58:31 +0000 (UTC) Subject: [commit: ghc] master: Fix a race condition when PROFILING (#8453) (1082f21) Message-ID: <20131102205831.6FDDD2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1082f21b1eaf7b380daefb864959e6cfad1aeec7/ghc >--------------------------------------------------------------- commit 1082f21b1eaf7b380daefb864959e6cfad1aeec7 Author: Takano Akio Date: Thu Oct 17 22:50:43 2013 +0900 Fix a race condition when PROFILING (#8453) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 1082f21b1eaf7b380daefb864959e6cfad1aeec7 rts/sm/Evac.c | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c index 223e2f3..577edc3 100644 --- a/rts/sm/Evac.c +++ b/rts/sm/Evac.c @@ -955,9 +955,15 @@ selector_loop: #ifdef PROFILING // For the purposes of LDV profiling, we have destroyed // the original selector thunk, p. - SET_INFO((StgClosure*)p, (StgInfoTable *)info_ptr); - OVERWRITING_CLOSURE((StgClosure*)p); - SET_INFO((StgClosure*)p, &stg_WHITEHOLE_info); + if (era > 0) { + // Only modify the info pointer when LDV profiling is + // enabled. Note that this is incompatible with parallel GC, + // because it would allow other threads to start evaluating + // the same selector thunk. + SET_INFO((StgClosure*)p, (StgInfoTable *)info_ptr); + OVERWRITING_CLOSURE((StgClosure*)p); + SET_INFO((StgClosure*)p, &stg_WHITEHOLE_info); + } #endif // the closure in val is now the "value" of the From git at git.haskell.org Sat Nov 2 20:58:33 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Nov 2013 20:58:33 +0000 (UTC) Subject: [commit: ghc] master: Add support for module reification (#1480) (69fa2e5) Message-ID: <20131102205834.185BF2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/69fa2e558d56178d33950df815c3233606b0d44e/ghc >--------------------------------------------------------------- commit 69fa2e558d56178d33950df815c3233606b0d44e Author: Austin Seipp Date: Fri Nov 1 22:15:53 2013 -0500 Add support for module reification (#1480) Authored-by: Gergely Risko Signed-off-by: Austin Seipp >--------------------------------------------------------------- 69fa2e558d56178d33950df815c3233606b0d44e compiler/iface/LoadIface.lhs | 12 +++++++++++- compiler/typecheck/TcSplice.lhs | 30 +++++++++++++++++++++++++++++- 2 files changed, 40 insertions(+), 2 deletions(-) diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index ab522db..08e7466 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -10,7 +10,7 @@ Loading interface files module LoadIface ( -- RnM/TcM functions loadModuleInterface, loadModuleInterfaces, - loadSrcInterface, loadInterfaceForName, + loadSrcInterface, loadInterfaceForName, loadInterfaceForModule, -- IfM functions loadInterface, loadWiredInHomeIface, @@ -126,6 +126,16 @@ loadInterfaceForName doc name ; ASSERT2( isExternalName name, ppr name ) initIfaceTcRn $ loadSysInterface doc (nameModule name) } + +-- | Loads the interface for a given Module. +loadInterfaceForModule :: SDoc -> Module -> TcRn ModIface +loadInterfaceForModule doc m + = do + -- Should not be called with this module + when debugIsOn $ do + this_mod <- getModule + MASSERT2( this_mod /= m, ppr m <+> parens doc ) + initIfaceTcRn $ loadSysInterface doc m \end{code} diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index 458fc07..5a55d25 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -55,6 +55,7 @@ import Var import Module import Annotations import TcRnMonad +import LoadIface import Class import Inst import TyCon @@ -1050,6 +1051,7 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where qReifyInstances = reifyInstances qReifyRoles = reifyRoles qReifyAnnotations = reifyAnnotations + qReifyModule = reifyModule -- For qRecover, discard error messages if -- the recovery action is chosen. Otherwise @@ -1654,7 +1656,7 @@ reifyStrict (HsUnpack {}) = TH.Unpacked ------------------------------ lookupThAnnLookup :: TH.AnnLookup -> TcM CoreAnnTarget lookupThAnnLookup (TH.AnnLookupName th_nm) = fmap NamedTarget (lookupThName th_nm) -lookupThAnnLookup (TH.AnnLookupModule pn mn) +lookupThAnnLookup (TH.AnnLookupModule (TH.Module pn mn)) = return $ ModuleTarget $ mkModule (stringToPackageId $ TH.pkgString pn) (mkModuleName $ TH.modString mn) @@ -1668,6 +1670,32 @@ reifyAnnotations th_nm ; return (envAnns ++ epsAnns) } ------------------------------ +modToTHMod :: Module -> TH.Module +modToTHMod m = TH.Module (TH.PkgName $ packageIdString $ modulePackageId m) + (TH.ModName $ moduleNameString $ moduleName m) + +reifyModule :: TH.Module -> TcM TH.ModuleInfo +reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do + this_mod <- getModule + let reifMod = mkModule (stringToPackageId pkgString) (mkModuleName mString) + if (reifMod == this_mod) then reifyThisModule else reifyFromIface reifMod + where + reifyThisModule = do + usages <- fmap (map modToTHMod . moduleEnvKeys . imp_mods) getImports + return $ TH.ModuleInfo usages + + reifyFromIface reifMod = do + iface <- loadInterfaceForModule (ptext (sLit "reifying module from TH for") <+> ppr reifMod) reifMod + let usages = [modToTHMod m | usage <- mi_usages iface, + Just m <- [usageToModule (modulePackageId reifMod) usage] ] + return $ TH.ModuleInfo usages + + usageToModule :: PackageId -> Usage -> Maybe Module + usageToModule _ (UsageFile {}) = Nothing + usageToModule this_pkg (UsageHomeModule { usg_mod_name = mn }) = Just $ mkModule this_pkg mn + usageToModule _ (UsagePackageModule { usg_mod = m }) = Just m + +------------------------------ mkThAppTs :: TH.Type -> [TH.Type] -> TH.Type mkThAppTs fun_ty arg_tys = foldl TH.AppT fun_ty arg_tys From git at git.haskell.org Sat Nov 2 20:58:35 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Nov 2013 20:58:35 +0000 (UTC) Subject: [commit: ghc] master: Nuke trailing whitespace. (23fb7f3) Message-ID: <20131102205835.9257B2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23fb7f3b7987d7b3fa445e54680a8a00a37e714d/ghc >--------------------------------------------------------------- commit 23fb7f3b7987d7b3fa445e54680a8a00a37e714d Author: Austin Seipp Date: Fri Nov 1 22:43:06 2013 -0500 Nuke trailing whitespace. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 23fb7f3b7987d7b3fa445e54680a8a00a37e714d 0 files changed From git at git.haskell.org Sat Nov 2 20:58:37 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Nov 2013 20:58:37 +0000 (UTC) Subject: [commit: ghc] master: adding further documentation and explanation to the prefetch primops (dd2bce5) Message-ID: <20131102205837.A8B362406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dd2bce5ecadf3153c43483aa37c8ff4f42cecc0c/ghc >--------------------------------------------------------------- commit dd2bce5ecadf3153c43483aa37c8ff4f42cecc0c Author: Carter Tazio Schonwald Date: Mon Oct 28 15:16:18 2013 -0400 adding further documentation and explanation to the prefetch primops Signed-off-by: Carter Tazio Schonwald Signed-off-by: Austin Seipp >--------------------------------------------------------------- dd2bce5ecadf3153c43483aa37c8ff4f42cecc0c compiler/prelude/primops.txt.pp | 27 +++++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 5bedc31..cf2aa25 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2604,11 +2604,20 @@ section "Prefetch" This suffix number, N, is the "locality level" of the prefetch, following the convention in GCC and other compilers. Higher locality numbers correspond to the memory being loaded in more - levels of the cpu cache, and being retained after initial use. + levels of the cpu cache, and being retained after initial use. The naming + convention follows the naming convention of the prefetch intrinsic found + in the GCC and Clang C compilers. + + The prefetch primops are all marked with the can_fail=True attribute, but + they will never fail. The motivation for enabling the can_fail attribute is + so that prefetches are not hoisted/let floated out. This is because prefetch + is a tool for optimizing usage of system memory bandwidth, and preventing let + hoising makes *WHEN* the prefetch happens a bit more predictable. + On the LLVM backend, prefetch*N# uses the LLVM prefetch intrinsic with locality level N. The code generated by LLVM is target architecture - dependent, but should agree with the GHC NCG on x86 systems. + dependent, but should agree with the GHC NCG on x86 systems. On the Sparc and PPC native backends, prefetch*N is a No-Op. @@ -2619,6 +2628,20 @@ section "Prefetch" For streaming workloads, the prefetch*0 operations are recommended. For workloads which do many reads or writes to a memory location in a short period of time, prefetch*3 operations are recommended. + + For further reading about prefetch and associated systems performance optimization, + the instruction set and optimization manuals by Intel and other CPU vendors are + excellent starting place. + + + The "Intel 64 and IA-32 Architectures Optimization Reference Manual" is + especially a helpful read, even if your software is meant for other CPU + architectures or vendor hardware. + + http://www.intel.com/content/www/us/en/architecture-and-technology/64-ia-32-architectures-optimization-manual.html + + + } ------------------------------------------------------------------------ From git at git.haskell.org Sat Nov 2 20:58:39 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Nov 2013 20:58:39 +0000 (UTC) Subject: [commit: ghc] master: rts_apply uses CCS_MAIN rather than CCS_SYSTEM (#7753) (773365f) Message-ID: <20131102205839.B84F32406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/773365f91ff141ad38e929844c901ecd5465a000/ghc >--------------------------------------------------------------- commit 773365f91ff141ad38e929844c901ecd5465a000 Author: Takano Akio Date: Tue Oct 1 07:40:35 2013 +0900 rts_apply uses CCS_MAIN rather than CCS_SYSTEM (#7753) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 773365f91ff141ad38e929844c901ecd5465a000 rts/RtsAPI.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c index 720b732..baa9934 100644 --- a/rts/RtsAPI.c +++ b/rts/RtsAPI.c @@ -198,7 +198,12 @@ rts_apply (Capability *cap, HaskellObj f, HaskellObj arg) StgThunk *ap; ap = (StgThunk *)allocate(cap,sizeofW(StgThunk) + 2); - SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_SYSTEM); +#ifdef PROFILING + // Here we don't want to use CCS_SYSTEM, because it's a hidden cost centre, + // and evaluating Haskell code under a hidden cost centre leads to + // confusing profiling output. (#7753) +#endif + SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_MAIN); ap->payload[0] = f; ap->payload[1] = arg; return (StgClosure *)ap; From git at git.haskell.org Sat Nov 2 20:58:41 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Nov 2013 20:58:41 +0000 (UTC) Subject: [commit: ghc] master: Remove superfluous #ifdef from Takano's patch. (7e6786f) Message-ID: <20131102205841.DDC1E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7e6786fae76ee0563b04c261e537d15b341ef6b5/ghc >--------------------------------------------------------------- commit 7e6786fae76ee0563b04c261e537d15b341ef6b5 Author: Austin Seipp Date: Fri Nov 1 22:40:49 2013 -0500 Remove superfluous #ifdef from Takano's patch. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 7e6786fae76ee0563b04c261e537d15b341ef6b5 rts/RtsAPI.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c index baa9934..725bfeb 100644 --- a/rts/RtsAPI.c +++ b/rts/RtsAPI.c @@ -198,11 +198,9 @@ rts_apply (Capability *cap, HaskellObj f, HaskellObj arg) StgThunk *ap; ap = (StgThunk *)allocate(cap,sizeofW(StgThunk) + 2); -#ifdef PROFILING // Here we don't want to use CCS_SYSTEM, because it's a hidden cost centre, // and evaluating Haskell code under a hidden cost centre leads to // confusing profiling output. (#7753) -#endif SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_MAIN); ap->payload[0] = f; ap->payload[1] = arg; From git at git.haskell.org Sat Nov 2 20:58:44 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Nov 2013 20:58:44 +0000 (UTC) Subject: [commit: packages/template-haskell] master: Allow module reification (#1480) (8a02cb1) Message-ID: <20131102205844.9A4432406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/template-haskell On branch : master Link : http://git.haskell.org/packages/template-haskell.git/commitdiff/8a02cb167bb0eaf74bd068142174cd0e8eaa9cf9 >--------------------------------------------------------------- commit 8a02cb167bb0eaf74bd068142174cd0e8eaa9cf9 Author: Austin Seipp Date: Fri Nov 1 22:16:15 2013 -0500 Allow module reification (#1480) Authored-by: Gergely Risko Signed-off-by: Austin Seipp >--------------------------------------------------------------- 8a02cb167bb0eaf74bd068142174cd0e8eaa9cf9 Language/Haskell/TH.hs | 4 +++- Language/Haskell/TH/Lib.hs | 6 ++++++ Language/Haskell/TH/Ppr.hs | 7 +++++++ Language/Haskell/TH/Syntax.hs | 25 ++++++++++++++++++++++--- 4 files changed, 38 insertions(+), 4 deletions(-) diff --git a/Language/Haskell/TH.hs b/Language/Haskell/TH.hs index a5ccca2..2ab19bd 100644 --- a/Language/Haskell/TH.hs +++ b/Language/Haskell/TH.hs @@ -19,7 +19,9 @@ module Language.Haskell.TH( -- ** Querying the compiler -- *** Reify reify, -- :: Name -> Q Info - Info(..), + reifyModule, + thisModule, + Info(..), ModuleInfo(..), InstanceDec, ParentName, Arity, diff --git a/Language/Haskell/TH/Lib.hs b/Language/Haskell/TH/Lib.hs index 38a86d5..0ffa2c0 100644 --- a/Language/Haskell/TH/Lib.hs +++ b/Language/Haskell/TH/Lib.hs @@ -655,3 +655,9 @@ appsE [] = error "appsE []" appsE [x] = x appsE (x:y:zs) = appsE ( (appE x y) : zs ) +-- | Return the Module at the place of splicing. Can be used as an +-- input for 'reifyModule'. +thisModule :: Q Module +thisModule = do + loc <- location + return $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc) diff --git a/Language/Haskell/TH/Ppr.hs b/Language/Haskell/TH/Ppr.hs index 9bec103..2023f3a 100644 --- a/Language/Haskell/TH/Ppr.hs +++ b/Language/Haskell/TH/Ppr.hs @@ -79,6 +79,13 @@ pprFixity v (Fixity i d) = ppr_fix d <+> int i <+> ppr v ------------------------------ +instance Ppr Module where + ppr (Module pkg m) = text (pkgString pkg) <+> text (modString m) + +instance Ppr ModuleInfo where + ppr (ModuleInfo imps) = text "Module" <+> vcat (map ppr imps) + +------------------------------ instance Ppr Exp where ppr = pprExp noPrec diff --git a/Language/Haskell/TH/Syntax.hs b/Language/Haskell/TH/Syntax.hs index e189c0b..f3868d1 100644 --- a/Language/Haskell/TH/Syntax.hs +++ b/Language/Haskell/TH/Syntax.hs @@ -55,6 +55,7 @@ class (Monad m, Applicative m) => Quasi m where -- Works for classes and type functions qReifyRoles :: Name -> m [Role] qReifyAnnotations :: Data a => AnnLookup -> m [a] + qReifyModule :: Module -> m ModuleInfo qLocation :: m Loc @@ -92,9 +93,10 @@ instance Quasi IO where qLookupName _ _ = badIO "lookupName" qReify _ = badIO "reify" - qReifyInstances _ _ = badIO "classInstances" + qReifyInstances _ _ = badIO "reifyInstances" qReifyRoles _ = badIO "reifyRoles" qReifyAnnotations _ = badIO "reifyAnnotations" + qReifyModule _ = badIO "reifyModule" qLocation = badIO "currentLocation" qRecover _ _ = badIO "recover" -- Maybe we could fix this? qAddDependentFile _ = badIO "addDependentFile" @@ -347,6 +349,12 @@ reifyRoles nm = Q (qReifyRoles nm) reifyAnnotations :: Data a => AnnLookup -> Q [a] reifyAnnotations an = Q (qReifyAnnotations an) +-- | @reifyModule mod@ looks up information about module @mod at . To +-- look up the current module, call this function with the return +-- value of @thisModule at . +reifyModule :: Module -> Q ModuleInfo +reifyModule m = Q (qReifyModule m) + -- | Is the list of instances returned by 'reifyInstances' nonempty? isInstance :: Name -> [Type] -> Q Bool isInstance nm tys = do { decs <- reifyInstances nm tys @@ -399,6 +407,7 @@ instance Quasi Q where qReifyInstances = reifyInstances qReifyRoles = reifyRoles qReifyAnnotations = reifyAnnotations + qReifyModule = reifyModule qLookupName = lookupName qLocation = location qRunIO = runIO @@ -519,8 +528,12 @@ newtype ModName = ModName String -- Module name newtype PkgName = PkgName String -- package name deriving (Show,Eq,Ord,Typeable,Data) +-- | Obtained from 'reifyModule' and 'thisModule'. +data Module = Module PkgName ModName -- package qualified module name + deriving (Show,Eq,Ord,Typeable,Data) + newtype OccName = OccName String - deriving (Eq,Ord,Typeable,Data) + deriving (Show,Eq,Ord,Typeable,Data) mkModName :: String -> ModName mkModName s = ModName s @@ -986,6 +999,12 @@ data Info Type -- What it is bound to deriving( Show, Data, Typeable ) +-- | Obtained from 'reifyModule' in the 'Q' Monad. +data ModuleInfo = + -- | Contains the import list of the module. + ModuleInfo [Module] + deriving( Show, Data, Typeable ) + {- | In 'ClassOpI' and 'DataConI', name of the parent class or type -} @@ -1363,7 +1382,7 @@ data Role = NominalR -- ^ @nominal@ deriving( Show, Eq, Data, Typeable ) -- | Annotation target for reifyAnnotations -data AnnLookup = AnnLookupModule PkgName ModName +data AnnLookup = AnnLookupModule Module | AnnLookupName Name deriving( Show, Eq, Data, Typeable ) From git at git.haskell.org Sat Nov 2 21:41:35 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Nov 2013 21:41:35 +0000 (UTC) Subject: [commit: ghc] master: Bump all version numbers in release notes. (5a01117) Message-ID: <20131102214135.369CE2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5a01117eb67f852cf6dbee8ca34e1dae4eca43cd/ghc >--------------------------------------------------------------- commit 5a01117eb67f852cf6dbee8ca34e1dae4eca43cd Author: Austin Seipp Date: Sat Nov 2 16:41:21 2013 -0500 Bump all version numbers in release notes. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 5a01117eb67f852cf6dbee8ca34e1dae4eca43cd docs/users_guide/7.8.1-notes.xml | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/docs/users_guide/7.8.1-notes.xml b/docs/users_guide/7.8.1-notes.xml index cecd856..406cb51 100644 --- a/docs/users_guide/7.8.1-notes.xml +++ b/docs/users_guide/7.8.1-notes.xml @@ -763,7 +763,7 @@ - Version number 1.18.1 (was 1.16.0) + Version number 1.18.1.2 (was 1.16.0) @@ -774,7 +774,7 @@ - Version number XXXX (was XXXX) + Version number 0.5.3.1 (was 0.5.0.0) @@ -785,7 +785,7 @@ - Version number XXXX (was XXXX) + Version number 1.3.0.2 (was 1.3.0.1) @@ -796,7 +796,7 @@ - Version number XXXX (was XXXX) + Version number 1.2.0.2 (was 1.2.0.1) @@ -824,7 +824,7 @@ - Version number XXXX (was XXXX) + Version number 1.3.0.2 (was 1.3.0.1) @@ -835,7 +835,7 @@ - Version number XXXX (was XXXX) + Version number 0.3.1.0 (was 0.3.0.0) @@ -865,7 +865,7 @@ - Version number XXXX (was XXXX) + Version number 2.0.0.3 (was 2.0.0.2) @@ -876,7 +876,7 @@ - Version number XXXX (was XXXX) + Version number 1.1.1.1 (was 1.1.1.0) @@ -887,7 +887,7 @@ - Version number XXXX (was XXXX) + Version number 3.10.0.0 (was 3.9.0.0) @@ -898,7 +898,7 @@ - Version number XXXX (was XXXX) + Version number 0.6.0.1 (was 0.6.0.0) @@ -909,7 +909,7 @@ - Version number XXXX (was XXXX) + Version number 0.5.1.0 (was 0.5.0.0) @@ -920,7 +920,7 @@ - Version number XXXX (was XXXX) + Version number 1.0.0.6 (was 1.0.0.5) @@ -931,7 +931,7 @@ - Version number XXXX (was XXXX) + Version number 1.1.0.2 (was 1.1.0.1) @@ -942,7 +942,7 @@ - Version number XXXX (was XXXX) + Version number 1.2.0.0 (was 1.1.0.2) @@ -960,7 +960,7 @@ - Version number XXXX (was XXXX) + Version number 2.9.0.0 (was 2.8.0.0) @@ -976,7 +976,7 @@ - Version number XXXX (was XXXX) + Version number 1.4.1 (was 1.4.1) @@ -1015,7 +1015,7 @@ - Version number XXXX (was XXXX) + Version number 2.3.0.0 (was 2.3.0.0) From git at git.haskell.org Sat Nov 2 23:00:38 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Nov 2013 23:00:38 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T8322' deleted Message-ID: <20131102230038.43A6E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T8322 From git at git.haskell.org Sun Nov 3 09:00:08 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Nov 2013 09:00:08 +0000 (UTC) Subject: [commit: ghc] master: Silence two AMP warnings (c3e7823) Message-ID: <20131103090008.BC7E02406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c3e7823e560bc4f95b48a6e76f736d875d3937b6/ghc >--------------------------------------------------------------- commit c3e7823e560bc4f95b48a6e76f736d875d3937b6 Author: Herbert Valerio Riedel Date: Sun Nov 3 09:41:43 2013 +0100 Silence two AMP warnings Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- c3e7823e560bc4f95b48a6e76f736d875d3937b6 compiler/cmm/MkGraph.hs | 6 +++++- compiler/typecheck/TcSMonad.lhs | 6 +++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs index bba3d4a..6f9bbf8 100644 --- a/compiler/cmm/MkGraph.hs +++ b/compiler/cmm/MkGraph.hs @@ -27,11 +27,15 @@ import Compiler.Hoopl hiding (Unique, (<*>), mkFirst, mkMiddle, mkLast, mkLabel, import DynFlags import FastString import ForeignCall -import Prelude hiding (succ) import SMRep (ByteOff) import UniqSupply import OrdList +import Control.Monad +import Data.List +import Data.Maybe +import Prelude (($),Int,Eq(..)) -- avoid importing (<*>) + #include "HsVersions.h" diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index 3a01e31..8e23132 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -133,7 +133,7 @@ import UniqFM import Maybes ( orElse, catMaybes, firstJust ) import Pair ( pSnd ) -import Control.Monad( when, zipWithM ) +import Control.Monad( ap, when, zipWithM ) import Data.IORef import TrieMap @@ -989,6 +989,10 @@ newtype TcS a = TcS { unTcS :: TcSEnv -> TcM a } instance Functor TcS where fmap f m = TcS $ fmap f . unTcS m +instance Applicative TcS where + pure = return + (<*>) = ap + instance Monad TcS where return x = TcS (\_ -> return x) fail err = TcS (\_ -> fail err) From git at git.haskell.org Sun Nov 3 09:48:41 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Nov 2013 09:48:41 +0000 (UTC) Subject: [commit: packages/parallel] master: Add Travis-CI script & README (1717209) Message-ID: <20131103094841.C72122406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/parallel On branch : master Link : http://git.haskell.org/packages/parallel.git/commitdiff/1717209d87c42152fe1d154aa2cb4db54113ef9b >--------------------------------------------------------------- commit 1717209d87c42152fe1d154aa2cb4db54113ef9b Author: Herbert Valerio Riedel Date: Sun Nov 3 10:43:00 2013 +0100 Add Travis-CI script & README Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 1717209d87c42152fe1d154aa2cb4db54113ef9b .travis.yml | 41 +++++++++++++++++++++++++++++++++++++++++ README.md | 4 ++++ 2 files changed, 45 insertions(+) diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..20c61fc --- /dev/null +++ b/.travis.yml @@ -0,0 +1,41 @@ +env: + - GHCVER=7.0.1 + - GHCVER=7.0.2 + - GHCVER=7.0.3 + - GHCVER=7.0.4 + - GHCVER=7.2.2 + - GHCVER=7.4.1 + - GHCVER=7.4.2 + - GHCVER=7.6.1 + - GHCVER=7.6.2 + - GHCVER=7.6.3 + - GHCVER=head + +matrix: + allow_failures: + - env: GHCVER=head + +before_install: + - sudo add-apt-repository -y ppa:hvr/ghc + - sudo apt-get update + - sudo apt-get install cabal-install-1.18 ghc-$GHCVER + - export PATH=/opt/ghc/$GHCVER/bin:$PATH + +install: + - cabal-1.18 update + - cabal-1.18 install --only-dependencies + - ghc --version + +script: + - cabal-1.18 configure -v2 + - cabal-1.18 build + - cabal-1.18 check + - cabal-1.18 sdist + - export SRC_TGZ=$(cabal-1.18 info . | awk '{print $2 ".tar.gz";exit}') ; + cd dist/; + if [ -f "$SRC_TGZ" ]; then + cabal-1.18 install "$SRC_TGZ"; + else + echo "expected '$SRC_TGZ' not found"; + exit 1; + fi diff --git a/README.md b/README.md new file mode 100644 index 0000000..047226f --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +The `parallel` Package [![Build Status](https://travis-ci.org/ghc/packages-parallel.png?branch=master)](https://travis-ci.org/ghc/packages-parallel) +====================== + +See [`parallel` on Hackage](http://hackage.haskell.org/package/parallel) for more information. From git at git.haskell.org Sun Nov 3 09:49:53 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Nov 2013 09:49:53 +0000 (UTC) Subject: [commit: packages/parallel] master: Add missing `{-# LANGUAGE #-}` pragmas (162bdd6) Message-ID: <20131103094953.C1D302406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/parallel On branch : master Link : http://git.haskell.org/packages/parallel.git/commitdiff/162bdd68e506e55cafbaf9cbff2b8a1a875f8302 >--------------------------------------------------------------- commit 162bdd68e506e55cafbaf9cbff2b8a1a875f8302 Author: Herbert Valerio Riedel Date: Sun Nov 3 10:26:40 2013 +0100 Add missing `{-# LANGUAGE #-}` pragmas Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 162bdd68e506e55cafbaf9cbff2b8a1a875f8302 Control/Parallel.hs | 2 ++ Control/Parallel/Strategies.hs | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/Control/Parallel.hs b/Control/Parallel.hs index 8c01328..2cae515 100644 --- a/Control/Parallel.hs +++ b/Control/Parallel.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- | -- Module : Control.Parallel diff --git a/Control/Parallel/Strategies.hs b/Control/Parallel/Strategies.hs index 9d2f3f2..b2a04a6 100644 --- a/Control/Parallel/Strategies.hs +++ b/Control/Parallel/Strategies.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MagicHash, UnboxedTuples #-} +{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Parallel.Strategies From git at git.haskell.org Sun Nov 3 09:54:20 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Nov 2013 09:54:20 +0000 (UTC) Subject: [commit: packages/parallel] master: `M-x untabify` & `M-x delete-trailing-whitespace` (a7bdc6a) Message-ID: <20131103095420.50F412406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/parallel On branch : master Link : http://git.haskell.org/packages/parallel.git/commitdiff/a7bdc6ac8454c86aab0d3cfac4dc7ffff49772ba >--------------------------------------------------------------- commit a7bdc6ac8454c86aab0d3cfac4dc7ffff49772ba Author: Herbert Valerio Riedel Date: Sun Nov 3 10:27:48 2013 +0100 `M-x untabify` & `M-x delete-trailing-whitespace` Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- a7bdc6ac8454c86aab0d3cfac4dc7ffff49772ba Control/Parallel.hs | 2 +- Control/Parallel/Strategies.hs | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/Control/Parallel.hs b/Control/Parallel.hs index 2cae515..f882104 100644 --- a/Control/Parallel.hs +++ b/Control/Parallel.hs @@ -19,7 +19,7 @@ module Control.Parallel ( ) where #ifdef __GLASGOW_HASKELL__ -import qualified GHC.Conc ( par, pseq ) +import qualified GHC.Conc ( par, pseq ) infixr 0 `par`, `pseq` #endif diff --git a/Control/Parallel/Strategies.hs b/Control/Parallel/Strategies.hs index b2a04a6..addf792 100644 --- a/Control/Parallel/Strategies.hs +++ b/Control/Parallel/Strategies.hs @@ -891,4 +891,3 @@ The naming scheme is now as follows: 'parBuffer', which are not named after their type constructor (lists) but after their function (rolling buffer of fixed size). -} - From git at git.haskell.org Sun Nov 3 09:54:22 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Nov 2013 09:54:22 +0000 (UTC) Subject: [commit: packages/parallel] master: Modernize `parallel.cabal` to `cabal-version>=1.10` (d862c73) Message-ID: <20131103095422.33CAC2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/parallel On branch : master Link : http://git.haskell.org/packages/parallel.git/commitdiff/d862c73cfa56669d6aa5416b4d59e6343768adee >--------------------------------------------------------------- commit d862c73cfa56669d6aa5416b4d59e6343768adee Author: Herbert Valerio Riedel Date: Sun Nov 3 10:43:18 2013 +0100 Modernize `parallel.cabal` to `cabal-version>=1.10` Note: this bumps the package version to 3.2.0.4 and updates the `build-depends` constraints to match the versions tested via the TravisCI build job. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- d862c73cfa56669d6aa5416b4d59e6343768adee parallel.cabal | 58 +++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 36 insertions(+), 22 deletions(-) diff --git a/parallel.cabal b/parallel.cabal index 444a58f..75cf780 100644 --- a/parallel.cabal +++ b/parallel.cabal @@ -1,33 +1,47 @@ -name: parallel -version: 3.2.0.3 -license: BSD3 -license-file: LICENSE -maintainer: libraries at haskell.org -synopsis: Parallel programming library +name: parallel +version: 3.2.0.4 +license: BSD3 +license-file: LICENSE +maintainer: libraries at haskell.org +synopsis: Parallel programming library +category: Control, Parallelism +build-type: Simple +cabal-version: >=1.10 +tested-with: GHC==7.6.3, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1, GHC==7.2.2, GHC==7.2.1, GHC==7.0.4, GHC==7.0.3, GHC==7.0.2, GHC==7.0.1 description: This package provides a library for parallel programming. -category: Control -build-type: Simple -cabal-version: >=1.6 source-repository head type: git location: http://git.haskell.org/packages/parallel.git -library { - exposed-modules: +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: + BangPatterns + CPP + FlexibleInstances + MagicHash + UnboxedTuples + + exposed-modules: Control.Seq Control.Parallel Control.Parallel.Strategies - extensions: CPP BangPatterns - build-depends: base >= 3 && < 5, - deepseq >= 1.1 && < 1.4, - containers >= 0.1 && < 0.6, - array >= 0.1 && < 0.6 - ghc-options: -Wall - if impl(ghc >= 6.11) { - -- To improve parallel performance: - ghc-options: -feager-blackholing - } -} + build-depends: + array >= 0.3 && < 0.6, + base >= 4.3 && < 4.8, + containers >= 0.4 && < 0.6, + deepseq >= 1.1 && < 1.4 + + ghc-options: -Wall + + if impl(ghc >= 6.11) + -- To improve parallel performance: + ghc-options: -feager-blackholing From git at git.haskell.org Sun Nov 3 11:55:22 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Nov 2013 11:55:22 +0000 (UTC) Subject: [commit: packages/array] master: Add Travis-CI script & README (f2de2ec) Message-ID: <20131103115522.84A682406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/array On branch : master Link : http://git.haskell.org/packages/array.git/commitdiff/f2de2ec7b7e3765beaa1d3d21e3c22082bcc8170 >--------------------------------------------------------------- commit f2de2ec7b7e3765beaa1d3d21e3c22082bcc8170 Author: Herbert Valerio Riedel Date: Sun Nov 3 12:54:19 2013 +0100 Add Travis-CI script & README Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- f2de2ec7b7e3765beaa1d3d21e3c22082bcc8170 .travis.yml | 35 +++++++++++++++++++++++++++++++++++ README.md | 4 ++++ array.cabal | 1 + 3 files changed, 40 insertions(+) diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..e42cee5 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,35 @@ +env: + - GHCVER=7.4.1 + - GHCVER=7.4.2 + - GHCVER=7.6.1 + - GHCVER=7.6.2 + - GHCVER=7.6.3 + - GHCVER=head + +matrix: + allow_failures: + - env: GHCVER=head + +before_install: + - sudo add-apt-repository -y ppa:hvr/ghc + - sudo apt-get update + - sudo apt-get install cabal-install-1.18 ghc-$GHCVER + - export PATH=/opt/ghc/$GHCVER/bin:$PATH + +install: + - cabal-1.18 update + - ghc --version + +script: + - cabal-1.18 configure -v2 + - cabal-1.18 build + - cabal-1.18 check + - cabal-1.18 sdist + - export SRC_TGZ=$(cabal-1.18 info . | awk '{print $2 ".tar.gz";exit}') ; + cd dist/; + if [ -f "$SRC_TGZ" ]; then + cabal-1.18 install "$SRC_TGZ"; + else + echo "expected '$SRC_TGZ' not found"; + exit 1; + fi diff --git a/README.md b/README.md new file mode 100644 index 0000000..4c548d8 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +The `array` Package [![Build Status](https://travis-ci.org/ghc/packages-array.png?branch=master)](https://travis-ci.org/ghc/packages-array) +=================== + +See [`array` on Hackage](http://hackage.haskell.org/package/array) for more information. diff --git a/array.cabal b/array.cabal index a441dd4..e037dc6 100644 --- a/array.cabal +++ b/array.cabal @@ -13,6 +13,7 @@ description: some instances of these classes. cabal-version: >=1.10 build-type: Simple +tested-with: GHC==7.6.3, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1 extra-source-files: changelog From git at git.haskell.org Sun Nov 3 12:03:03 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Nov 2013 12:03:03 +0000 (UTC) Subject: [commit: packages/directory] master: Add Travis-CI script & README (5c9de1f) Message-ID: <20131103120303.514F12406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/directory On branch : master Link : http://git.haskell.org/packages/directory.git/commitdiff/5c9de1f15cf7049d97d7ef42e8f7051d82792361 >--------------------------------------------------------------- commit 5c9de1f15cf7049d97d7ef42e8f7051d82792361 Author: Herbert Valerio Riedel Date: Sun Nov 3 13:02:45 2013 +0100 Add Travis-CI script & README Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 5c9de1f15cf7049d97d7ef42e8f7051d82792361 .travis.yml | 34 ++++++++++++++++++++++++++++++++++ README.md | 15 +++++++++++++++ 2 files changed, 49 insertions(+) diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..c62e226 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,34 @@ +env: + - GHCVER=7.4.1 + - GHCVER=7.4.2 + - GHCVER=7.6.1 + - GHCVER=7.6.2 + - GHCVER=7.6.3 + +before_install: + - sudo add-apt-repository -y ppa:hvr/ghc + - sudo apt-get update + - sudo apt-get install cabal-install-1.18 ghc-$GHCVER autoconf + - export PATH=/opt/ghc/$GHCVER/bin:$PATH + +install: + - cabal-1.18 update + - cabal-1.18 install --only-dependencies + - ghc --version + +script: + - autoreconf -i + - cabal-1.18 configure -v2 + - cabal-1.18 build + - cabal-1.18 check + - cabal-1.18 sdist + +# The following scriptlet checks that the resulting source distribution can be built & installed + - export SRC_TGZ=$(cabal-1.18 info . | awk '{print $2 ".tar.gz";exit}') ; + cd dist/; + if [ -f "$SRC_TGZ" ]; then + cabal-1.18 install "$SRC_TGZ"; + else + echo "expected '$SRC_TGZ' not found"; + exit 1; + fi diff --git a/README.md b/README.md new file mode 100644 index 0000000..e4d6e7f --- /dev/null +++ b/README.md @@ -0,0 +1,15 @@ +The `directory` Package [![Build Status](https://travis-ci.org/ghc/packages-directory.png?branch=master)](https://travis-ci.org/ghc/packages-directory) +======================= + +See [`directory` on Hackage](http://hackage.haskell.org/package/directory) for +more information. + +Installing from Git +------------------- + +To build this package using Cabal directly from Git, you must run +`autoreconf -i` before the usual Cabal build steps (`cabal +{configure,build,install}`). The program `autoreconf` is part of +[GNU autoconf](http://www.gnu.org/software/autoconf/). There is no +need to run the `configure` script: `cabal configure` will do this for +you. From git at git.haskell.org Sun Nov 3 12:10:02 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Nov 2013 12:10:02 +0000 (UTC) Subject: [commit: packages/stm] master: Add Travis-CI script & README (7dceaa2) Message-ID: <20131103121002.1F1092406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/stm On branch : master Link : http://git.haskell.org/packages/stm.git/commitdiff/7dceaa23de6827e38d221fd16e72c89c047ba61d >--------------------------------------------------------------- commit 7dceaa23de6827e38d221fd16e72c89c047ba61d Author: Herbert Valerio Riedel Date: Sun Nov 3 13:09:44 2013 +0100 Add Travis-CI script & README Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 7dceaa23de6827e38d221fd16e72c89c047ba61d .travis.yml | 41 +++++++++++++++++++++++++++++++++++++++++ README.md | 4 ++++ 2 files changed, 45 insertions(+) diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..034a8cc --- /dev/null +++ b/.travis.yml @@ -0,0 +1,41 @@ +env: + - GHCVER=6.12.3 + - GHCVER=7.0.1 + - GHCVER=7.0.2 + - GHCVER=7.0.3 + - GHCVER=7.0.4 + - GHCVER=7.2.1 + - GHCVER=7.2.2 + - GHCVER=7.4.1 + - GHCVER=7.4.2 + - GHCVER=7.6.1 + - GHCVER=7.6.2 + - GHCVER=7.6.3 + - GHCVER=head + +matrix: + allow_failures: + - env: GHCVER=head + +before_install: + - sudo add-apt-repository -y ppa:hvr/ghc + - sudo apt-get update + - sudo apt-get install cabal-install-1.18 ghc-$GHCVER + - export PATH=/opt/ghc/$GHCVER/bin:$PATH + +install: + - cabal-1.18 update + +script: + - cabal-1.18 configure -v2 + - cabal-1.18 build + - cabal-1.18 check + - cabal-1.18 sdist + - export SRC_TGZ=$(cabal-1.18 info . | awk '{print $2 ".tar.gz";exit}') ; + cd dist/; + if [ -f "$SRC_TGZ" ]; then + cabal-1.18 install "$SRC_TGZ"; + else + echo "expected '$SRC_TGZ' not found"; + exit 1; + fi diff --git a/README.md b/README.md new file mode 100644 index 0000000..fac324a --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +The `stm` Package [![Build Status](https://travis-ci.org/ghc/packages-stm.png?branch=master)](https://travis-ci.org/ghc/packages-stm) +================= + +See [`stm` on Hackage](http://hackage.haskell.org/package/stm) for more information. From git at git.haskell.org Sun Nov 3 13:33:40 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Nov 2013 13:33:40 +0000 (UTC) Subject: [commit: packages/deepseq] master: Add Travis-CI script & README (c98c56f) Message-ID: <20131103133340.5ECDD2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/deepseq On branch : master Link : http://git.haskell.org/packages/deepseq.git/commitdiff/c98c56f69a90583480b45909b552d7ee84acfcb3 >--------------------------------------------------------------- commit c98c56f69a90583480b45909b552d7ee84acfcb3 Author: Herbert Valerio Riedel Date: Sun Nov 3 14:32:09 2013 +0100 Add Travis-CI script & README Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- c98c56f69a90583480b45909b552d7ee84acfcb3 .travis.yml | 40 ++++++++++++++++++++++++++++++++++++++++ README.md | 4 ++++ deepseq.cabal | 1 + 3 files changed, 45 insertions(+) diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..f649faa --- /dev/null +++ b/.travis.yml @@ -0,0 +1,40 @@ +env: + - GHCVER=7.0.1 + - GHCVER=7.0.2 + - GHCVER=7.0.3 + - GHCVER=7.0.4 + - GHCVER=7.2.1 + - GHCVER=7.2.2 + - GHCVER=7.4.1 + - GHCVER=7.4.2 + - GHCVER=7.6.1 + - GHCVER=7.6.2 + - GHCVER=7.6.3 + - GHCVER=head + +matrix: + allow_failures: + - env: GHCVER=head + +before_install: + - sudo add-apt-repository -y ppa:hvr/ghc + - sudo apt-get update + - sudo apt-get install cabal-install-1.18 ghc-$GHCVER + - export PATH=/opt/ghc/$GHCVER/bin:$PATH + +install: + - cabal-1.18 update + +script: + - cabal-1.18 configure -v2 + - cabal-1.18 build + - cabal-1.18 check + - cabal-1.18 sdist + - export SRC_TGZ=$(cabal-1.18 info . | awk '{print $2 ".tar.gz";exit}') ; + cd dist/; + if [ -f "$SRC_TGZ" ]; then + cabal-1.18 install "$SRC_TGZ"; + else + echo "expected '$SRC_TGZ' not found"; + exit 1; + fi diff --git a/README.md b/README.md new file mode 100644 index 0000000..3ff11b8 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +The `deepseq` Package [![Build Status](https://travis-ci.org/ghc/packages-deepseq.png?branch=master)](https://travis-ci.org/ghc/packages-deepseq) +===================== + +See [`deepseq` on Hackage](http://hackage.haskell.org/package/deepseq) for more information. diff --git a/deepseq.cabal b/deepseq.cabal index af91fa2..22538d5 100644 --- a/deepseq.cabal +++ b/deepseq.cabal @@ -26,6 +26,7 @@ description: which builds on top of this package. build-type: Simple cabal-version: >=1.10 +tested-with: GHC==7.6.3, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1, GHC==7.2.2, GHC==7.2.1, GHC==7.0.4, GHC==7.0.3, GHC==7.0.2, GHC==7.0.1 source-repository head type: git From git at git.haskell.org Mon Nov 4 01:07:01 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Nov 2013 01:07:01 +0000 (UTC) Subject: [commit: ghc] master: Update documentation concerning prefetch ops (37ae422) Message-ID: <20131104010701.D3B5C2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/37ae422fc1131245705a686d1e3144b3f9e9aa81/ghc >--------------------------------------------------------------- commit 37ae422fc1131245705a686d1e3144b3f9e9aa81 Author: Carter Tazio Schonwald Date: Sat Nov 2 19:12:53 2013 -0400 Update documentation concerning prefetch ops Also remove can_fail=True since it's likely unnecessary upon discussion (see #8256.) Signed-off-by: Austin Seipp >--------------------------------------------------------------- 37ae422fc1131245705a686d1e3144b3f9e9aa81 compiler/prelude/primops.txt.pp | 37 +++++++++++++++---------------------- 1 file changed, 15 insertions(+), 22 deletions(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 872a2bc..37591af 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2608,13 +2608,6 @@ section "Prefetch" convention follows the naming convention of the prefetch intrinsic found in the GCC and Clang C compilers. - The prefetch primops are all marked with the can_fail=True attribute, but - they will never fail. The motivation for enabling the can_fail attribute is - so that prefetches are not hoisted/let floated out. This is because prefetch - is a tool for optimizing usage of system memory bandwidth, and preventing let - hoising makes *WHEN* the prefetch happens a bit more predictable. - - On the LLVM backend, prefetch*N# uses the LLVM prefetch intrinsic with locality level N. The code generated by LLVM is target architecture dependent, but should agree with the GHC NCG on x86 systems. @@ -2636,13 +2629,25 @@ section "Prefetch" The "Intel 64 and IA-32 Architectures Optimization Reference Manual" is especially a helpful read, even if your software is meant for other CPU - architectures or vendor hardware. + architectures or vendor hardware. The manual can be found at + http://www.intel.com/content/www/us/en/architecture-and-technology/64-ia-32-architectures-optimization-manual.html . - http://www.intel.com/content/www/us/en/architecture-and-technology/64-ia-32-architectures-optimization-manual.html + The {\tt prefetchMutableByteArray} family of operations has the order of operations + determined by passing around the {\tt State#} token. + For the {\tt prefetchByteArray} + and {\tt prefetchAddr} families of operations, consider the following example: + + {\tt let a1 = prefetchByteArray2# a n in ...a1... } + + In the above fragement, {\tt a} is the input variable for the prefetch + and {\tt a1 == a} will be true. To ensure that the prefetch is not treated as deadcode, + the body of the let should only use {\tt a1} and NOT {\tt a}. The same principle + applies for uses of prefetch in a loop. + + } - } ------------------------------------------------------------------------ @@ -2651,57 +2656,45 @@ section "Prefetch" --- primop PrefetchByteArrayOp3 "prefetchByteArray3#" GenPrimOp ByteArray# -> Int# -> ByteArray# - with can_fail = True primop PrefetchMutableByteArrayOp3 "prefetchMutableByteArray3#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> State# s - with can_fail = True primop PrefetchAddrOp3 "prefetchAddr3#" GenPrimOp Addr# -> Int# -> Addr# - with can_fail = True ---- primop PrefetchByteArrayOp2 "prefetchByteArray2#" GenPrimOp ByteArray# -> Int# -> ByteArray# - with can_fail = True primop PrefetchMutableByteArrayOp2 "prefetchMutableByteArray2#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> State# s - with can_fail = True primop PrefetchAddrOp2 "prefetchAddr2#" GenPrimOp Addr# -> Int# -> Addr# - with can_fail = True ---- primop PrefetchByteArrayOp1 "prefetchByteArray1#" GenPrimOp ByteArray# -> Int# -> ByteArray# - with can_fail = True primop PrefetchMutableByteArrayOp1 "prefetchMutableByteArray1#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> State# s - with can_fail = True primop PrefetchAddrOp1 "prefetchAddr1#" GenPrimOp Addr# -> Int# -> Addr# - with can_fail = True ---- primop PrefetchByteArrayOp0 "prefetchByteArray0#" GenPrimOp ByteArray# -> Int# -> ByteArray# - with can_fail = True primop PrefetchMutableByteArrayOp0 "prefetchMutableByteArray0#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> State# s - with can_fail = True primop PrefetchAddrOp0 "prefetchAddr0#" GenPrimOp Addr# -> Int# -> Addr# - with can_fail = True From git at git.haskell.org Mon Nov 4 01:07:20 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Nov 2013 01:07:20 +0000 (UTC) Subject: [commit: packages/template-haskell] master: Use addDependentFile in quoteFile. (3701097) Message-ID: <20131104010720.DFAE12406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/template-haskell On branch : master Link : http://git.haskell.org/packages/template-haskell.git/commitdiff/37010971cce739c26d3eedbc2e9c1728b0eba33a >--------------------------------------------------------------- commit 37010971cce739c26d3eedbc2e9c1728b0eba33a Author: Austin Seipp Date: Sun Nov 3 17:32:38 2013 -0600 Use addDependentFile in quoteFile. We'd expect recompilation if these files change. Authored-by: Adam Vogt Signed-off-by: Austin Seipp >--------------------------------------------------------------- 37010971cce739c26d3eedbc2e9c1728b0eba33a Language/Haskell/TH/Quote.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Language/Haskell/TH/Quote.hs b/Language/Haskell/TH/Quote.hs index 3a13fe1..b9c0d25 100644 --- a/Language/Haskell/TH/Quote.hs +++ b/Language/Haskell/TH/Quote.hs @@ -75,7 +75,7 @@ dataToPatQ = dataToQa id litP conP -- the data out of a file. For example, suppose 'asmq' is an -- assembly-language quoter, so that you can write [asmq| ld r1, r2 |] -- as an expression. Then if you define @asmq_f = quoteFile asmq@, then --- the quote [asmq_f| foo.s |] will take input from file "foo.s" instead +-- the quote [asmq_f|foo.s|] will take input from file @"foo.s"@ instead -- of the inline text quoteFile :: QuasiQuoter -> QuasiQuoter quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp, quoteType = qt, quoteDec = qd }) @@ -83,4 +83,5 @@ quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp, quoteType = qt, quoteDec where get :: (String -> Q a) -> String -> Q a get old_quoter file_name = do { file_cts <- runIO (readFile file_name) + ; addDependentFile file_name ; old_quoter file_cts } From git at git.haskell.org Mon Nov 4 08:14:29 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Nov 2013 08:14:29 +0000 (UTC) Subject: [commit: ghc] master: Fix obsolete mention of `darcs-all` script (7ea0c63) Message-ID: <20131104081429.24B072406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7ea0c63b0f8672d98ee834cadb2ab9f7cf4a4248/ghc >--------------------------------------------------------------- commit 7ea0c63b0f8672d98ee834cadb2ab9f7cf4a4248 Author: Herbert Valerio Riedel Date: Sun Nov 3 12:32:15 2013 +0100 Fix obsolete mention of `darcs-all` script Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 7ea0c63b0f8672d98ee834cadb2ab9f7cf4a4248 packages | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/packages b/packages index 2869816..ec77afc 100644 --- a/packages +++ b/packages @@ -28,12 +28,12 @@ # * 'upstreamurl' is the upstream Git repo location for packages # maintained outside of GHC HQ. # -# * The 'tag' determines when "darcs-all get" will get the +# * The 'tag' determines when "sync-all get" will get the # repo. If the tag is "-" then it will always get it, but if there -# is a tag then a corresponding flag must be given to darcs-all, e.g. +# is a tag then a corresponding flag must be given to "sync-all", e.g. # if you want to get the packages with an "extralibs" or "testsuite" -# tag then you need to use "darcs-all --extra --testsuite get". -# Support for new tags must be manually added to the darcs-all script. +# tag then you need to use "sync-all --extra --testsuite get". +# Support for new tags must be manually added to the "sync-all" script. # # 'tag' is also used to determine which packages the build system # deems to have the EXTRA_PACKAGE property: tags 'dph' and 'extra' From git at git.haskell.org Mon Nov 4 08:14:31 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Nov 2013 08:14:31 +0000 (UTC) Subject: [commit: ghc] master: Update obsolete URLs in documentation (2c028d8) Message-ID: <20131104081431.56C6D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2c028d8f96921a1b7b54e2d483c58d73e3f8ab13/ghc >--------------------------------------------------------------- commit 2c028d8f96921a1b7b54e2d483c58d73e3f8ab13 Author: Herbert Valerio Riedel Date: Sun Nov 3 12:33:11 2013 +0100 Update obsolete URLs in documentation Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 2c028d8f96921a1b7b54e2d483c58d73e3f8ab13 HACKING.md | 2 +- docs/users_guide/external_core.xml | 2 +- docs/users_guide/glasgow_exts.xml | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/HACKING.md b/HACKING.md index 74a0804..7a4cc93 100644 --- a/HACKING.md +++ b/HACKING.md @@ -30,7 +30,7 @@ find an overview here: Next, clone the repository and all the associated libraries: ``` -$ git clone http://darcs.haskell.org/ghc.git/ +$ git clone http://git.haskell.org/ghc.git $ cd ghc $ ./sync-all --testsuite get ``` diff --git a/docs/users_guide/external_core.xml b/docs/users_guide/external_core.xml index 3052da6..e435441 100644 --- a/docs/users_guide/external_core.xml +++ b/docs/users_guide/external_core.xml @@ -158,7 +158,7 @@ I am unsure of the proper DocBook elements. Formal static and dynamic semantics in the form of an executable typechecker and interpreter are available separately in the GHC source tree - http://darcs.haskell.org/ghc + http://git.haskell.org/ghc.git under utils/ext-core. diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index b475c36..ce07806 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -8966,7 +8966,7 @@ Because the preprocessor targets Haskell (rather than Core), patterns, written !pat. Bang patterns are under consideration for Haskell Prime. The Haskell +url="http://ghc.haskell.org/trac/haskell-prime/wiki/BangPatterns">Haskell prime feature description contains more discussion and examples than the material below. From git at git.haskell.org Mon Nov 4 08:14:33 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Nov 2013 08:14:33 +0000 (UTC) Subject: [commit: ghc] master: Tweak lookup semantics for GHCi macros (7e4406b) Message-ID: <20131104081433.713682406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7e4406b282647587384981f6b5ee8d7c6309373d/ghc >--------------------------------------------------------------- commit 7e4406b282647587384981f6b5ee8d7c6309373d Author: Herbert Valerio Riedel Date: Sat Nov 2 11:58:09 2013 +0100 Tweak lookup semantics for GHCi macros This changes the prefix-based lookup to prefer macros over builtins only if the macro name matches an existing builtin name. See #8305 for more details. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 7e4406b282647587384981f6b5ee8d7c6309373d ghc/InteractiveUI.hs | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index eb32aa6..5413a1a 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -986,15 +986,23 @@ lookupCommand' ":" = return Nothing lookupCommand' str' = do macros <- liftIO $ readIORef macros_ref ghci_cmds <- ghci_commands `fmap` getGHCiState - let{ (str, cmds) = case str' of - ':' : rest -> (rest, ghci_cmds) -- "::" selects a builtin command - _ -> (str', macros ++ ghci_cmds) } -- otherwise prefer macros - -- look for exact match first, then the first prefix match - return $ case [ c | c <- cmds, str == cmdName c ] of - c:_ -> Just c - [] -> case [ c | c@(s,_,_) <- cmds, str `isPrefixOf` s ] of - [] -> Nothing - c:_ -> Just c + let (str, xcmds) = case str' of + ':' : rest -> (rest, []) -- "::" selects a builtin command + _ -> (str', macros) -- otherwise include macros in lookup + + lookupExact s = find $ (s ==) . cmdName + lookupPrefix s = find $ (s `isPrefixOf`) . cmdName + + builtinPfxMatch = lookupPrefix str ghci_cmds + + -- first, look for exact match (while preferring macros); then, look + -- for first prefix match (preferring builtins), *unless* a macro + -- overrides the builtin; see #8305 for motivation + return $ lookupExact str xcmds <|> + lookupExact str ghci_cmds <|> + (builtinPfxMatch >>= \c -> lookupExact (cmdName c) xcmds) <|> + builtinPfxMatch <|> + lookupPrefix str xcmds getCurrentBreakSpan :: GHCi (Maybe SrcSpan) getCurrentBreakSpan = do From git at git.haskell.org Mon Nov 4 13:38:26 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Nov 2013 13:38:26 +0000 (UTC) Subject: [commit: ghc] master: Mention some new instances in release notes (9f507c6) Message-ID: <20131104133826.AC4C12406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9f507c6b73470874d2e7db3abd83a21d446b4a23/ghc >--------------------------------------------------------------- commit 9f507c6b73470874d2e7db3abd83a21d446b4a23 Author: Krzysztof Gogolewski Date: Mon Nov 4 14:37:51 2013 +0100 Mention some new instances in release notes >--------------------------------------------------------------- 9f507c6b73470874d2e7db3abd83a21d446b4a23 docs/users_guide/7.8.1-notes.xml | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/docs/users_guide/7.8.1-notes.xml b/docs/users_guide/7.8.1-notes.xml index 406cb51..46624ff 100644 --- a/docs/users_guide/7.8.1-notes.xml +++ b/docs/users_guide/7.8.1-notes.xml @@ -631,23 +631,38 @@ The Control.Category module now has the PolyKinds extension enabled, meaning that instances of Category no longer - need be of kind * -> * -> * + need be of kind * -> * -> *. There are now Foldable and Traversable - instances for Either a, Const r, and (,) a + instances for Either a, Const r, and (,) a. - There is now a Monoid instance for Const + There is now a Monoid instance for Const. - There is now a Data instance for Data.Version + There is now a Data instance for Data.Version. + + + + + There are now Eq, Ord, Show and Read instances for ZipList. + + + + + There are now Eq, Ord, Show and Read instances for Down. + + + + + There are now Eq, Ord, Show, Read and Generic instances for types in GHC.Generics (U1, Par1, Rec1, K1, M1, (:+:), (:*:), (:.:)). From git at git.haskell.org Tue Nov 5 12:42:58 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Nov 2013 12:42:58 +0000 (UTC) Subject: [commit: packages/integer-gmp] master: Add primitives to write/read Integers to/from bytearrays (e94799c) Message-ID: <20131105124258.A087D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/integer-gmp On branch : master Link : http://git.haskell.org/packages/integer-gmp.git/commitdiff/e94799c9d5e15fc03bc226197b00b1d4b1189945 >--------------------------------------------------------------- commit e94799c9d5e15fc03bc226197b00b1d4b1189945 Author: Herbert Valerio Riedel Date: Tue Nov 5 12:08:00 2013 +0100 Add primitives to write/read Integers to/from bytearrays This adds the following new (internal) primitives {{{#!hs sizeInBaseInteger :: Integer -> Int# -> Word# exportInteger :: Integer -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) importInteger :: ByteArray# -> Word# -> Word# -> Int# -> Integer }}} The import/export primitives support selecting most/least significant byte first order as well as using an offset into the byte-arrays. See Haddock comments for more details. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- e94799c9d5e15fc03bc226197b00b1d4b1189945 GHC/Integer/GMP/Internals.hs | 2 +- GHC/Integer/GMP/Prim.hs | 19 +++++++++++ GHC/Integer/Type.lhs | 73 +++++++++++++++++++++++++++++++++++++++++- cbits/gmp-wrappers.cmm | 50 +++++++++++++++++++++++++++++ 4 files changed, 142 insertions(+), 2 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e94799c9d5e15fc03bc226197b00b1d4b1189945 From git at git.haskell.org Tue Nov 5 13:48:00 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Nov 2013 13:48:00 +0000 (UTC) Subject: [commit: packages/parallel] master: Add changelog to prepare for 3.2.0.4 release (03da433) Message-ID: <20131105134800.99A882406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/parallel On branch : master Link : http://git.haskell.org/packages/parallel.git/commitdiff/03da43303ed05ace65cb24cee1dbc1766c694233 >--------------------------------------------------------------- commit 03da43303ed05ace65cb24cee1dbc1766c694233 Author: Herbert Valerio Riedel Date: Tue Nov 5 14:46:55 2013 +0100 Add changelog to prepare for 3.2.0.4 release Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 03da43303ed05ace65cb24cee1dbc1766c694233 changelog | 8 ++++++++ parallel.cabal | 2 ++ 2 files changed, 10 insertions(+) diff --git a/changelog b/changelog new file mode 100644 index 0000000..47d98ce --- /dev/null +++ b/changelog @@ -0,0 +1,8 @@ +-*-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/parallel.cabal b/parallel.cabal index 75cf780..1906333 100644 --- a/parallel.cabal +++ b/parallel.cabal @@ -11,6 +11,8 @@ tested-with: GHC==7.6.3, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1, GHC= description: This package provides a library for parallel programming. +extra-source-files: changelog + source-repository head type: git location: http://git.haskell.org/packages/parallel.git From git at git.haskell.org Tue Nov 5 18:34:45 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Nov 2013 18:34:45 +0000 (UTC) Subject: [commit: packages/deepseq] master: Add changelog to prepare for 1.3.0.2 release (6994c77) Message-ID: <20131105183445.9F1172406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/deepseq On branch : master Link : http://git.haskell.org/packages/deepseq.git/commitdiff/6994c775fe9b42eeb3b8afd00dbf928aa7ab221f >--------------------------------------------------------------- commit 6994c775fe9b42eeb3b8afd00dbf928aa7ab221f Author: Herbert Valerio Riedel Date: Tue Nov 5 18:40:19 2013 +0100 Add changelog to prepare for 1.3.0.2 release Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 6994c775fe9b42eeb3b8afd00dbf928aa7ab221f changelog | 35 +++++++++++++++++++++++++++++++++++ deepseq.cabal | 6 ++++-- 2 files changed, 39 insertions(+), 2 deletions(-) diff --git a/changelog b/changelog new file mode 100644 index 0000000..ed643ca --- /dev/null +++ b/changelog @@ -0,0 +1,35 @@ +-*-change-log-*- + +1.3.0.2 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 `/since: .../` annotations to Haddock comments + * Add changelog + +1.3.0.1 Sep 2012 + * No changes + +1.3.0.0 Feb 2012 + * Add instances for `Fixed`, `a->b` and `Version` + +1.3.0.1 Sep 2011 + * Disable SafeHaskell for GHC 7.2 + +1.2.0.0 Sep 2011 + * New function `force` + * New operator `$!!` + * Add SafeHaskell support + * Dropped dependency on containers + +1.1.0.2 Nov 2010 + * Improve Haddock documentation + +1.1.0.1 Oct 2010 + * Enable support for containers-0.4.x + +1.1.0.0 Nov 2009 + * Major rewrite + +1.0.0.0 Nov 2009 + * Initial release diff --git a/deepseq.cabal b/deepseq.cabal index 22538d5..0793123 100644 --- a/deepseq.cabal +++ b/deepseq.cabal @@ -28,6 +28,8 @@ build-type: Simple cabal-version: >=1.10 tested-with: GHC==7.6.3, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1, GHC==7.2.2, GHC==7.2.1, GHC==7.0.4, GHC==7.0.3, GHC==7.0.2, GHC==7.0.1 +extra-source-files: changelog + source-repository head type: git location: http://git.haskell.org/packages/deepseq.git @@ -35,10 +37,10 @@ source-repository head source-repository this type: git location: http://git.haskell.org/packages/deepseq.git - tag: bytestring-1.3.0.2-release + tag: deepseq-1.3.0.2-release library - default-language: Haskell98 + default-language: Haskell2010 other-extensions: CPP if impl(ghc >= 7.2) other-extensions: Safe From git at git.haskell.org Tue Nov 5 20:58:06 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Nov 2013 20:58:06 +0000 (UTC) Subject: [commit: packages/integer-gmp] master: Clean-up Cmm of import/export primitives (dfd65a2) Message-ID: <20131105205807.024132406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/integer-gmp On branch : master Link : http://git.haskell.org/packages/integer-gmp.git/commitdiff/dfd65a28de3fe6093d7e39fab6de960408abeb7e >--------------------------------------------------------------- commit dfd65a28de3fe6093d7e39fab6de960408abeb7e Author: Herbert Valerio Riedel Date: Tue Nov 5 21:26:17 2013 +0100 Clean-up Cmm of import/export primitives This is a follow-up to e94799c9 fixing the Cmm implementation of the primops based on suggestions by Duncan Coutts. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- dfd65a28de3fe6093d7e39fab6de960408abeb7e cbits/gmp-wrappers.cmm | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/cbits/gmp-wrappers.cmm b/cbits/gmp-wrappers.cmm index 186cfad..0da3db8 100644 --- a/cbits/gmp-wrappers.cmm +++ b/cbits/gmp-wrappers.cmm @@ -71,47 +71,48 @@ import "integer-gmp" integer_cbits_decodeDouble; integer_cmm_importIntegerzh (P_ ba, W_ of, W_ sz, W_ e) { - P_ p; - W_ mp_result1; + W_ src_ptr; + W_ mp_result; again: STK_CHK_GEN_N (SIZEOF_MP_INT); MAYBE_GC(again); - p = ba + SIZEOF_StgArrWords + of; + mp_result = Sp - SIZEOF_MP_INT; - mp_result1 = Sp - SIZEOF_MP_INT; + src_ptr = BYTE_ARR_CTS(ba) + of; - ccall __gmpz_init(mp_result1 "ptr"); - ccall __gmpz_import(mp_result1 "ptr", sz, W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, p "ptr"); + ccall __gmpz_init(mp_result "ptr"); + ccall __gmpz_import(mp_result "ptr", sz, W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, src_ptr "ptr"); - return(TO_W_(MP_INT__mp_size(mp_result1)), - MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords); + return(TO_W_(MP_INT__mp_size(mp_result)), + MP_INT__mp_d(mp_result) - SIZEOF_StgArrWords); } +/* :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) */ integer_cmm_exportIntegerzh (W_ s1, P_ d1, P_ mba, W_ of, W_ e) { - P_ dst; + W_ dst_ptr; W_ mp_tmp; - W_ cnt_result1; + W_ cnt_result; again: STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_W); MAYBE_GC(again); - mp_tmp = Sp - SIZEOF_MP_INT; + mp_tmp = Sp - SIZEOF_MP_INT; MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d1)); MP_INT__mp_size(mp_tmp) = (s1); MP_INT__mp_d(mp_tmp) = BYTE_ARR_CTS(d1); - cnt_result1 = Sp - (SIZEOF_MP_INT + SIZEOF_W); - W_[cnt_result1] = 0; + cnt_result = Sp - (SIZEOF_MP_INT + SIZEOF_W); + W_[cnt_result] = 0; - dst = mba + SIZEOF_StgArrWords + of; + dst_ptr = BYTE_ARR_CTS(mba) + of; - ccall __gmpz_export(dst "ptr", cnt_result1 "ptr", W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, mp_tmp "ptr"); + ccall __gmpz_export(dst_ptr "ptr", cnt_result "ptr", W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, mp_tmp "ptr"); - return (W_[cnt_result1]); + return (W_[cnt_result]); } integer_cmm_int2Integerzh (W_ val) From git at git.haskell.org Tue Nov 5 20:58:56 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Nov 2013 20:58:56 +0000 (UTC) Subject: [commit: packages/deepseq] master: fix version (3a9c431) Message-ID: <20131105205856.C02FC2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/deepseq On branch : master Link : http://git.haskell.org/packages/deepseq.git/commitdiff/3a9c431e4c89ca506aae8e80867cfcde8c099724 >--------------------------------------------------------------- commit 3a9c431e4c89ca506aae8e80867cfcde8c099724 Author: Gabor Greif Date: Tue Nov 5 21:50:25 2013 +0100 fix version >--------------------------------------------------------------- 3a9c431e4c89ca506aae8e80867cfcde8c099724 changelog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/changelog b/changelog index ed643ca..9c3286d 100644 --- a/changelog +++ b/changelog @@ -13,7 +13,7 @@ 1.3.0.0 Feb 2012 * Add instances for `Fixed`, `a->b` and `Version` -1.3.0.1 Sep 2011 +1.2.0.1 Sep 2011 * Disable SafeHaskell for GHC 7.2 1.2.0.0 Sep 2011 From git at git.haskell.org Wed Nov 6 08:31:59 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 08:31:59 +0000 (UTC) Subject: [commit: ghc] master: Improve pretty printing of IfaceAT in interface files (a4494ac) Message-ID: <20131106083159.E1B6D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a4494acd07a0b2120623812e57b180b96830a577/ghc >--------------------------------------------------------------- commit a4494acd07a0b2120623812e57b180b96830a577 Author: Simon Peyton Jones Date: Tue Nov 5 14:55:44 2013 +0000 Improve pretty printing of IfaceAT in interface files >--------------------------------------------------------------- a4494acd07a0b2120623812e57b180b96830a577 compiler/iface/IfaceSyn.lhs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index 9088c2e..f693999 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -260,9 +260,9 @@ instance Binary IfaceClassOp where occ <- return $! mkOccNameFS varName n return (IfaceClassOp occ def ty) -data IfaceAT = IfaceAT IfaceDecl [IfaceAxBranch] - -- Nothing => no default associated type instance - -- Just ds => default associated type instance from these templates +data IfaceAT = IfaceAT + IfaceDecl -- The associated type declaration + [IfaceAxBranch] -- Default associated type instances, if any instance Binary IfaceAT where put_ bh (IfaceAT dec defs) = do @@ -1082,7 +1082,10 @@ instance Outputable IfaceClassOp where ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty instance Outputable IfaceAT where - ppr (IfaceAT d defs) = hang (ppr d) 2 (vcat (map ppr defs)) + ppr (IfaceAT d defs) + = vcat [ ppr d + , ppUnless (null defs) $ nest 2 $ + ptext (sLit "Defaults:") <+> vcat (map ppr defs) ] pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc pprIfaceDeclHead context thing tyvars From git at git.haskell.org Wed Nov 6 08:32:01 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 08:32:01 +0000 (UTC) Subject: [commit: ghc] master: Fix marshalling of IfaceAt to and from interface files (6f331d6) Message-ID: <20131106083202.6FBA22406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f331d69e50f13626b65ab76de408a49caebd4f6/ghc >--------------------------------------------------------------- commit 6f331d69e50f13626b65ab76de408a49caebd4f6 Author: Simon Peyton Jones Date: Tue Nov 5 14:58:10 2013 +0000 Fix marshalling of IfaceAt to and from interface files I had forgotten about Note [CoAxBranch type variables] in CoAxiom This patch fixes Trac #8500 >--------------------------------------------------------------- 6f331d69e50f13626b65ab76de408a49caebd4f6 compiler/iface/MkIface.lhs | 4 +++- compiler/iface/TcIface.lhs | 3 ++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index a8d2ccb..b7b5448 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -1513,7 +1513,9 @@ coAxBranchToIfaceBranch' env0 , ifaxbRHS = tidyToIfaceType env1 rhs , ifaxbIncomps = [] } where - (env1, tv_bndrs) = tidyTyVarBndrs env0 tvs + (env1, tv_bndrs) = tidyTyClTyVarBndrs env0 tvs + -- Don't re-bind in-scope tyvars + -- See Note [CoAxBranch type variables] in CoAxiom ----------------- tyConToIfaceDecl :: TidyEnv -> TyCon -> IfaceDecl diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 867af7b..7376169 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -589,7 +589,8 @@ tc_ax_branch :: Kind -> [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch] tc_ax_branch tc_kind prev_branches (IfaceAxBranch { ifaxbTyVars = tv_bndrs, ifaxbLHS = lhs, ifaxbRHS = rhs , ifaxbRoles = roles, ifaxbIncomps = incomps }) - = bindIfaceTyVars tv_bndrs $ \ tvs -> do -- Variables will all be fresh + = bindIfaceTyVars_AT tv_bndrs $ \ tvs -> do + -- The _AT variant is needed here; see Note [CoAxBranch type variables] in CoAxiom { tc_lhs <- tcIfaceTcArgs tc_kind lhs -- See Note [Checking IfaceTypes vs IfaceKinds] ; tc_rhs <- tcIfaceType rhs ; let br = CoAxBranch { cab_loc = noSrcSpan From git at git.haskell.org Wed Nov 6 08:32:04 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 08:32:04 +0000 (UTC) Subject: [commit: ghc] master: Comments on mi_usages (ae9ed7d) Message-ID: <20131106083204.122342406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ae9ed7de3a01be24d3da126e94b846b6c50dce0a/ghc >--------------------------------------------------------------- commit ae9ed7de3a01be24d3da126e94b846b6c50dce0a Author: Simon Peyton Jones Date: Tue Nov 5 14:58:24 2013 +0000 Comments on mi_usages >--------------------------------------------------------------- ae9ed7de3a01be24d3da126e94b846b6c50dce0a compiler/main/HscTypes.lhs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 2d747b6..eab2d29 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -1818,7 +1818,10 @@ instance Binary Dependencies where noDependencies :: Dependencies noDependencies = Deps [] [] [] [] --- | Records modules that we depend on by making a direct import from +-- | Records modules that we depend on, either by direct import, +-- or because we have inlined something from a direct import, and +-- hence now rely on the things mentioned in the inlining +-- See wiki: http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance data Usage -- | Module from another package = UsagePackageModule { @@ -1840,8 +1843,8 @@ data Usage -- NB: usages are for parent names only, e.g. type constructors -- but not the associated data constructors. usg_exports :: Maybe Fingerprint, - -- ^ Fingerprint for the export list we used to depend on this module, - -- if we depend on the export list + -- ^ Fingerprint for the export list of this module, + -- if we directly imported it (and hence we depend on its export list) usg_safe :: IsSafeImport -- ^ Was this module imported as a safe import } -- ^ Module from the current package From git at git.haskell.org Wed Nov 6 08:32:06 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 08:32:06 +0000 (UTC) Subject: [commit: ghc] master: Fix checking of shadowed names (fixes Trac #8499) (e470290) Message-ID: <20131106083206.2A8522406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e470290f87015043af7f297425a722329f726134/ghc >--------------------------------------------------------------- commit e470290f87015043af7f297425a722329f726134 Author: Simon Peyton Jones Date: Tue Nov 5 14:58:51 2013 +0000 Fix checking of shadowed names (fixes Trac #8499) >--------------------------------------------------------------- e470290f87015043af7f297425a722329f726134 compiler/rename/RnEnv.lhs | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index 24c5698..c6c8a90 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -1323,40 +1323,46 @@ check_dup_names names checkShadowedRdrNames :: [Located RdrName] -> RnM () checkShadowedRdrNames loc_rdr_names = do { envs <- getRdrEnvs - ; checkShadowedOccs envs loc_occs } + ; checkShadowedOccs envs get_loc_occ filtered_rdrs } where - loc_occs = [(loc,rdrNameOcc rdr) | L loc rdr <- loc_rdr_names] + filtered_rdrs = filterOut (isExact . unLoc) loc_rdr_names + -- See Note [Binders in Template Haskell] in Convert + get_loc_occ (L loc rdr) = (loc,rdrNameOcc rdr) checkDupAndShadowedNames :: (GlobalRdrEnv, LocalRdrEnv) -> [Name] -> RnM () checkDupAndShadowedNames envs names = do { check_dup_names filtered_names - ; checkShadowedOccs envs loc_occs } + ; checkShadowedOccs envs get_loc_occ filtered_names } where filtered_names = filterOut isSystemName names -- See Note [Binders in Template Haskell] in Convert - loc_occs = [(nameSrcSpan name, nameOccName name) | name <- filtered_names] + get_loc_occ name = (nameSrcSpan name, nameOccName name) ------------------------------------- -checkShadowedOccs :: (GlobalRdrEnv, LocalRdrEnv) -> [(SrcSpan,OccName)] -> RnM () -checkShadowedOccs (global_env,local_env) loc_occs +checkShadowedOccs :: (GlobalRdrEnv, LocalRdrEnv) + -> (a -> (SrcSpan, OccName)) + -> [a] -> RnM () +checkShadowedOccs (global_env,local_env) get_loc_occ ns = whenWOptM Opt_WarnNameShadowing $ - do { traceRn (text "shadow" <+> ppr loc_occs) - ; mapM_ check_shadow loc_occs } + do { traceRn (text "shadow" <+> ppr (map get_loc_occ ns)) + ; mapM_ check_shadow ns } where - check_shadow (loc, occ) + check_shadow n | startsWithUnderscore occ = return () -- Do not report shadowing for "_x" -- See Trac #3262 | Just n <- mb_local = complain [ptext (sLit "bound at") <+> ppr (nameSrcLoc n)] | otherwise = do { gres' <- filterM is_shadowed_gre gres ; complain (map pprNameProvenance gres') } where - complain [] = return () - complain pp_locs = addWarnAt loc (shadowedNameWarn occ pp_locs) - mb_local = lookupLocalRdrOcc local_env occ - gres = lookupGRE_RdrName (mkRdrUnqual occ) global_env + (loc,occ) = get_loc_occ n + mb_local = lookupLocalRdrOcc local_env occ + gres = lookupGRE_RdrName (mkRdrUnqual occ) global_env -- Make an Unqualified RdrName and look that up, so that -- we don't find any GREs that are in scope qualified-only + complain [] = return () + complain pp_locs = addWarnAt loc (shadowedNameWarn occ pp_locs) + is_shadowed_gre :: GlobalRdrElt -> RnM Bool -- Returns False for record selectors that are shadowed, when -- punning or wild-cards are on (cf Trac #2723) From git at git.haskell.org Wed Nov 6 08:32:08 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 08:32:08 +0000 (UTC) Subject: [commit: ghc] master: More comments on Usage and Dependencies (50d4cd7) Message-ID: <20131106083208.6387A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/50d4cd7afd8fdc3efdc3a50b9e8e606336c1cdee/ghc >--------------------------------------------------------------- commit 50d4cd7afd8fdc3efdc3a50b9e8e606336c1cdee Author: Simon Peyton Jones Date: Tue Nov 5 15:17:22 2013 +0000 More comments on Usage and Dependencies >--------------------------------------------------------------- 50d4cd7afd8fdc3efdc3a50b9e8e606336c1cdee compiler/main/HscTypes.lhs | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index eab2d29..1004a6b 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -1776,7 +1776,7 @@ type WhetherHasFamInst = Bool -- | Did this module originate from a *-boot file? type IsBootInterface = Bool --- | Dependency information about modules and packages below this one +-- | Dependency information about ALL modules and packages below this one -- in the import hierarchy. -- -- Invariant: the dependencies of a module @M@ never includes @M at . @@ -1784,16 +1784,23 @@ type IsBootInterface = Bool -- Invariant: none of the lists contain duplicates. data Dependencies = Deps { dep_mods :: [(ModuleName, IsBootInterface)] - -- ^ Home-package module dependencies + -- ^ All home-package modules transitively below this one + -- I.e. modules that this one imports, or that are in the + -- dep_mods of those directly-imported modules + , dep_pkgs :: [(PackageId, Bool)] - -- ^ External package dependencies. The bool indicates - -- if the package is required to be trusted when the - -- module is imported as a safe import (Safe Haskell). - -- See Note [RnNames . Tracking Trust Transitively] + -- ^ All packages transitively below this module + -- I.e. packages to which this module's direct imports belong, + -- or that are in the dep_pkgs of those modules + -- The bool indicates if the package is required to be + -- trusted when the module is imported as a safe import + -- (Safe Haskell). See Note [RnNames . Tracking Trust Transitively] + , dep_orphs :: [Module] -- ^ Orphan modules (whether home or external pkg), -- *not* including family instance orphans as they -- are anyway included in 'dep_finsts' + , dep_finsts :: [Module] -- ^ Modules that contain family instances (whether the -- instances are from the home or an external package) @@ -1818,10 +1825,12 @@ instance Binary Dependencies where noDependencies :: Dependencies noDependencies = Deps [] [] [] [] --- | Records modules that we depend on, either by direct import, --- or because we have inlined something from a direct import, and --- hence now rely on the things mentioned in the inlining +-- | Records modules for which changes may force recompilation of this module -- See wiki: http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance +-- +-- This differs from Dependencies. A module X may be in the dep_mods of this +-- module (via an import chain) but if we don't use anything from X it won't +-- appear in our Usage data Usage -- | Module from another package = UsagePackageModule { From git at git.haskell.org Wed Nov 6 08:32:10 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 08:32:10 +0000 (UTC) Subject: [commit: ghc] master: Comments and reorg only (ba33d57) Message-ID: <20131106083210.79CA92406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ba33d57ea0e150bed6ad6ee0f720944951389514/ghc >--------------------------------------------------------------- commit ba33d57ea0e150bed6ad6ee0f720944951389514 Author: Simon Peyton Jones Date: Wed Nov 6 08:30:12 2013 +0000 Comments and reorg only >--------------------------------------------------------------- ba33d57ea0e150bed6ad6ee0f720944951389514 compiler/types/FunDeps.lhs | 188 +++++++++++++++++++++----------------------- 1 file changed, 90 insertions(+), 98 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ba33d57ea0e150bed6ad6ee0f720944951389514 From git at git.haskell.org Wed Nov 6 08:33:36 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 08:33:36 +0000 (UTC) Subject: [commit: testsuite] master: Test Trac #8500 (d4da5f8) Message-ID: <20131106083336.396FB2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d4da5f8e222f7271e84dfb89d84099503df41467/testsuite >--------------------------------------------------------------- commit d4da5f8e222f7271e84dfb89d84099503df41467 Author: Simon Peyton Jones Date: Wed Nov 6 08:32:50 2013 +0000 Test Trac #8500 >--------------------------------------------------------------- d4da5f8e222f7271e84dfb89d84099503df41467 tests/indexed-types/should_compile/Makefile | 5 +++++ tests/indexed-types/should_compile/T8500.hs | 10 ++++++++++ tests/indexed-types/should_compile/T8500a.hs | 7 +++++++ tests/indexed-types/should_compile/all.T | 6 ++++++ 4 files changed, 28 insertions(+) diff --git a/tests/indexed-types/should_compile/Makefile b/tests/indexed-types/should_compile/Makefile index c65d1f9..5401afd 100644 --- a/tests/indexed-types/should_compile/Makefile +++ b/tests/indexed-types/should_compile/Makefile @@ -36,3 +36,8 @@ T8011: $(RM) T8011a.o T8011a.hi T8011.o T8011.hi '$(TEST_HC)' $(TEST_HC_OPTS) -c T8011a.hs '$(TEST_HC)' $(TEST_HC_OPTS) -c T8011.hs + +T8500: + $(RM) T8500a.o T8500a.hi T8500.o T8500.hi + '$(TEST_HC)' $(TEST_HC_OPTS) -c T8500a.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -c T8500.hs diff --git a/tests/indexed-types/should_compile/T8500.hs b/tests/indexed-types/should_compile/T8500.hs new file mode 100644 index 0000000..5e8f090 --- /dev/null +++ b/tests/indexed-types/should_compile/T8500.hs @@ -0,0 +1,10 @@ + {-# LANGUAGE TypeFamilies #-} + +module T8500 where + +import T8500a + +instance C Int where + type F Int = Double + +instance C Bool diff --git a/tests/indexed-types/should_compile/T8500a.hs b/tests/indexed-types/should_compile/T8500a.hs new file mode 100644 index 0000000..f4f97b9 --- /dev/null +++ b/tests/indexed-types/should_compile/T8500a.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies #-} + +module T8500a where + +class C a where + type F a + type F a = [a] diff --git a/tests/indexed-types/should_compile/all.T b/tests/indexed-types/should_compile/all.T index 6327e6e..8e68a59 100644 --- a/tests/indexed-types/should_compile/all.T +++ b/tests/indexed-types/should_compile/all.T @@ -226,6 +226,12 @@ test('T8011', run_command, ['$MAKE -s --no-print-directory T8011']) +# Marshalling of assocatiated types +test('T8500', + normal, + run_command, + ['$MAKE -s --no-print-directory T8500']) + test('T8018', normal, compile, ['']) test('T8020', normal, compile, ['']) test('ClosedFam1', extra_clean(['ClosedFam1.o-boot', 'ClosedFam1.hi-boot']), From git at git.haskell.org Wed Nov 6 08:33:38 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 08:33:38 +0000 (UTC) Subject: [commit: testsuite] master: Test Trac #8499 (a019503) Message-ID: <20131106083338.7FFAB2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a019503ea3651241fa5d71fd1cdf7c8da8dbbf3a/testsuite >--------------------------------------------------------------- commit a019503ea3651241fa5d71fd1cdf7c8da8dbbf3a Author: Simon Peyton Jones Date: Wed Nov 6 08:33:25 2013 +0000 Test Trac #8499 >--------------------------------------------------------------- a019503ea3651241fa5d71fd1cdf7c8da8dbbf3a tests/th/T8499.hs | 12 ++++++++++++ tests/th/all.T | 1 + 2 files changed, 13 insertions(+) diff --git a/tests/th/T8499.hs b/tests/th/T8499.hs new file mode 100644 index 0000000..353bb9f --- /dev/null +++ b/tests/th/T8499.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE TemplateHaskell, PolyKinds, DataKinds #-} +{-# OPTIONS_GHC -Wall #-} + +module T8499 where + +import Language.Haskell.TH + +$( do TyConI (DataD _ _ [PlainTV tvb_a] _ _) <- reify ''Maybe + my_a <- newName "a" + return [TySynD (mkName "SMaybe") + [KindedTV my_a (AppT (ConT ''Maybe) (VarT tvb_a))] + (TupleT 0)] ) diff --git a/tests/th/all.T b/tests/th/all.T index e38297f..55c5a93 100644 --- a/tests/th/all.T +++ b/tests/th/all.T @@ -303,3 +303,4 @@ test('T8412', normal, compile_fail, ['-v0']) test('T7667', normal, compile, ['-v0']) test('T7667a', normal, compile_fail, ['-v0']) test('T8455', normal, compile, ['-v0']) +test('T8499', normal, compile, ['-v0']) From git at git.haskell.org Wed Nov 6 09:42:28 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 09:42:28 +0000 (UTC) Subject: [commit: testsuite] master: Peak megabytes for T1969 varies from run to run (19b8f3b) Message-ID: <20131106094228.E196E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/19b8f3b39e3ec68fe7dfa305da16e55a58785a8f/testsuite >--------------------------------------------------------------- commit 19b8f3b39e3ec68fe7dfa305da16e55a58785a8f Author: Simon Peyton Jones Date: Wed Nov 6 09:40:47 2013 +0000 Peak megabytes for T1969 varies from run to run >--------------------------------------------------------------- 19b8f3b39e3ec68fe7dfa305da16e55a58785a8f tests/perf/compiler/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/perf/compiler/all.T b/tests/perf/compiler/all.T index 43f8065..1966bfe 100644 --- a/tests/perf/compiler/all.T +++ b/tests/perf/compiler/all.T @@ -13,7 +13,7 @@ test('T1969', # 19 (x86/OS X) # 2013-02-10 13 (x86/Windows) # 2013-02-10 14 (x86/OSX) - (wordsize(64), 30, 10)]), + (wordsize(64), 30, 15)]), # 28 (amd64/Linux) # 34 (amd64/Linux) # 2012-09-20 23 (amd64/Linux) From git at git.haskell.org Wed Nov 6 09:42:31 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 09:42:31 +0000 (UTC) Subject: [commit: testsuite] master: Error messsage wibbles (6162a7c) Message-ID: <20131106094231.158872406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6162a7ce6367c7d9fc9ed864ac146529d2107c2f/testsuite >--------------------------------------------------------------- commit 6162a7ce6367c7d9fc9ed864ac146529d2107c2f Author: Simon Peyton Jones Date: Tue Nov 5 13:53:03 2013 +0000 Error messsage wibbles >--------------------------------------------------------------- 6162a7ce6367c7d9fc9ed864ac146529d2107c2f tests/indexed-types/should_compile/T3017.stderr | 2 +- tests/indexed-types/should_fail/T3330a.hs | 21 +++++++++++++++ tests/indexed-types/should_fail/T3330a.stderr | 17 ++++++------ tests/indexed-types/should_fail/T7729a.stderr | 20 ++++++++++---- tests/indexed-types/should_fail/T8227.stderr | 18 +++++++++---- tests/parser/should_compile/T2245.stderr | 10 +++---- tests/parser/should_fail/readFail003.stderr | 32 ----------------------- tests/typecheck/should_fail/T7453.stderr | 14 +++++----- tests/typecheck/should_fail/T7748a.stderr | 5 +--- tests/typecheck/should_fail/T7869.stderr | 16 ++++++------ tests/typecheck/should_fail/T8142.stderr | 23 +++++++++------- tests/typecheck/should_fail/tcfail204.stderr | 7 +++-- 12 files changed, 96 insertions(+), 89 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 6162a7ce6367c7d9fc9ed864ac146529d2107c2f From git at git.haskell.org Wed Nov 6 09:42:45 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 09:42:45 +0000 (UTC) Subject: [commit: ghc] master: Untabify and whitespace (28e2606) Message-ID: <20131106094245.935DD2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/28e2606c1ab72796bd4e67b28727964ec0d8850f/ghc >--------------------------------------------------------------- commit 28e2606c1ab72796bd4e67b28727964ec0d8850f Author: Simon Peyton Jones Date: Tue Nov 5 12:41:25 2013 +0000 Untabify and whitespace >--------------------------------------------------------------- 28e2606c1ab72796bd4e67b28727964ec0d8850f compiler/typecheck/TcCanonical.lhs | 33 +++++++++++++-------------------- 1 file changed, 13 insertions(+), 20 deletions(-) diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs index 9135894..ad3b13b 100644 --- a/compiler/typecheck/TcCanonical.lhs +++ b/compiler/typecheck/TcCanonical.lhs @@ -1,11 +1,4 @@ \begin{code} -{-# OPTIONS -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 TcCanonical( canonicalize, emitWorkNC, StopOrContinue (..) @@ -518,13 +511,13 @@ flatten loc f ctxt (TyConApp tc tys) -- flatten it away as well, and generate a new given equality constraint -- between the application and a newly generated flattening skolem variable. | otherwise - = ASSERT( tyConArity tc <= length tys ) -- Type functions are saturated + = ASSERT( tyConArity tc <= length tys ) -- Type functions are saturated do { (xis, cos) <- flattenMany loc f ctxt tys ; let (xi_args, xi_rest) = splitAt (tyConArity tc) xis (cos_args, cos_rest) = splitAt (tyConArity tc) cos - -- The type function might be *over* saturated - -- in which case the remaining arguments should - -- be dealt with by AppTys + -- The type function might be *over* saturated + -- in which case the remaining arguments should + -- be dealt with by AppTys fam_ty = mkTyConApp tc xi_args ; (ret_co, rhs_xi) <- @@ -604,7 +597,7 @@ flattenTyVar, flattenFinalTyVar -- for the unification variables that have been unified already with the inert -- equalities, see Note [Spontaneously solved in TyBinds] in TcInteract. flattenTyVar loc f ctxt tv - | not (isTcTyVar tv) -- Happens when flatten under a (forall a. ty) + | not (isTcTyVar tv) -- Happens when flatten under a (forall a. ty) = flattenFinalTyVar loc f ctxt tv -- So ty contains referneces to the non-TcTyVar a | otherwise = do { mb_ty <- isFilledMetaTyVar_maybe tv @@ -712,8 +705,8 @@ emitWorkNC loc evs canEqNC :: CtLoc -> CtEvidence -> Type -> Type -> TcS StopOrContinue canEqNC _loc ev ty1 ty2 - | eqType ty1 ty2 -- Dealing with equality here avoids - -- later spurious occurs checks for a~a + | eqType ty1 ty2 -- Dealing with equality here avoids + -- later spurious occurs checks for a~a = if isWanted ev then setEvBind (ctev_evar ev) (EvCoercion (mkTcReflCo ty1)) >> return Stop else @@ -782,11 +775,11 @@ canEqNC loc ev ty1 ty2 | Just (s1,t1) <- tcSplitAppTy_maybe ty1 , Just (s2,t2) <- tcSplitAppTy_maybe ty2 = do { let xevcomp [x,y] = EvCoercion (mkTcAppCo (evTermCoercion x) (evTermCoercion y)) - xevcomp _ = error "canEqAppTy: can't happen" -- Can't happen - xevdecomp x = let xco = evTermCoercion x - in [EvCoercion (mkTcLRCo CLeft xco), EvCoercion (mkTcLRCo CRight xco)] - ; ctevs <- xCtFlavor ev [mkTcEqPred s1 s2, mkTcEqPred t1 t2] (XEvTerm xevcomp xevdecomp) - ; canEvVarsCreated loc ctevs } + xevcomp _ = error "canEqAppTy: can't happen" -- Can't happen + xevdecomp x = let xco = evTermCoercion x + in [EvCoercion (mkTcLRCo CLeft xco), EvCoercion (mkTcLRCo CRight xco)] + ; ctevs <- xCtFlavor ev [mkTcEqPred s1 s2, mkTcEqPred t1 t2] (XEvTerm xevcomp xevdecomp) + ; canEvVarsCreated loc ctevs } | otherwise = do { emitInsoluble (CNonCanonical { cc_ev = ev, cc_loc = loc }) @@ -993,7 +986,7 @@ classify (TyConApp tc tys) | isSynFamilyTyCon tc , tyConArity tc == length tys = FunCls tc tys classify ty | Just ty' <- tcView ty - = case classify ty' of + = case classify ty' of OtherCls {} -> OtherCls ty var_or_fn -> var_or_fn | otherwise From git at git.haskell.org Wed Nov 6 09:42:47 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 09:42:47 +0000 (UTC) Subject: [commit: ghc] master: Untabify and whitespace (706552a) Message-ID: <20131106094247.C60A52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/706552a2d02e8f83e7e30157200b1ab615c4409e/ghc >--------------------------------------------------------------- commit 706552a2d02e8f83e7e30157200b1ab615c4409e Author: Simon Peyton Jones Date: Tue Nov 5 12:19:10 2013 +0000 Untabify and whitespace >--------------------------------------------------------------- 706552a2d02e8f83e7e30157200b1ab615c4409e compiler/basicTypes/VarEnv.lhs | 265 +++++++++++++++++++--------------------- 1 file changed, 129 insertions(+), 136 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 706552a2d02e8f83e7e30157200b1ab615c4409e From git at git.haskell.org Wed Nov 6 09:42:49 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 09:42:49 +0000 (UTC) Subject: [commit: ghc] master: Make -ddump-tc-trace imply -ddump-cs-trace (1548d83) Message-ID: <20131106094249.C40282406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1548d83e9b18fe67e97f04febbdf4ef2fbaaf759/ghc >--------------------------------------------------------------- commit 1548d83e9b18fe67e97f04febbdf4ef2fbaaf759 Author: Simon Peyton Jones Date: Tue Nov 5 12:17:27 2013 +0000 Make -ddump-tc-trace imply -ddump-cs-trace >--------------------------------------------------------------- 1548d83e9b18fe67e97f04febbdf4ef2fbaaf759 compiler/main/DynFlags.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 522e761..34d5a47 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2317,7 +2317,8 @@ dynamic_flags = [ , Flag "ddump-rn-trace" (setDumpFlag Opt_D_dump_rn_trace) , Flag "ddump-if-trace" (setDumpFlag Opt_D_dump_if_trace) , Flag "ddump-cs-trace" (setDumpFlag Opt_D_dump_cs_trace) - , Flag "ddump-tc-trace" (setDumpFlag Opt_D_dump_tc_trace) + , Flag "ddump-tc-trace" (NoArg (do { setDumpFlag' Opt_D_dump_tc_trace + ; setDumpFlag' Opt_D_dump_cs_trace })) , Flag "ddump-vt-trace" (setDumpFlag Opt_D_dump_vt_trace) , Flag "ddump-splices" (setDumpFlag Opt_D_dump_splices) , Flag "ddump-rn-stats" (setDumpFlag Opt_D_dump_rn_stats) @@ -3248,7 +3249,6 @@ forceRecompile = do dfs <- liftEwM getCmdLineState when (force_recomp dfs) (setGeneralFlag Opt_ForceRecomp) where force_recomp dfs = isOneShot (ghcMode dfs) - setVerboseCore2Core :: DynP () setVerboseCore2Core = do setDumpFlag' Opt_D_verbose_core2core upd (\dfs -> dfs { shouldDumpSimplPhase = Nothing }) From git at git.haskell.org Wed Nov 6 09:42:51 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 09:42:51 +0000 (UTC) Subject: [commit: ghc] master: Refactor the constraint solver (again!) (06aac68) Message-ID: <20131106094251.ED35E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/06aac68dee100b21dc7d304fa90d9baa423507a0/ghc >--------------------------------------------------------------- commit 06aac68dee100b21dc7d304fa90d9baa423507a0 Author: Simon Peyton Jones Date: Tue Nov 5 12:38:33 2013 +0000 Refactor the constraint solver (again!) There are three core changes here: a) In the constraint-solver pipeline. Given a work-item 'wi', the old scheme was: let relevant = getRelevantInerts wi interact 'wi' with each constraint in 'relevant' Bu now we have a single step interact 'wi' with the inert-set This turns out to avoid duplication, between getRelevantInerts (which needs to know which are relevant) and the interact step. Simpler, cleaner. This in turn made it sensible to combine the 'spontaneous solve' stage into the 'interact with inerts' stage. b) Wanteds are no longer used to rewrite wanteds. See Trac #8450. This in turn means that the inert set may have - many CFunEqCans with the same LHS - many CTyEqCans with the same LHS Hence the EqualCtList in teh domain of inert_eqs and inert_funeqs c) Some refactoring of the representation of the inert set, Notably inert_dicts and inert_funeqs are indexed by Class and TyCon respectively, so we can easily get all the constraints relevant to that class or tycon There are many knock on effects! This started as a small job but I ended up doing qite a lot. Some error messages in the test suite really did improve as a result of (b) >--------------------------------------------------------------- 06aac68dee100b21dc7d304fa90d9baa423507a0 compiler/typecheck/TcCanonical.lhs | 46 +- compiler/typecheck/TcErrors.lhs | 145 +++-- compiler/typecheck/TcInteract.lhs | 1212 +++++++++++++++++++----------------- compiler/typecheck/TcRnTypes.lhs | 86 ++- compiler/typecheck/TcSMonad.lhs | 585 +++++++++-------- libraries/Cabal | 2 +- 6 files changed, 1081 insertions(+), 995 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 06aac68dee100b21dc7d304fa90d9baa423507a0 From git at git.haskell.org Wed Nov 6 09:42:54 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 09:42:54 +0000 (UTC) Subject: [commit: ghc] master: Add filterVarEnv (2c6b201) Message-ID: <20131106094254.379E92406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2c6b20103f1c4a4c243c5858cba4c3730668d4ab/ghc >--------------------------------------------------------------- commit 2c6b20103f1c4a4c243c5858cba4c3730668d4ab Author: Simon Peyton Jones Date: Tue Nov 5 12:17:57 2013 +0000 Add filterVarEnv >--------------------------------------------------------------- 2c6b20103f1c4a4c243c5858cba4c3730668d4ab compiler/basicTypes/VarEnv.lhs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/basicTypes/VarEnv.lhs b/compiler/basicTypes/VarEnv.lhs index 9f88d0b..2d01673 100644 --- a/compiler/basicTypes/VarEnv.lhs +++ b/compiler/basicTypes/VarEnv.lhs @@ -27,7 +27,7 @@ module VarEnv ( modifyVarEnv, modifyVarEnv_Directly, isEmptyVarEnv, foldVarEnv, elemVarEnvByKey, lookupVarEnv_Directly, - filterVarEnv_Directly, restrictVarEnv, + filterVarEnv, filterVarEnv_Directly, restrictVarEnv, partitionVarEnv, -- * The InScopeSet type @@ -399,6 +399,7 @@ varEnvKeys :: VarEnv a -> [Unique] isEmptyVarEnv :: VarEnv a -> Bool lookupVarEnv :: VarEnv a -> Var -> Maybe a +filterVarEnv :: (a -> Bool) -> VarEnv a -> VarEnv a lookupVarEnv_NF :: VarEnv a -> Var -> a lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a elemVarEnv :: Var -> VarEnv a -> Bool @@ -421,6 +422,7 @@ minusVarEnv = minusUFM intersectsVarEnv e1 e2 = not (isEmptyVarEnv (e1 `intersectUFM` e2)) plusVarEnv = plusUFM lookupVarEnv = lookupUFM +filterVarEnv = filterUFM lookupWithDefaultVarEnv = lookupWithDefaultUFM mapVarEnv = mapUFM mkVarEnv = listToUFM From git at git.haskell.org Wed Nov 6 09:46:58 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 09:46:58 +0000 (UTC) Subject: [commit: testsuite] master: Test Trac #8450 (8c88d0a) Message-ID: <20131106094658.283542406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8c88d0a9b205a31b1708a7069c4aa417373f9ac3/testsuite >--------------------------------------------------------------- commit 8c88d0a9b205a31b1708a7069c4aa417373f9ac3 Author: Simon Peyton Jones Date: Wed Nov 6 09:46:44 2013 +0000 Test Trac #8450 >--------------------------------------------------------------- 8c88d0a9b205a31b1708a7069c4aa417373f9ac3 tests/typecheck/should_fail/T8450.hs | 8 ++++++++ tests/typecheck/should_fail/T8450.stderr | 13 +++++++++++++ tests/typecheck/should_fail/all.T | 1 + 3 files changed, 22 insertions(+) diff --git a/tests/typecheck/should_fail/T8450.hs b/tests/typecheck/should_fail/T8450.hs new file mode 100644 index 0000000..ac122e7 --- /dev/null +++ b/tests/typecheck/should_fail/T8450.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T8450 where + +runEffect :: Either Bool r -> r +runEffect = undefined + +run :: forall a. a +run = runEffect $ (undefined :: Either a ()) diff --git a/tests/typecheck/should_fail/T8450.stderr b/tests/typecheck/should_fail/T8450.stderr new file mode 100644 index 0000000..3688005 --- /dev/null +++ b/tests/typecheck/should_fail/T8450.stderr @@ -0,0 +1,13 @@ + +T8450.hs:8:20: + Couldn't match type ?a? with ?Bool? + ?a? is a rigid type variable bound by + the type signature for run :: a at T8450.hs:7:15 + Expected type: Either Bool () + Actual type: Either a () + Relevant bindings include run :: a (bound at T8450.hs:8:1) + In the second argument of ?($)?, namely + ?(undefined :: Either a ())? + In the expression: runEffect $ (undefined :: Either a ()) + In an equation for ?run?: + run = runEffect $ (undefined :: Either a ()) diff --git a/tests/typecheck/should_fail/all.T b/tests/typecheck/should_fail/all.T index 0abc6c7..1d15999 100644 --- a/tests/typecheck/should_fail/all.T +++ b/tests/typecheck/should_fail/all.T @@ -322,3 +322,4 @@ test('TcCoercibleFail2', when(compiler_lt('ghc', '7.7'), skip), compile_fail, [' test('T8306', normal, compile_fail, ['']) test('T8392a', normal, compile_fail, ['']) test('T8428', normal, compile_fail, ['']) +test('T8450', normal, compile_fail, ['']) From git at git.haskell.org Wed Nov 6 10:39:30 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 10:39:30 +0000 (UTC) Subject: [commit: ghc] master: Zonk the type in reifyInstances (fixes Trac #7477) (8944fd3) Message-ID: <20131106103930.797B72406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8944fd3fc5fa7d435f438c5680c8d177257d27e9/ghc >--------------------------------------------------------------- commit 8944fd3fc5fa7d435f438c5680c8d177257d27e9 Author: Simon Peyton Jones Date: Wed Nov 6 09:30:20 2013 +0000 Zonk the type in reifyInstances (fixes Trac #7477) A simple oversight, but crucial! tcLHsType was returning F k Int where k is a unification variable that has been unified with * >--------------------------------------------------------------- 8944fd3fc5fa7d435f438c5680c8d177257d27e9 compiler/typecheck/TcSplice.lhs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index 5a55d25..fde2d7b 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -1171,16 +1171,22 @@ reifyInstances th_nm th_tys ; (rn_ty, _fvs) <- checkNoErrs $ rnLHsType doc rdr_ty -- Rename to HsType Name -- checkNoErrs: see Note [Renamer errors] ; (ty, _kind) <- tcLHsType rn_ty + ; ty <- zonkTcTypeToType emptyZonkEnv ty -- Substitute out the meta type variables + -- In particular, the type might have kind + -- variables inside it (Trac #7477) + ; traceTc "reifyInstances" (ppr ty $$ ppr (typeKind ty)) ; case splitTyConApp_maybe ty of -- This expands any type synonyms Just (tc, tys) -- See Trac #7910 | Just cls <- tyConClass_maybe tc -> do { inst_envs <- tcGetInstEnvs ; let (matches, unifies, _) = lookupInstEnv inst_envs cls tys + ; traceTc "reifyInstances1" (ppr matches) ; mapM reifyClassInstance (map fst matches ++ unifies) } | isOpenFamilyTyCon tc -> do { inst_envs <- tcGetFamInstEnvs ; let matches = lookupFamInstEnv inst_envs tc tys + ; traceTc "reifyInstances2" (ppr matches) ; mapM (reifyFamilyInstance . fim_instance) matches } _ -> bale_out (hang (ptext (sLit "reifyInstances:") <+> quotes (ppr ty)) 2 (ptext (sLit "is not a class constraint or type family application"))) } From git at git.haskell.org Wed Nov 6 10:39:32 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 10:39:32 +0000 (UTC) Subject: [commit: ghc] master: Improve a parser error message (Trac #8506) (38438e1) Message-ID: <20131106103932.8C61A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/38438e1325461f8f6d32b21378cc10584e6b012e/ghc >--------------------------------------------------------------- commit 38438e1325461f8f6d32b21378cc10584e6b012e Author: Simon Peyton Jones Date: Wed Nov 6 09:30:40 2013 +0000 Improve a parser error message (Trac #8506) >--------------------------------------------------------------- 38438e1325461f8f6d32b21378cc10584e6b012e compiler/parser/RdrHsSyn.lhs | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 47abe3a..cd88566 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -36,7 +36,6 @@ module RdrHsSyn ( -- checking and constructing values checkPrecP, -- Int -> P Int checkContext, -- HsType -> P HsContext - checkTyVars, -- [LHsType RdrName] -> P () checkPattern, -- HsExp -> P HsPat bang_RDR, checkPatterns, -- SrcLoc -> [HsExp] -> P [HsPat] @@ -119,7 +118,7 @@ mkClassDecl loc (L _ (mcxt, tycl_hdr)) fds where_cls = do { let (binds, sigs, ats, at_defs, _, docs) = cvBindsAndSigs (unLoc where_cls) cxt = fromMaybe (noLoc []) mcxt ; (cls, tparams) <- checkTyClHdr tycl_hdr - ; tyvars <- checkTyVars tycl_hdr tparams -- Only type vars allowed + ; tyvars <- checkTyVars "class" cls tparams -- Only type vars allowed ; return (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = reLocate loc cls, tcdTyVars = tyvars, tcdFDs = unLoc fds, tcdSigs = sigs, tcdMeths = binds, tcdATs = ats, tcdATDefs = at_defs, tcdDocs = docs, @@ -135,7 +134,7 @@ mkTyData :: SrcSpan -> P (LTyClDecl RdrName) mkTyData loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv = do { (tc, tparams) <- checkTyClHdr tycl_hdr - ; tyvars <- checkTyVars tycl_hdr tparams + ; tyvars <- checkTyVars "data" tc tparams ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv ; return (L loc (DataDecl { tcdLName = reLocate loc tc, tcdTyVars = tyvars, tcdDataDefn = defn, @@ -177,7 +176,7 @@ mkTySynonym :: SrcSpan -> P (LTyClDecl RdrName) mkTySynonym loc lhs rhs = do { (tc, tparams) <- checkTyClHdr lhs - ; tyvars <- checkTyVars lhs tparams + ; tyvars <- checkTyVars "type" tc tparams ; return (L loc (SynDecl { tcdLName = reLocate loc tc, tcdTyVars = tyvars , tcdRhs = rhs, tcdFVs = placeHolderNames })) } @@ -204,7 +203,7 @@ mkFamDecl :: SrcSpan -> P (LFamilyDecl RdrName) mkFamDecl loc info lhs ksig = do { (tc, tparams) <- checkTyClHdr lhs - ; tyvars <- checkTyVars lhs tparams + ; tyvars <- checkTyVars "type family" tc tparams ; return (L loc (FamilyDecl { fdInfo = info, fdLName = reLocate loc tc , fdTyVars = tyvars, fdKindSig = ksig })) } @@ -492,13 +491,10 @@ we can bring x,y into scope. So: * For RecCon we do not \begin{code} -checkTyVars :: LHsType RdrName -> [LHsType RdrName] -> P (LHsTyVarBndrs RdrName) +checkTyVars :: String -> Located RdrName -> [LHsType RdrName] -> P (LHsTyVarBndrs RdrName) -- Check whether the given list of type parameters are all type variables --- (possibly with a kind signature). If the second argument is `False', --- only type variables are allowed and we raise an error on encountering a --- non-variable; otherwise, we allow non-variable arguments and return the --- entire list of parameters. -checkTyVars tycl_hdr tparms = do { tvs <- mapM chk tparms +-- (possibly with a kind signature). +checkTyVars what tc tparms = do { tvs <- mapM chk tparms ; return (mkHsQTvs tvs) } where -- Check that the name space is correct! @@ -508,9 +504,16 @@ checkTyVars tycl_hdr tparms = do { tvs <- mapM chk tparms | isRdrTyVar tv = return (L l (UserTyVar tv)) chk t@(L l _) = parseErrorSDoc l $ - vcat [ sep [ ptext (sLit "Unexpected type") <+> quotes (ppr t) - , ptext (sLit "where type variable expected") ] - , ptext (sLit "In the declaration of") <+> quotes (ppr tycl_hdr) ] + vcat [ ptext (sLit "Unexpected type") <+> quotes (ppr t) + , ptext (sLit "In the") <+> pp_what <+> ptext (sLit "declaration for") <+> quotes (ppr tc) + , vcat[ (ptext (sLit "A") <+> pp_what <+> ptext (sLit "declaration should have form")) + , nest 2 (pp_what <+> ppr tc <+> ptext (sLit "a b c") + <+> equals_or_where <+> ptext (sLit "...")) ] ] + + pp_what = text what + equals_or_where = case what of + "class" -> ptext (sLit "where") + _ -> equals checkDatatypeContext :: Maybe (LHsContext RdrName) -> P () checkDatatypeContext Nothing = return () From git at git.haskell.org Wed Nov 6 10:40:22 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 10:40:22 +0000 (UTC) Subject: [commit: testsuite] master: Test Trac #7477 (37158ff) Message-ID: <20131106104022.5DD322406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/37158ff9ee3603c863eee8dcdfd196750fe8847a/testsuite >--------------------------------------------------------------- commit 37158ff9ee3603c863eee8dcdfd196750fe8847a Author: Simon Peyton Jones Date: Wed Nov 6 09:34:03 2013 +0000 Test Trac #7477 >--------------------------------------------------------------- 37158ff9ee3603c863eee8dcdfd196750fe8847a tests/th/T7477.hs | 12 ++++++++++++ tests/{ghci/linking/T3333.hs => th/T7477.stderr} | 6 ++---- tests/th/all.T | 1 + 3 files changed, 15 insertions(+), 4 deletions(-) diff --git a/tests/th/T7477.hs b/tests/th/T7477.hs new file mode 100644 index 0000000..4e4d018 --- /dev/null +++ b/tests/th/T7477.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds, KindSignatures, PolyKinds, TypeFamilies, TemplateHaskell #-} + +module T7477 where + +import Language.Haskell.TH + +type family F (a :: k) +type instance F Int = Bool + +$( do { info <- reifyInstances ''F [ConT ''Int] + ; reportWarning (pprint info) + ; return [] }) diff --git a/tests/ghci/linking/T3333.hs b/tests/th/T7477.stderr similarity index 52% copy from tests/ghci/linking/T3333.hs copy to tests/th/T7477.stderr index 82c8909..f6a9e0d 100644 --- a/tests/ghci/linking/T3333.hs +++ b/tests/th/T7477.stderr @@ -1,5 +1,3 @@ -module WeakTest where -import Foreign.C.Types - -foreign import ccall weak_test :: CInt -> IO CInt +T7477.hs:10:4: Warning: + type instance T7477.F GHC.Prim.* GHC.Types.Int = GHC.Types.Bool diff --git a/tests/th/all.T b/tests/th/all.T index 55c5a93..9b959fa 100644 --- a/tests/th/all.T +++ b/tests/th/all.T @@ -304,3 +304,4 @@ test('T7667', normal, compile, ['-v0']) test('T7667a', normal, compile_fail, ['-v0']) test('T8455', normal, compile, ['-v0']) test('T8499', normal, compile, ['-v0']) +test('T7477', normal, compile, ['-v0']) From git at git.haskell.org Wed Nov 6 10:40:24 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 10:40:24 +0000 (UTC) Subject: [commit: testsuite] master: Test for Trac #4135, comment 2 (7a318d7) Message-ID: <20131106104024.B35072406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a318d7d3a1467251b3133c43f01c7372c32904e/testsuite >--------------------------------------------------------------- commit 7a318d7d3a1467251b3133c43f01c7372c32904e Author: Simon Peyton Jones Date: Wed Nov 6 09:56:54 2013 +0000 Test for Trac #4135, comment 2 >--------------------------------------------------------------- 7a318d7d3a1467251b3133c43f01c7372c32904e tests/th/T4135a.hs | 15 +++++++++++++++ tests/th/all.T | 3 ++- 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/tests/th/T4135a.hs b/tests/th/T4135a.hs new file mode 100644 index 0000000..41549ca --- /dev/null +++ b/tests/th/T4135a.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeFamilies, + FlexibleInstances, OverlappingInstances #-} + +module T4135a where + +import Control.Monad +import Language.Haskell.TH + +class Foo a where + type FooType a + +createInstance' :: Q Type -> Q Dec +createInstance' t = liftM head [d| + instance Foo $t where + type FooType $t = String |] diff --git a/tests/th/all.T b/tests/th/all.T index 9b959fa..5428b9c 100644 --- a/tests/th/all.T +++ b/tests/th/all.T @@ -235,7 +235,8 @@ test('T5883', normal, compile, ['-v0 -dsuppress-uniques -ddump-splices']) test('T5882', normal, compile, ['-v0']) test('T5886', extra_clean(['T5886a.hi','T5886a.o']), multimod_compile, ['T5886','-v0 ' + config.ghc_th_way_flags]) -test('T4135', normal, compile, ['-v0']) +test('T4135', normal, compile, ['-v0']) +test('T4135a', normal, compile, ['-v0']) test('T5971', normal, compile_fail, ['-v0 -dsuppress-uniques']) test('T5968', normal, compile, ['-v0']) test('T5984', extra_clean(['T5984_Lib.hi', 'T5984_Lib.o']), From git at git.haskell.org Wed Nov 6 10:40:26 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 10:40:26 +0000 (UTC) Subject: [commit: testsuite] master: Error message wibbles (559436a) Message-ID: <20131106104026.B124E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/559436a1dbd7684770b8ba366355a6100d48682d/testsuite >--------------------------------------------------------------- commit 559436a1dbd7684770b8ba366355a6100d48682d Author: Simon Peyton Jones Date: Wed Nov 6 10:40:05 2013 +0000 Error message wibbles >--------------------------------------------------------------- 559436a1dbd7684770b8ba366355a6100d48682d tests/parser/should_fail/T3811d.stderr | 6 ++++-- tests/parser/should_fail/readFail025.stderr | 6 ++++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/tests/parser/should_fail/T3811d.stderr b/tests/parser/should_fail/T3811d.stderr index ddffea0..d0cbacc 100644 --- a/tests/parser/should_fail/T3811d.stderr +++ b/tests/parser/should_fail/T3811d.stderr @@ -1,4 +1,6 @@ T3811d.hs:6:11: - Unexpected type ?D Char? where type variable expected - In the declaration of ?C b (D Char) b? + Unexpected type ?D Char? + In the class declaration for ?C? + A class declaration should have form + class C a b c where ... diff --git a/tests/parser/should_fail/readFail025.stderr b/tests/parser/should_fail/readFail025.stderr index 0d74f86..e706e52 100644 --- a/tests/parser/should_fail/readFail025.stderr +++ b/tests/parser/should_fail/readFail025.stderr @@ -1,4 +1,6 @@ readFail025.hs:5:8: - Unexpected type ?String? where type variable expected - In the declaration of ?T String? + Unexpected type ?String? + In the data declaration for ?T? + A data declaration should have form + data T a b c = ... From git at git.haskell.org Wed Nov 6 10:40:29 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 10:40:29 +0000 (UTC) Subject: [commit: testsuite] master: Test Trac #8506 (8a4d858) Message-ID: <20131106104029.361782406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8a4d858e9df67c35c5f59e2f6382ece02fc4c214/testsuite >--------------------------------------------------------------- commit 8a4d858e9df67c35c5f59e2f6382ece02fc4c214 Author: Simon Peyton Jones Date: Wed Nov 6 09:36:28 2013 +0000 Test Trac #8506 >--------------------------------------------------------------- 8a4d858e9df67c35c5f59e2f6382ece02fc4c214 tests/parser/should_fail/T8506.hs | 4 ++++ tests/parser/should_fail/T8506.stderr | 6 ++++++ tests/parser/should_fail/all.T | 1 + 3 files changed, 11 insertions(+) diff --git a/tests/parser/should_fail/T8506.hs b/tests/parser/should_fail/T8506.hs new file mode 100644 index 0000000..6603f56 --- /dev/null +++ b/tests/parser/should_fail/T8506.hs @@ -0,0 +1,4 @@ +module T8506 where + +class Shapable Int where + diff --git a/tests/parser/should_fail/T8506.stderr b/tests/parser/should_fail/T8506.stderr new file mode 100644 index 0000000..bfccfaf --- /dev/null +++ b/tests/parser/should_fail/T8506.stderr @@ -0,0 +1,6 @@ + +T8506.hs:3:16: + Unexpected type ?Int? + In the class declaration for ?Shapable? + A class declaration should have form + class Shapable a b c where ... diff --git a/tests/parser/should_fail/all.T b/tests/parser/should_fail/all.T index 7e0194a..45c471e 100644 --- a/tests/parser/should_fail/all.T +++ b/tests/parser/should_fail/all.T @@ -82,3 +82,4 @@ test('T7848', normal, compile_fail, ['-dppr-user-length=100']) test('ExportCommaComma', normal, compile_fail, ['']) test('T8430', literate, compile_fail, ['']) test('T8431', [timeout_multiplier(0.05)], compile_fail, ['-XAlternativeLayoutRule']) +test('T8506', normal, compile_fail, ['']) From git at git.haskell.org Wed Nov 6 16:21:33 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 16:21:33 +0000 (UTC) Subject: [commit: ghc] master: Warn if you use -XTemplateHaskell in stage1 (5bf435b) Message-ID: <20131106162133.688142406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5bf435bd01981a65dba7c611cf8da327c8268738/ghc >--------------------------------------------------------------- commit 5bf435bd01981a65dba7c611cf8da327c8268738 Author: Simon Peyton Jones Date: Wed Nov 6 16:19:34 2013 +0000 Warn if you use -XTemplateHaskell in stage1 This should really be an error, but we'll just warn for now >--------------------------------------------------------------- 5bf435bd01981a65dba7c611cf8da327c8268738 compiler/main/DynFlags.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 34d5a47..0116dae 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3115,10 +3115,10 @@ checkTemplateHaskellOk turn_on | otherwise = getCurLoc >>= \l -> upd (\d -> d { thOnLoc = l }) #else --- In stage 1 we don't know that the RTS has rts_isProfiled, --- so we simply say "ok". It doesn't matter because TH isn't --- available in stage 1 anyway. -checkTemplateHaskellOk _ = return () +-- In stage 1, Template Haskell is simply illegal +checkTemplateHaskellOk turn_on + | turn_on = addWarn "Template Haskell requires GHC with interpreter support\nPerhaps you are using a stage-1 compiler?" + | otherwise = return () #endif {- ********************************************************************** From git at git.haskell.org Wed Nov 6 16:21:35 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 16:21:35 +0000 (UTC) Subject: [commit: ghc] master: Tidy up the error messages we get from TH in stage1 (Trac #8312) (bf3b293) Message-ID: <20131106162135.7AB622406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bf3b29323d69b2c6f073885fb896dd4a5c346c02/ghc >--------------------------------------------------------------- commit bf3b29323d69b2c6f073885fb896dd4a5c346c02 Author: Simon Peyton Jones Date: Wed Nov 6 16:21:05 2013 +0000 Tidy up the error messages we get from TH in stage1 (Trac #8312) Instead of panic-ing we now give a sensible message. There is quite a bit of refactoring here too, removing several #ifdef GHCI things >--------------------------------------------------------------- bf3b29323d69b2c6f073885fb896dd4a5c346c02 compiler/ghc.cabal.in | 2 +- compiler/rename/RnExpr.lhs | 7 +- compiler/rename/RnPat.lhs | 11 +-- compiler/rename/RnSource.lhs | 7 -- compiler/rename/RnSplice.lhs | 41 +++-------- compiler/rename/RnSplice.lhs-boot | 4 -- compiler/rename/RnTypes.lhs | 6 -- compiler/typecheck/TcAnnotations.lhs | 10 +-- compiler/typecheck/TcExpr.lhs | 16 ++--- compiler/typecheck/TcHsType.lhs | 18 +---- compiler/typecheck/TcRnMonad.lhs | 14 ++++ compiler/typecheck/TcSplice.lhs | 128 ++++++++++++++++++---------------- compiler/typecheck/TcSplice.lhs-boot | 16 +++-- 13 files changed, 114 insertions(+), 166 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 bf3b29323d69b2c6f073885fb896dd4a5c346c02 From git at git.haskell.org Wed Nov 6 16:39:57 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 16:39:57 +0000 (UTC) Subject: [commit: ghc] master: Wibbles to 'Tidy up the error messages we get from TH' (c314e64) Message-ID: <20131106163958.063CF2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c314e64c4c5f4d41fab4c13f9023052ab76f670d/ghc >--------------------------------------------------------------- commit c314e64c4c5f4d41fab4c13f9023052ab76f670d Author: Simon Peyton Jones Date: Wed Nov 6 16:39:46 2013 +0000 Wibbles to 'Tidy up the error messages we get from TH' >--------------------------------------------------------------- c314e64c4c5f4d41fab4c13f9023052ab76f670d compiler/main/DynFlags.hs | 2 +- compiler/typecheck/TcAnnotations.lhs | 3 +-- compiler/typecheck/TcRnMonad.lhs | 8 ++++---- 3 files changed, 6 insertions(+), 7 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0116dae..b88e294 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3117,7 +3117,7 @@ checkTemplateHaskellOk turn_on #else -- In stage 1, Template Haskell is simply illegal checkTemplateHaskellOk turn_on - | turn_on = addWarn "Template Haskell requires GHC with interpreter support\nPerhaps you are using a stage-1 compiler?" + | turn_on = addWarn "Template Haskell requires GHC with interpreter support\n Perhaps you are using a stage-1 compiler?" | otherwise = return () #endif diff --git a/compiler/typecheck/TcAnnotations.lhs b/compiler/typecheck/TcAnnotations.lhs index 4f4ab60..c25a217 100644 --- a/compiler/typecheck/TcAnnotations.lhs +++ b/compiler/typecheck/TcAnnotations.lhs @@ -17,7 +17,6 @@ import SrcLoc import Outputable import Module -import TcExpr import FastString \end{code} @@ -32,7 +31,7 @@ tcAnnotation ann@(L loc (HsAnnotation provenance expr)) = do let target = annProvenanceToTarget mod provenance -- Run that annotation and construct the full Annotation data structure - setSrcSpan loc $ addErrCtxt (annCtxt ann) $ addExprErrCtxt expr $ runAnnotation target expr + setSrcSpan loc $ addErrCtxt (annCtxt ann) $ runAnnotation target expr annProvenanceToTarget :: Module -> AnnProvenance Name -> AnnTarget Name annProvenanceToTarget _ (ValueAnnProvenance name) = NamedTarget name diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 1b66b94..0e064ad 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -838,10 +838,10 @@ checkTH e what = failTH e what -- Raise an error in a stage-1 compiler failTH :: Outputable a => a -> String -> TcRn x failTH e what -- Raise an error in a stage-1 compiler - = failWithTc (vcat [ text what - <+> ptext (sLit "requires GHC with interpreter support") - , ptext (sLit "Perhaps you are using a stage-1 compiler?") - , nest 2 (ppr e)]) + = failWithTc (vcat [ hang (char 'A' <+> text what + <+> ptext (sLit "requires GHC with interpreter support:")) + 2 (ppr e) + , ptext (sLit "Perhaps you are using a stage-1 compiler?") ]) \end{code} From git at git.haskell.org Wed Nov 6 16:53:48 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 16:53:48 +0000 (UTC) Subject: [commit: ghc] master: Improve printing of errors when the tycons look the same (2403fa1) Message-ID: <20131106165348.2AE1A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2403fa102559e81d665838a62b2a5de3229a9783/ghc >--------------------------------------------------------------- commit 2403fa102559e81d665838a62b2a5de3229a9783 Author: Simon Peyton Jones Date: Wed Nov 6 13:37:09 2013 +0000 Improve printing of errors when the tycons look the same See Trac #8278. Example new message: Couldn't match expected type ?T8278a.Maybe? with actual type ?Maybe a0? NB: ?T8278a.Maybe? is defined in ?T8278a? ?Maybe? is defined in ?Data.Maybe? in package ?base? In the first argument of ?f?, namely ?Nothing? The "NB" is the new bit >--------------------------------------------------------------- 2403fa102559e81d665838a62b2a5de3229a9783 compiler/typecheck/TcErrors.lhs | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs index b50f97e..78f1554 100644 --- a/compiler/typecheck/TcErrors.lhs +++ b/compiler/typecheck/TcErrors.lhs @@ -24,6 +24,7 @@ import TypeRep import Type import Kind ( isKind ) import Unify ( tcMatchTys ) +import Module import Inst import InstEnv import TyCon @@ -852,7 +853,8 @@ misMatchMsg oriented ty1 ty2 = misMatchMsg (Just NotSwapped) ty2 ty1 | Just NotSwapped <- oriented = sep [ ptext (sLit "Couldn't match expected") <+> what <+> quotes (ppr ty2) - , nest 12 $ ptext (sLit "with actual") <+> what <+> quotes (ppr ty1) ] + , nest 12 $ ptext (sLit "with actual") <+> what <+> quotes (ppr ty1) + , sameOccExtra ty2 ty1 ] | otherwise = sep [ ptext (sLit "Couldn't match") <+> what <+> quotes (ppr ty1) , nest 14 $ ptext (sLit "with") <+> quotes (ppr ty2) ] @@ -871,6 +873,29 @@ mkExpectedActualMsg ty1 ty2 (TypeEqOrigin { uo_actual = act, uo_expected = exp } , text " Actual type:" <+> ppr act ] mkExpectedActualMsg _ _ _ = panic "mkExprectedAcutalMsg" + +sameOccExtra :: TcType -> TcType -> SDoc +sameOccExtra ty1 ty2 + | Just (tc1, _) <- tcSplitTyConApp_maybe ty1 + , Just (tc2, _) <- tcSplitTyConApp_maybe ty2 + , let n1 = tyConName tc1 + n2 = tyConName tc2 + same_occ = nameOccName n1 == nameOccName n2 + same_pkg = modulePackageId (nameModule n1) == modulePackageId (nameModule n2) + , n1 /= n2 -- Different Names + , same_occ -- but same OccName + = ptext (sLit "NB:") <+> (ppr_from same_pkg n1 $$ ppr_from same_pkg n2) + | otherwise + = empty + where + ppr_from same_pkg nm + = hang (quotes (ppr nm)) + 2 (sep [ ptext (sLit "is defined in") <+> quotes (ppr (moduleName mod)) + , ppUnless (same_pkg || pkg == mainPackageId) $ + nest 4 $ ptext (sLit "in package") <+> quotes (ppr pkg) ]) + where + pkg = modulePackageId mod + mod = nameModule nm \end{code} Note [Reporting occurs-check errors] From git at git.haskell.org Wed Nov 6 16:56:10 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Nov 2013 16:56:10 +0000 (UTC) Subject: [commit: testsuite] master: Wibbles following fix to Trac #8278 (9ca3219) Message-ID: <20131106165610.DD6E82406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9ca32193a82218c18a633d1ae505248d65ef17a4/testsuite >--------------------------------------------------------------- commit 9ca32193a82218c18a633d1ae505248d65ef17a4 Author: Simon Peyton Jones Date: Wed Nov 6 16:55:54 2013 +0000 Wibbles following fix to Trac #8278 The error message for ghci052 and ghci053 are (still) terrible, because there is shadowing going on in the interactive context. But that's a separate matter. >--------------------------------------------------------------- 9ca32193a82218c18a633d1ae505248d65ef17a4 tests/ghci/scripts/ghci052.script | 2 ++ tests/ghci/scripts/ghci052.stderr | 16 ++++++++++++---- tests/ghci/scripts/ghci053.script | 2 ++ tests/ghci/scripts/ghci053.stderr | 8 ++++++-- tests/module/mod180.stderr | 5 ++++- tests/typecheck/bug1465/bug1465.stderr | 2 ++ tests/typecheck/should_fail/tcfail182.stderr | 2 ++ 7 files changed, 30 insertions(+), 7 deletions(-) diff --git a/tests/ghci/scripts/ghci052.script b/tests/ghci/scripts/ghci052.script index 53e0093..c32d0fc 100644 --- a/tests/ghci/scripts/ghci052.script +++ b/tests/ghci/scripts/ghci052.script @@ -1,4 +1,6 @@ --Testing data type and constructor shadowing with functions +-- Very unsatisfactory error messages + data Planet = Mercury | Venus | Earth let pn Mercury = "M" ; pn Venus = "V" ; pn Earth = "E" pn Mercury diff --git a/tests/ghci/scripts/ghci052.stderr b/tests/ghci/scripts/ghci052.stderr index 089785b..35977bf 100644 --- a/tests/ghci/scripts/ghci052.stderr +++ b/tests/ghci/scripts/ghci052.stderr @@ -1,24 +1,32 @@ -:7:4: +:9:4: Couldn't match expected type ?main::Interactive.Planet? with actual type ?Planet? + NB: ?main::Interactive.Planet? is defined in ?:Interactive? + ?Planet? is defined in ?:Interactive? In the first argument of ?pn?, namely ?Mercury? In the expression: pn Mercury -:8:4: +:10:4: Couldn't match expected type ?main::Interactive.Planet? with actual type ?Planet? + NB: ?main::Interactive.Planet? is defined in ?:Interactive? + ?Planet? is defined in ?:Interactive? In the first argument of ?pn?, namely ?Venus? In the expression: pn Venus -:9:4: +:11:4: Couldn't match expected type ?main::Interactive.Planet? with actual type ?Planet? + NB: ?main::Interactive.Planet? is defined in ?:Interactive? + ?Planet? is defined in ?:Interactive? In the first argument of ?pn?, namely ?Mars? In the expression: pn Mars -:11:44: +:13:44: Couldn't match expected type ?Planet? with actual type ?main::Interactive.Planet? + NB: ?Planet? is defined in ?:Interactive? + ?main::Interactive.Planet? is defined in ?:Interactive? In the pattern: Earth In an equation for ?pn?: pn Earth = "E" diff --git a/tests/ghci/scripts/ghci053.script b/tests/ghci/scripts/ghci053.script index cf104b5..43e0fbd 100644 --- a/tests/ghci/scripts/ghci053.script +++ b/tests/ghci/scripts/ghci053.script @@ -1,4 +1,6 @@ --Testing deriving in the presence of shadowing +-- Very unsatisfactory error messages + data Planet = Mercury | Venus | Earth deriving Eq let mercury = Mercury Venus == Earth diff --git a/tests/ghci/scripts/ghci053.stderr b/tests/ghci/scripts/ghci053.stderr index 5f9b598..abb4009 100644 --- a/tests/ghci/scripts/ghci053.stderr +++ b/tests/ghci/scripts/ghci053.stderr @@ -1,12 +1,16 @@ -:8:12: +:10:12: Couldn't match expected type ?main::Interactive.Planet? with actual type ?Planet? + NB: ?main::Interactive.Planet? is defined in ?:Interactive? + ?Planet? is defined in ?:Interactive? In the second argument of ?(==)?, namely ?Mercury? In the expression: mercury == Mercury -:10:10: +:12:10: Couldn't match expected type ?Planet? with actual type ?main::Interactive.Planet? + NB: ?Planet? is defined in ?:Interactive? + ?main::Interactive.Planet? is defined in ?:Interactive? In the second argument of ?(==)?, namely ?Earth? In the expression: Venus == Earth diff --git a/tests/module/mod180.stderr b/tests/module/mod180.stderr index 2647f2a..dd582e6 100644 --- a/tests/module/mod180.stderr +++ b/tests/module/mod180.stderr @@ -1,5 +1,8 @@ mod180.hs:8:5: - Couldn't match expected type ?T? with actual type ?main:Mod180_A.T? + Couldn't match expected type ?T? + with actual type ?main:Mod180_A.T? + NB: ?T? is defined in ?Mod180_B? + ?main:Mod180_A.T? is defined in ?Mod180_A? In the expression: x In an equation for ?z?: z = x diff --git a/tests/typecheck/bug1465/bug1465.stderr b/tests/typecheck/bug1465/bug1465.stderr index 15f5f64..44b3de1 100644 --- a/tests/typecheck/bug1465/bug1465.stderr +++ b/tests/typecheck/bug1465/bug1465.stderr @@ -2,5 +2,7 @@ C.hs:6:11: Couldn't match expected type ?bug1465-1.0:A.T? with actual type ?A.T? + NB: ?bug1465-1.0:A.T? is defined in ?A? in package ?bug1465-1.0? + ?A.T? is defined in ?A? in package ?bug1465-2.0? In the expression: B2.f In the expression: [B1.f, B2.f] diff --git a/tests/typecheck/should_fail/tcfail182.stderr b/tests/typecheck/should_fail/tcfail182.stderr index 36768f6..1360b70 100644 --- a/tests/typecheck/should_fail/tcfail182.stderr +++ b/tests/typecheck/should_fail/tcfail182.stderr @@ -2,6 +2,8 @@ tcfail182.hs:9:3: Couldn't match expected type ?Prelude.Maybe a? with actual type ?Maybe t0? + NB: ?Prelude.Maybe? is defined in ?Data.Maybe? in package ?base? + ?Maybe? is defined in ?Foo? Relevant bindings include f :: Prelude.Maybe a -> Int (bound at tcfail182.hs:9:1) In the pattern: Foo From git at git.haskell.org Thu Nov 7 09:22:35 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 09:22:35 +0000 (UTC) Subject: [commit: packages/unix] master: Temporary workaround for addressing #7359 (88bfec0) Message-ID: <20131107092235.E83A32406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://git.haskell.org/packages/unix.git/commitdiff/88bfec0cf55f8c9ad74881d48cf8756c9fe627aa >--------------------------------------------------------------- commit 88bfec0cf55f8c9ad74881d48cf8756c9fe627aa Author: Herbert Valerio Riedel Date: Thu Nov 7 10:21:17 2013 +0100 Temporary workaround for addressing #7359 Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 88bfec0cf55f8c9ad74881d48cf8756c9fe627aa System/Posix/Signals.hsc | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/System/Posix/Signals.hsc b/System/Posix/Signals.hsc index eb46ba4..4b5321e 100644 --- a/System/Posix/Signals.hsc +++ b/System/Posix/Signals.hsc @@ -616,6 +616,17 @@ foreign import ccall unsafe "sigfillset" foreign import ccall unsafe "sigismember" c_sigismember :: Ptr CSigset -> CInt -> IO CInt +#elif defined(darwin_HOST_OS) && __GLASGOW_HASKELL__ < 706 +-- see http://ghc.haskell.org/trac/ghc/ticket/7359#comment:3 +-- To be removed when support for GHC 7.4.x is dropped +foreign import ccall unsafe "__hscore_sigdelset" + c_sigdelset :: Ptr CSigset -> CInt -> IO CInt + +foreign import ccall unsafe "__hscore_sigfillset" + c_sigfillset :: Ptr CSigset -> IO CInt + +foreign import ccall unsafe "__hscore_sigismember" + c_sigismember :: Ptr CSigset -> CInt -> IO CInt #else foreign import capi unsafe "signal.h sigdelset" c_sigdelset :: Ptr CSigset -> CInt -> IO CInt From git at git.haskell.org Thu Nov 7 12:25:38 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 12:25:38 +0000 (UTC) Subject: [commit: packages/unix] master: Fix #7912 by using `CApiFFI` for `` imports (7ca70fb) Message-ID: <20131107122538.BEA462406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7ca70fbf7b82bcca945669d043673a06973c1edf/unix >--------------------------------------------------------------- commit 7ca70fbf7b82bcca945669d043673a06973c1edf Author: Herbert Valerio Riedel Date: Thu Nov 7 13:22:34 2013 +0100 Fix #7912 by using `CApiFFI` for `` imports On Android, the functions imported from `` are actually inlined functions, so we need to wrap them via the `capi` calling convention. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 7ca70fbf7b82bcca945669d043673a06973c1edf System/Posix/Terminal/Common.hsc | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/System/Posix/Terminal/Common.hsc b/System/Posix/Terminal/Common.hsc index 4075ba3..e43a59a 100644 --- a/System/Posix/Terminal/Common.hsc +++ b/System/Posix/Terminal/Common.hsc @@ -1,3 +1,4 @@ +{-# LANGUAGE CApiFFI #-} #ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} #endif @@ -331,14 +332,14 @@ inputSpeed termios = unsafePerformIO $ do w <- c_cfgetispeed p return (word2Baud w) -foreign import ccall unsafe "cfgetispeed" +foreign import capi unsafe "termios.h cfgetispeed" c_cfgetispeed :: Ptr CTermios -> IO CSpeed withInputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes withInputSpeed termios br = unsafePerformIO $ do withNewTermios termios $ \p -> c_cfsetispeed p (baud2Word br) -foreign import ccall unsafe "cfsetispeed" +foreign import capi unsafe "termios.h cfsetispeed" c_cfsetispeed :: Ptr CTermios -> CSpeed -> IO CInt @@ -348,14 +349,14 @@ outputSpeed termios = unsafePerformIO $ do w <- c_cfgetospeed p return (word2Baud w) -foreign import ccall unsafe "cfgetospeed" +foreign import capi unsafe "termios.h cfgetospeed" c_cfgetospeed :: Ptr CTermios -> IO CSpeed withOutputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes withOutputSpeed termios br = unsafePerformIO $ do withNewTermios termios $ \p -> c_cfsetospeed p (baud2Word br) -foreign import ccall unsafe "cfsetospeed" +foreign import capi unsafe "termios.h cfsetospeed" c_cfsetospeed :: Ptr CTermios -> CSpeed -> IO CInt -- | @getTerminalAttributes fd@ calls @tcgetattr@ to obtain @@ -367,7 +368,7 @@ getTerminalAttributes (Fd fd) = do throwErrnoIfMinus1_ "getTerminalAttributes" (c_tcgetattr fd p) return $ makeTerminalAttributes fp -foreign import ccall unsafe "tcgetattr" +foreign import capi unsafe "termios.h tcgetattr" c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt data TerminalState @@ -392,7 +393,7 @@ setTerminalAttributes (Fd fd) termios state = do state2Int WhenDrained = (#const TCSADRAIN) state2Int WhenFlushed = (#const TCSAFLUSH) -foreign import ccall unsafe "tcsetattr" +foreign import capi unsafe "termios.h tcsetattr" c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt -- | @sendBreak fd duration@ calls @tcsendbreak@ to transmit a @@ -402,7 +403,7 @@ sendBreak :: Fd -> Int -> IO () sendBreak (Fd fd) duration = throwErrnoIfMinus1_ "sendBreak" (c_tcsendbreak fd (fromIntegral duration)) -foreign import ccall unsafe "tcsendbreak" +foreign import capi unsafe "termios.h tcsendbreak" c_tcsendbreak :: CInt -> CInt -> IO CInt -- | @drainOutput fd@ calls @tcdrain@ to block until all output @@ -410,7 +411,7 @@ foreign import ccall unsafe "tcsendbreak" drainOutput :: Fd -> IO () drainOutput (Fd fd) = throwErrnoIfMinus1_ "drainOutput" (c_tcdrain fd) -foreign import ccall unsafe "tcdrain" +foreign import capi unsafe "termios.h tcdrain" c_tcdrain :: CInt -> IO CInt @@ -431,7 +432,7 @@ discardData (Fd fd) queue = queue2Int OutputQueue = (#const TCOFLUSH) queue2Int BothQueues = (#const TCIOFLUSH) -foreign import ccall unsafe "tcflush" +foreign import capi unsafe "termios.h tcflush" c_tcflush :: CInt -> CInt -> IO CInt data FlowAction @@ -453,7 +454,7 @@ controlFlow (Fd fd) action = action2Int TransmitStop = (#const TCIOFF) action2Int TransmitStart = (#const TCION) -foreign import ccall unsafe "tcflow" +foreign import capi unsafe "termios.h tcflow" c_tcflow :: CInt -> CInt -> IO CInt -- | @getTerminalProcessGroupID fd@ calls @tcgetpgrp@ to From git at git.haskell.org Thu Nov 7 13:04:16 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 13:04:16 +0000 (UTC) Subject: [commit: packages/unix] master: Remove misleading paragraph in `fdToHandle`'s Haddock (48a72e8) Message-ID: <20131107130417.12ED32406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/48a72e8753a1e90ad24335db9bf241892610375b/unix >--------------------------------------------------------------- commit 48a72e8753a1e90ad24335db9bf241892610375b Author: Herbert Valerio Riedel Date: Thu Nov 7 13:42:51 2013 +0100 Remove misleading paragraph in `fdToHandle`'s Haddock The removed paragraph is obsolete and does no longer apply to the implementation as noted by Duncan in #8286. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 48a72e8753a1e90ad24335db9bf241892610375b System/Posix/IO/Common.hsc | 5 ----- 1 file changed, 5 deletions(-) diff --git a/System/Posix/IO/Common.hsc b/System/Posix/IO/Common.hsc index a781093..b2ac787 100644 --- a/System/Posix/IO/Common.hsc +++ b/System/Posix/IO/Common.hsc @@ -207,11 +207,6 @@ handleToFd :: Handle -> IO Fd -- | Converts an 'Fd' into a 'Handle' that can be used with the -- standard Haskell IO library (see "System.IO"). --- --- GHC only: this function has the side effect of putting the 'Fd' --- into non-blocking mode (@O_NONBLOCK@) due to the way the standard --- IO library implements multithreaded I\/O. --- fdToHandle :: Fd -> IO Handle #ifdef __GLASGOW_HASKELL__ From git at git.haskell.org Thu Nov 7 13:04:18 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 13:04:18 +0000 (UTC) Subject: [commit: packages/unix] master: Kill trailing whitespace (0c59426) Message-ID: <20131107130419.3E0B52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0c59426912f0104f9d79aab4dbe7d9a491f3fe32/unix >--------------------------------------------------------------- commit 0c59426912f0104f9d79aab4dbe7d9a491f3fe32 Author: Herbert Valerio Riedel Date: Thu Nov 7 13:48:36 2013 +0100 Kill trailing whitespace Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 0c59426912f0104f9d79aab4dbe7d9a491f3fe32 System/Posix/IO/Common.hsc | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/System/Posix/IO/Common.hsc b/System/Posix/IO/Common.hsc index b2ac787..8de0ac0 100644 --- a/System/Posix/IO/Common.hsc +++ b/System/Posix/IO/Common.hsc @@ -164,7 +164,7 @@ open_ :: CString -> OpenFileFlags -> IO Fd open_ str how maybe_mode (OpenFileFlags appendFlag exclusiveFlag nocttyFlag - nonBlockFlag truncateFlag) = do + nonBlockFlag truncateFlag) = do fd <- c_open str all_flags mode_w return (Fd fd) where @@ -178,13 +178,13 @@ open_ str how maybe_mode (OpenFileFlags appendFlag exclusiveFlag nocttyFlag (if truncateFlag then (#const O_TRUNC) else 0) (creat, mode_w) = case maybe_mode of - Nothing -> (0,0) - Just x -> ((#const O_CREAT), x) + Nothing -> (0,0) + Just x -> ((#const O_CREAT), x) open_mode = case how of - ReadOnly -> (#const O_RDONLY) - WriteOnly -> (#const O_WRONLY) - ReadWrite -> (#const O_RDWR) + ReadOnly -> (#const O_RDONLY) + WriteOnly -> (#const O_WRONLY) + ReadWrite -> (#const O_RDWR) foreign import ccall unsafe "__hscore_open" c_open :: CString -> CInt -> CMode -> IO CInt @@ -250,9 +250,9 @@ fdToHandle fd = do -- Fd options data FdOption = AppendOnWrite -- ^O_APPEND - | CloseOnExec -- ^FD_CLOEXEC - | NonBlockingRead -- ^O_NONBLOCK - | SynchronousWrites -- ^O_SYNC + | CloseOnExec -- ^FD_CLOEXEC + | NonBlockingRead -- ^O_NONBLOCK + | SynchronousWrites -- ^O_SYNC fdOption2Int :: FdOption -> CInt fdOption2Int CloseOnExec = (#const FD_CLOEXEC) @@ -267,21 +267,21 @@ queryFdOption (Fd fd) opt = do return ((r .&. fdOption2Int opt) /= 0) where flag = case opt of - CloseOnExec -> (#const F_GETFD) - _ -> (#const F_GETFL) + CloseOnExec -> (#const F_GETFD) + _ -> (#const F_GETFL) -- | May throw an exception if this is an invalid descriptor. setFdOption :: Fd -> FdOption -> Bool -> IO () setFdOption (Fd fd) opt val = do r <- throwErrnoIfMinus1 "setFdOption" (Base.c_fcntl_read fd getflag) let r' | val = r .|. opt_val - | otherwise = r .&. (complement opt_val) + | otherwise = r .&. (complement opt_val) throwErrnoIfMinus1_ "setFdOption" (Base.c_fcntl_write fd setflag (fromIntegral r')) where (getflag,setflag)= case opt of - CloseOnExec -> ((#const F_GETFD),(#const F_SETFD)) - _ -> ((#const F_GETFL),(#const F_SETFL)) + CloseOnExec -> ((#const F_GETFD),(#const F_SETFD)) + _ -> ((#const F_GETFL),(#const F_SETFL)) opt_val = fdOption2Int opt -- ----------------------------------------------------------------------------- From git at git.haskell.org Thu Nov 7 13:09:46 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 13:09:46 +0000 (UTC) Subject: [commit: packages/directory] master: Update aux files `config.{guess, sub}` and `install-sh` (c606f05) Message-ID: <20131107130946.D541D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/directory On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c606f05b8adf99134566e97a767b014e39f89a63/directory >--------------------------------------------------------------- commit c606f05b8adf99134566e97a767b014e39f89a63 Author: Herbert Valerio Riedel Date: Thu Nov 7 14:08:38 2013 +0100 Update aux files `config.{guess,sub}` and `install-sh` This updates the files to the versions bundled with GNU automake 1.13.3 Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- c606f05b8adf99134566e97a767b014e39f89a63 config.guess | 616 ++++++++++++++++++++++++++++++++-------------------------- config.sub | 391 +++++++++++++++++++++++++++---------- install-sh | 258 ++++++++++++------------ 3 files changed, 763 insertions(+), 502 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 c606f05b8adf99134566e97a767b014e39f89a63 From git at git.haskell.org Thu Nov 7 13:26:17 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 13:26:17 +0000 (UTC) Subject: [commit: ghc] master: Fix oversight in comverting tuples from TH to HsSyn (Trac #8507) (fa8b20a) Message-ID: <20131107132617.A61F52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fa8b20af798c85d4a0b6faf266c67d0c9ab178a9/ghc >--------------------------------------------------------------- commit fa8b20af798c85d4a0b6faf266c67d0c9ab178a9 Author: Simon Peyton Jones Date: Thu Nov 7 13:25:47 2013 +0000 Fix oversight in comverting tuples from TH to HsSyn (Trac #8507) >--------------------------------------------------------------- fa8b20af798c85d4a0b6faf266c67d0c9ab178a9 compiler/hsSyn/Convert.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs index eeda965..e789d17 100644 --- a/compiler/hsSyn/Convert.lhs +++ b/compiler/hsSyn/Convert.lhs @@ -912,7 +912,7 @@ cvtTypeKind ty_str ty | length tys' == n -- Saturated -> if n==1 then return (head tys') -- Singleton tuples treated -- like nothing (ie just parens) - else returnL (HsTupleTy HsBoxedTuple tys') + else returnL (HsTupleTy HsBoxedOrConstraintTuple tys') | n == 1 -> failWith (ptext (sLit ("Illegal 1-tuple " ++ ty_str ++ " constructor"))) | otherwise From git at git.haskell.org Thu Nov 7 13:26:19 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 13:26:19 +0000 (UTC) Subject: [commit: ghc] master: Allow optional 'family' and 'instance' keywords in associated type instances (384398b) Message-ID: <20131107132619.F36FF2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/384398b3eb2bc36a3e7b42a51495bd89398075b5/ghc >--------------------------------------------------------------- commit 384398b3eb2bc36a3e7b42a51495bd89398075b5 Author: Simon Peyton Jones Date: Thu Nov 7 13:24:51 2013 +0000 Allow optional 'family' and 'instance' keywords in associated type instances This is to allow class C a where type family F a type instance F a = Bool instance C Int where type instance F Int = Char Plus minor improvements relating to Trac #8506 >--------------------------------------------------------------- 384398b3eb2bc36a3e7b42a51495bd89398075b5 compiler/parser/Parser.y.pp | 70 ++++++++++++++++----------------- compiler/parser/RdrHsSyn.lhs | 77 ++++++++++++++++++++++--------------- docs/users_guide/glasgow_exts.xml | 10 +++-- 3 files changed, 84 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 384398b3eb2bc36a3e7b42a51495bd89398075b5 From git at git.haskell.org Thu Nov 7 13:27:26 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 13:27:26 +0000 (UTC) Subject: [commit: testsuite] master: Error message wibbles (01b2050) Message-ID: <20131107132726.63FB02406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/01b205037c2307d09511174e209ae47b6746c0d8/testsuite >--------------------------------------------------------------- commit 01b205037c2307d09511174e209ae47b6746c0d8 Author: Simon Peyton Jones Date: Thu Nov 7 13:27:02 2013 +0000 Error message wibbles >--------------------------------------------------------------- 01b205037c2307d09511174e209ae47b6746c0d8 tests/annotations/should_fail/annfail03.stderr | 1 - tests/annotations/should_fail/annfail04.stderr | 1 - tests/annotations/should_fail/annfail05.stderr | 1 - tests/annotations/should_fail/annfail06.stderr | 1 - tests/annotations/should_fail/annfail07.stderr | 2 +- tests/annotations/should_fail/annfail08.stderr | 2 -- tests/annotations/should_fail/annfail09.stderr | 1 - tests/annotations/should_fail/annfail10.stderr | 2 -- tests/annotations/should_fail/annfail12.stderr | 4 +--- 9 files changed, 2 insertions(+), 13 deletions(-) diff --git a/tests/annotations/should_fail/annfail03.stderr b/tests/annotations/should_fail/annfail03.stderr index 9c15855..3993fe8 100644 --- a/tests/annotations/should_fail/annfail03.stderr +++ b/tests/annotations/should_fail/annfail03.stderr @@ -4,5 +4,4 @@ annfail03.hs:17:1: instance for ?Data InModule? is used in a top-level splice or annotation, and must be imported, not defined locally - In the expression: InModule In the annotation: {-# ANN f InModule #-} diff --git a/tests/annotations/should_fail/annfail04.stderr b/tests/annotations/should_fail/annfail04.stderr index 9d7bf39..70ff2e6 100644 --- a/tests/annotations/should_fail/annfail04.stderr +++ b/tests/annotations/should_fail/annfail04.stderr @@ -4,5 +4,4 @@ annfail04.hs:14:12: instance for ?Thing Int? is used in a top-level splice or annotation, and must be imported, not defined locally - In the expression: (thing :: Int) In the annotation: {-# ANN f (thing :: Int) #-} diff --git a/tests/annotations/should_fail/annfail05.stderr b/tests/annotations/should_fail/annfail05.stderr index 04329ee..712cff2 100644 --- a/tests/annotations/should_fail/annfail05.stderr +++ b/tests/annotations/should_fail/annfail05.stderr @@ -2,5 +2,4 @@ annfail05.hs:11:1: No instance for (Data.Data.Data NoInstances) arising from an annotation - In the expression: NoInstances In the annotation: {-# ANN f NoInstances #-} diff --git a/tests/annotations/should_fail/annfail06.stderr b/tests/annotations/should_fail/annfail06.stderr index 332f35d..a807aaf 100644 --- a/tests/annotations/should_fail/annfail06.stderr +++ b/tests/annotations/should_fail/annfail06.stderr @@ -4,5 +4,4 @@ annfail06.hs:22:1: instance for ?Data InstancesInWrongModule? is used in a top-level splice or annotation, and must be imported, not defined locally - In the expression: InstancesInWrongModule In the annotation: {-# ANN f InstancesInWrongModule #-} diff --git a/tests/annotations/should_fail/annfail07.stderr b/tests/annotations/should_fail/annfail07.stderr index 86a5799..5f966a7 100644 --- a/tests/annotations/should_fail/annfail07.stderr +++ b/tests/annotations/should_fail/annfail07.stderr @@ -2,4 +2,4 @@ annfail07.hs:9:17: Couldn't match expected type ?[a0]? with actual type ?Bool? In the first argument of ?head?, namely ?True? - In the expression: (head True) + In the annotation: {-# ANN f (head True) #-} diff --git a/tests/annotations/should_fail/annfail08.stderr b/tests/annotations/should_fail/annfail08.stderr index b902347..8a64c82 100644 --- a/tests/annotations/should_fail/annfail08.stderr +++ b/tests/annotations/should_fail/annfail08.stderr @@ -2,10 +2,8 @@ annfail08.hs:9:1: No instance for (Data.Data.Data (a0 -> a0)) arising from an annotation - In the expression: (id + 1) In the annotation: {-# ANN f (id + 1) #-} annfail08.hs:9:15: No instance for (Num (a0 -> a0)) arising from a use of ?+? - In the expression: (id + 1) In the annotation: {-# ANN f (id + 1) #-} diff --git a/tests/annotations/should_fail/annfail09.stderr b/tests/annotations/should_fail/annfail09.stderr index 4bddab8..f1bd77c 100644 --- a/tests/annotations/should_fail/annfail09.stderr +++ b/tests/annotations/should_fail/annfail09.stderr @@ -3,5 +3,4 @@ annfail09.hs:11:11: GHC stage restriction: ?g? is used in a top-level splice or annotation, and must be imported, not defined locally - In the expression: g In the annotation: {-# ANN f g #-} diff --git a/tests/annotations/should_fail/annfail10.stderr b/tests/annotations/should_fail/annfail10.stderr index 2d32ac1..f9bfe26 100644 --- a/tests/annotations/should_fail/annfail10.stderr +++ b/tests/annotations/should_fail/annfail10.stderr @@ -11,7 +11,6 @@ annfail10.hs:9:1: Data.Data.Data (a, b, c) -- Defined in ?Data.Data? ...plus 31 others - In the expression: 1 In the annotation: {-# ANN f 1 #-} annfail10.hs:9:11: @@ -23,5 +22,4 @@ annfail10.hs:9:11: instance Integral a => Num (GHC.Real.Ratio a) -- Defined in ?GHC.Real? ...plus 11 others - In the expression: 1 In the annotation: {-# ANN f 1 #-} diff --git a/tests/annotations/should_fail/annfail12.stderr b/tests/annotations/should_fail/annfail12.stderr index 6b08c0a..b3cbb4e 100644 --- a/tests/annotations/should_fail/annfail12.stderr +++ b/tests/annotations/should_fail/annfail12.stderr @@ -2,7 +2,5 @@ annfail12.hs:5:1: Exception when trying to run compile-time code: You were meant to see this error! - In the expression: - (error "You were meant to see this error!" :: Int) In the annotation: - {-# ANN f (error "You were meant to see this error!" :: Int) #-} + {-# ANN f (error "You were meant to see this error!" :: Int) #-} From git at git.haskell.org Thu Nov 7 13:56:52 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 13:56:52 +0000 (UTC) Subject: [commit: ghc] master: Fix typo in User's Guide (f9b3ff4) Message-ID: <20131107135652.334982406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f9b3ff49fd0bf78930be7c0d07562e933c95cd9e/ghc >--------------------------------------------------------------- commit f9b3ff49fd0bf78930be7c0d07562e933c95cd9e Author: Pedro Rodrigues Date: Tue Nov 5 10:57:29 2013 +0000 Fix typo in User's Guide Signed-off-by: Austin Seipp >--------------------------------------------------------------- f9b3ff49fd0bf78930be7c0d07562e933c95cd9e docs/users_guide/glasgow_exts.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 11f45f6..5c4b091 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -8675,7 +8675,7 @@ proc (x,y) -> which is translated to arr (\ (x,y) -> if f x y then Left x else Right y) >>> - (arr (\x -> x+1) >>> f) ||| (arr (\y -> y+2) >>> g) + (arr (\x -> x+1) >>> g) ||| (arr (\y -> y+2) >>> h) Since the translation uses |||, the arrow concerned must belong to the ArrowChoice class. From git at git.haskell.org Thu Nov 7 13:56:54 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 13:56:54 +0000 (UTC) Subject: [commit: ghc] master: Add docs for #8305 (b459c35) Message-ID: <20131107135656.24ED42406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b459c35744d067ee05674012323d13a49bc09ea2/ghc >--------------------------------------------------------------- commit b459c35744d067ee05674012323d13a49bc09ea2 Author: Austin Seipp Date: Thu Nov 7 07:55:26 2013 -0600 Add docs for #8305 Signed-off-by: Austin Seipp >--------------------------------------------------------------- b459c35744d067ee05674012323d13a49bc09ea2 docs/users_guide/ghci.xml | 55 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) diff --git a/docs/users_guide/ghci.xml b/docs/users_guide/ghci.xml index de95182..e593775 100644 --- a/docs/users_guide/ghci.xml +++ b/docs/users_guide/ghci.xml @@ -3420,6 +3420,61 @@ warning settings: + + When defining GHCi macros, there is some important behavior you + should be aware of when names may conflict with built-in + commands, especially regarding tab completion. + + + For example, consider if you had a macro named + :time and in the shell, typed :t + 3 - what should happen? The current algorithm we use + for completing commands is: + + + + First, look up an exact match on the name from the defined macros. + + + Look for the exact match on the name in the built-in command list. + + + Do a prefix lookup on the list of built-in commands - + if a built-in command matches, but a macro is defined with + the same name as the built-in defined, pick the + macro. + + + Do a prefix lookup on the list of built-in commands. + + + Do a prefix lookup on the list of defined macros. + + + + + + Here are some examples: + + + + You have a macro :time and enter :t 3 + You get :type 3 + + + + You have a macro :type and enter :t 3 + You get :type 3 with your defined macro, not the builtin. + + + + You have a macro :time and a macro + :type, and enter :t + 3 + You get :type 3 with your defined macro. + + + From git at git.haskell.org Thu Nov 7 13:57:10 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 13:57:10 +0000 (UTC) Subject: [commit: packages/base] master: Fix OSX RTS crash due to bad coercion. (95a74f9) Message-ID: <20131107135710.BB1782406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/95a74f9b091a8b512828b6930ea46d7ac55be76b/base >--------------------------------------------------------------- commit 95a74f9b091a8b512828b6930ea46d7ac55be76b Author: Merijn Verstraaten Date: Wed Jul 24 14:37:25 2013 +0100 Fix OSX RTS crash due to bad coercion. The code coerces Int to CInt, which causes an overflow if Int is bigger than CInt (for example, Int 64bit, CInt 32 bit). This results in a negative value being passed to c_poll. On Linux all negative values are treated as infinite timeouts, which gives subtly wrong semantics, but is unlikely to produce actual bugs. OSX insists that only -1 is a valid value for infinite timeout, any other negative timeout is treated as an invalid argument. This patch replaces the c_poll call with a loop that handles the overflow gracefully by chaining multiple calls to poll to obtain the proper semantics. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 95a74f9b091a8b512828b6930ea46d7ac55be76b GHC/Event/Poll.hsc | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/GHC/Event/Poll.hsc b/GHC/Event/Poll.hsc index 665949b..6d089fb 100644 --- a/GHC/Event/Poll.hsc +++ b/GHC/Event/Poll.hsc @@ -35,6 +35,7 @@ import Foreign.Ptr (Ptr) import Foreign.Storable (Storable(..)) import GHC.Base import GHC.Conc.Sync (withMVar) +import GHC.Enum (maxBound) import GHC.Num (Num(..)) import GHC.Real (ceiling, fromIntegral) import GHC.Show (Show) @@ -90,7 +91,7 @@ poll p mtout f = do E.throwErrnoIfMinus1NoRetry "c_poll" $ case mtout of Just tout -> - c_poll ptr (fromIntegral len) (fromIntegral (fromTimeout tout)) + c_pollLoop ptr (fromIntegral len) (fromTimeout tout) Nothing -> c_poll_unsafe ptr (fromIntegral len) 0 unless (n == 0) $ do @@ -102,6 +103,27 @@ poll p mtout f = do return (i', i' == n) else return (i, True) return (fromIntegral n) + where + -- The poll timeout is specified as an Int, but c_poll takes a CInt. These + -- can't be safely coerced as on many systems (e.g. x86_64) CInt has a a + -- maxBound of (2^32 - 1), even though Int may have a significantly higher + -- bound. + -- + -- This function deals with timeouts greater than maxBound :: CInt, by + -- looping until c_poll returns a non-zero value (0 indicates timeout + -- expired) OR the full timeout has passed. + c_pollLoop :: Ptr PollFd -> (#type nfds_t) -> Int -> IO CInt + c_pollLoop ptr len tout + | tout <= maxPollTimeout = c_poll ptr len (fromIntegral tout) + | otherwise = do + result <- c_poll ptr len (fromIntegral maxPollTimeout) + if result == 0 + then c_pollLoop ptr len (fromIntegral (tout - maxPollTimeout)) + else return result + + -- Timeout of c_poll is limited by max value of CInt + maxPollTimeout :: Int + maxPollTimeout = fromIntegral (maxBound :: CInt) fromTimeout :: E.Timeout -> Int fromTimeout E.Forever = -1 From git at git.haskell.org Thu Nov 7 13:57:12 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 13:57:12 +0000 (UTC) Subject: [commit: packages/base] master: *Really* RTS crash due to bad coercion. (9c0eb7b) Message-ID: <20131107135712.C12C02406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9c0eb7b8d7978f0abc98296dcab050f4b6249c61/base >--------------------------------------------------------------- commit 9c0eb7b8d7978f0abc98296dcab050f4b6249c61 Author: Merijn Verstraaten Date: Wed Jul 24 19:00:42 2013 +0100 *Really* RTS crash due to bad coercion. Previous commit only moved the coercion mistake to a different architecture (i.e. underflow could still occur on platforms where Int is smaller than CInt). This patch should definitively deal with all possible combinations. Signed-off-by: Austin Seipp >--------------------------------------------------------------- 9c0eb7b8d7978f0abc98296dcab050f4b6249c61 GHC/Event/Poll.hsc | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/GHC/Event/Poll.hsc b/GHC/Event/Poll.hsc index 6d089fb..572cff6 100644 --- a/GHC/Event/Poll.hsc +++ b/GHC/Event/Poll.hsc @@ -121,9 +121,23 @@ poll p mtout f = do then c_pollLoop ptr len (fromIntegral (tout - maxPollTimeout)) else return result - -- Timeout of c_poll is limited by max value of CInt + -- We need to account for 3 cases: + -- 1. Int and CInt are of equal size. + -- 2. Int is larger than CInt + -- 3. Int is smaller than CInt + -- + -- In case 1, the value of maxPollTimeout will be the maxBound of Int. + -- + -- In case 2, the value of maxPollTimeout will be the maxBound of CInt, + -- which is the largest value accepted by c_poll. This will result in + -- c_pollLoop recursing if the provided timeout is larger. + -- + -- In case 3, "fromIntegral (maxBound :: CInt) :: Int" wil result in a + -- negative Int, max will thus return maxBound :: Int. Since poll doesn't + -- accept values bigger than maxBound :: Int and CInt is larger than Int, + -- there is no problem converting Int to CInt for the c_poll call. maxPollTimeout :: Int - maxPollTimeout = fromIntegral (maxBound :: CInt) + maxPollTimeout = max maxBound (fromIntegral (maxBound :: CInt)) fromTimeout :: E.Timeout -> Int fromTimeout E.Forever = -1 From git at git.haskell.org Thu Nov 7 23:38:29 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 23:38:29 +0000 (UTC) Subject: [commit: packages/integer-gmp] master: Rename `{import, export}Integer` (22c23c6) Message-ID: <20131107233829.3A3D42406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/integer-gmp On branch : master Link : http://git.haskell.org/packages/integer-gmp.git/commitdiff/22c23c6b6395e76d9717bca43f42a52cf84fc92d >--------------------------------------------------------------- commit 22c23c6b6395e76d9717bca43f42a52cf84fc92d Author: Herbert Valerio Riedel Date: Thu Nov 7 21:40:57 2013 +0100 Rename `{import,export}Integer` This renames to more verbose names which include the type these operations import/export from/to: - `importIntegerFromByteArray`, and - `exportIntegerToMutableByteArray`. This follows the naming convention used for other primitive operations, such as the recently added `copyMutableByteArrayToAddr` operation. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 22c23c6b6395e76d9717bca43f42a52cf84fc92d GHC/Integer/GMP/Internals.hs | 2 +- GHC/Integer/GMP/Prim.hs | 8 ++++---- GHC/Integer/Type.lhs | 28 ++++++++++++++-------------- cbits/gmp-wrappers.cmm | 4 ++-- 4 files changed, 21 insertions(+), 21 deletions(-) diff --git a/GHC/Integer/GMP/Internals.hs b/GHC/Integer/GMP/Internals.hs index 51727f8..54fe70a 100644 --- a/GHC/Integer/GMP/Internals.hs +++ b/GHC/Integer/GMP/Internals.hs @@ -1,6 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} -module GHC.Integer.GMP.Internals (Integer(..), gcdInt, gcdInteger, gcdExtInteger, lcmInteger, powInteger, powModInteger, powModSecInteger, recipModInteger, nextPrimeInteger, testPrimeInteger, sizeInBaseInteger, importInteger, exportInteger) +module GHC.Integer.GMP.Internals (Integer(..), gcdInt, gcdInteger, gcdExtInteger, lcmInteger, powInteger, powModInteger, powModSecInteger, recipModInteger, nextPrimeInteger, testPrimeInteger, sizeInBaseInteger, importIntegerFromByteArray, exportIntegerToMutableByteArray) where import GHC.Integer.Type diff --git a/GHC/Integer/GMP/Prim.hs b/GHC/Integer/GMP/Prim.hs index 99b5a8a..1152166 100644 --- a/GHC/Integer/GMP/Prim.hs +++ b/GHC/Integer/GMP/Prim.hs @@ -50,8 +50,8 @@ module GHC.Integer.GMP.Prim ( testPrimeInteger#, sizeInBaseInteger#, - exportInteger#, - importInteger#, + exportIntegerToMutableByteArray#, + importIntegerFromByteArray#, #if WORD_SIZE_IN_BITS < 64 int64ToInteger#, integerToInt64#, @@ -231,12 +231,12 @@ foreign import prim "integer_cmm_sizeInBasezh" sizeInBaseInteger# -- | -- -foreign import prim "integer_cmm_exportIntegerzh" exportInteger# +foreign import prim "integer_cmm_exportIntegerToMutableByteArrayzh" exportIntegerToMutableByteArray# :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) -- | -- -foreign import prim "integer_cmm_importIntegerzh" importInteger# +foreign import prim "integer_cmm_importIntegerFromByteArrayzh" importIntegerFromByteArray# :: ByteArray# -> Word# -> Word# -> Int# -> (# Int#, ByteArray# #) -- | diff --git a/GHC/Integer/Type.lhs b/GHC/Integer/Type.lhs index a8d7f09..2a654ea 100644 --- a/GHC/Integer/Type.lhs +++ b/GHC/Integer/Type.lhs @@ -47,7 +47,7 @@ import GHC.Integer.GMP.Prim ( testBitInteger#, mul2ExpInteger#, fdivQ2ExpInteger#, powInteger#, powModInteger#, powModSecInteger#, recipModInteger#, nextPrimeInteger#, testPrimeInteger#, - sizeInBaseInteger#, exportInteger#, importInteger#, + sizeInBaseInteger#, exportIntegerToMutableByteArray#, importIntegerFromByteArray#, #if WORD_SIZE_IN_BITS < 64 int64ToInteger#, integerToInt64#, word64ToInteger#, integerToWord64#, @@ -686,7 +686,7 @@ nextPrimeInteger (J# s d) = case nextPrimeInteger# s d of (# s', d' #) -> J# s' -- This function wraps @mpz_sizeinbase()@ which has some -- implementation pecularities to take into account: -- --- * @sizeInBaseInteger 0 base = 1@ (see also comment in 'exportInteger'). +-- * @sizeInBaseInteger 0 base = 1@ (see also comment in 'exportIntegerToMutableByteArray'). -- -- * This function is only defined if @base >= 2#@ and @base <= 256#@ -- (Note: the documentation claims that only @base <= 62#@ is @@ -705,7 +705,7 @@ sizeInBaseInteger (J# s d) b = sizeInBaseInteger# s d b -- | Dump 'Integer' (without sign) to mutable byte-array in base-256 representation. -- --- The call @exportInteger i mba offset order@ writes +-- The call @exportIntegerToMutableByteArray i mba offset order@ writes -- -- * the 'Integer' @i@ -- @@ -718,20 +718,20 @@ sizeInBaseInteger (J# s d) b = sizeInBaseInteger# s d b -- -- Use @sizeInBaseInteger i 256#@ to compute the exact number of bytes -- written in advance for @i /= 0 at . In case of @i == 0@, --- 'exportInteger' will write and report zero bytes written, whereas +-- 'exportIntegerToMutableByteArray' will write and report zero bytes written, whereas -- 'sizeInBaseInteger' report one byte. -- --- It's recommended to avoid calling 'exportInteger' for small +-- It's recommended to avoid calling 'exportIntegerToMutableByteArray' for small -- integers as this function would currently convert those to big -- integers in order to call @mpz_export()@. -{-# NOINLINE exportInteger #-} -exportInteger :: Integer -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) -exportInteger j@(S# _) mba o e = exportInteger (toBig j) mba o e -- TODO -exportInteger (J# s d) mba o e = exportInteger# s d mba o e +{-# NOINLINE exportIntegerToMutableByteArray #-} +exportIntegerToMutableByteArray :: Integer -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) +exportIntegerToMutableByteArray j@(S# _) mba o e = exportIntegerToMutableByteArray (toBig j) mba o e -- TODO +exportIntegerToMutableByteArray (J# s d) mba o e = exportIntegerToMutableByteArray# s d mba o e -- | Read 'Integer' (without sign) from byte-array in base-256 representation. -- --- The call @importInteger ba offset size order@ reads +-- The call @importIntegerFromByteArray ba offset size order@ reads -- -- * @size@ bytes from the 'ByteArray#' @mba@ starting at @offset@ -- @@ -740,12 +740,12 @@ exportInteger (J# s d) mba o e = exportInteger# s d mba o e -- -- * returns a new 'Integer' -- --- It's recommended to avoid calling 'importInteger' for known to be +-- It's recommended to avoid calling 'importIntegerFromByteArray' for known to be -- small integers as this function currently always returns a big -- integer even if it would fit into a small integer. -{-# NOINLINE importInteger #-} -importInteger :: ByteArray# -> Word# -> Word# -> Int# -> Integer -importInteger ba o l e = case importInteger# ba o l e of (# s', d' #) -> J# s' d' +{-# NOINLINE importIntegerFromByteArray #-} +importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer +importIntegerFromByteArray ba o l e = case importIntegerFromByteArray# ba o l e of (# s', d' #) -> J# s' d' \end{code} diff --git a/cbits/gmp-wrappers.cmm b/cbits/gmp-wrappers.cmm index 0da3db8..a4f4f0c 100644 --- a/cbits/gmp-wrappers.cmm +++ b/cbits/gmp-wrappers.cmm @@ -69,7 +69,7 @@ import "integer-gmp" integer_cbits_decodeDouble; the case for all the platforms that GHC supports, currently. -------------------------------------------------------------------------- */ -integer_cmm_importIntegerzh (P_ ba, W_ of, W_ sz, W_ e) +integer_cmm_importIntegerFromByteArrayzh (P_ ba, W_ of, W_ sz, W_ e) { W_ src_ptr; W_ mp_result; @@ -90,7 +90,7 @@ again: } /* :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) */ -integer_cmm_exportIntegerzh (W_ s1, P_ d1, P_ mba, W_ of, W_ e) +integer_cmm_exportIntegerToMutableByteArrayzh (W_ s1, P_ d1, P_ mba, W_ of, W_ e) { W_ dst_ptr; W_ mp_tmp; From git at git.haskell.org Thu Nov 7 23:38:31 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 23:38:31 +0000 (UTC) Subject: [commit: packages/integer-gmp] master: Add `Addr#` based `{import, export}Integer` variants (caf314e) Message-ID: <20131107233831.358032406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/integer-gmp On branch : master Link : http://git.haskell.org/packages/integer-gmp.git/commitdiff/caf314e79ad2e540fc6159b71d5a1ae27979f192 >--------------------------------------------------------------- commit caf314e79ad2e540fc6159b71d5a1ae27979f192 Author: Herbert Valerio Riedel Date: Thu Nov 7 22:23:36 2013 +0100 Add `Addr#` based `{import,export}Integer` variants These follow closely the existing implementations for `importIntegerFromByteArray` and `exportIntegerToMutableByteArray`. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- caf314e79ad2e540fc6159b71d5a1ae27979f192 GHC/Integer/GMP/Internals.hs | 2 +- GHC/Integer/GMP/Prim.hs | 18 +++++++++++++++--- GHC/Integer/Type.lhs | 23 +++++++++++++++++++++-- cbits/gmp-wrappers.cmm | 42 ++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 79 insertions(+), 6 deletions(-) diff --git a/GHC/Integer/GMP/Internals.hs b/GHC/Integer/GMP/Internals.hs index 54fe70a..fc5ca48 100644 --- a/GHC/Integer/GMP/Internals.hs +++ b/GHC/Integer/GMP/Internals.hs @@ -1,6 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} -module GHC.Integer.GMP.Internals (Integer(..), gcdInt, gcdInteger, gcdExtInteger, lcmInteger, powInteger, powModInteger, powModSecInteger, recipModInteger, nextPrimeInteger, testPrimeInteger, sizeInBaseInteger, importIntegerFromByteArray, exportIntegerToMutableByteArray) +module GHC.Integer.GMP.Internals (Integer(..), gcdInt, gcdInteger, gcdExtInteger, lcmInteger, powInteger, powModInteger, powModSecInteger, recipModInteger, nextPrimeInteger, testPrimeInteger, sizeInBaseInteger, importIntegerFromByteArray, importIntegerFromAddr, exportIntegerToMutableByteArray, exportIntegerToAddr) where import GHC.Integer.Type diff --git a/GHC/Integer/GMP/Prim.hs b/GHC/Integer/GMP/Prim.hs index 1152166..0fd1b37 100644 --- a/GHC/Integer/GMP/Prim.hs +++ b/GHC/Integer/GMP/Prim.hs @@ -50,8 +50,10 @@ module GHC.Integer.GMP.Prim ( testPrimeInteger#, sizeInBaseInteger#, - exportIntegerToMutableByteArray#, importIntegerFromByteArray#, + importIntegerFromAddr#, + exportIntegerToMutableByteArray#, + exportIntegerToAddr#, #if WORD_SIZE_IN_BITS < 64 int64ToInteger#, integerToInt64#, @@ -231,13 +233,23 @@ foreign import prim "integer_cmm_sizeInBasezh" sizeInBaseInteger# -- | -- +foreign import prim "integer_cmm_importIntegerFromByteArrayzh" importIntegerFromByteArray# + :: ByteArray# -> Word# -> Word# -> Int# -> (# Int#, ByteArray# #) + +-- | +-- +foreign import prim "integer_cmm_importIntegerFromAddrzh" importIntegerFromAddr# + :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Int#, ByteArray# #) + +-- | +-- foreign import prim "integer_cmm_exportIntegerToMutableByteArrayzh" exportIntegerToMutableByteArray# :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) -- | -- -foreign import prim "integer_cmm_importIntegerFromByteArrayzh" importIntegerFromByteArray# - :: ByteArray# -> Word# -> Word# -> Int# -> (# Int#, ByteArray# #) +foreign import prim "integer_cmm_exportIntegerToAddrzh" exportIntegerToAddr# + :: Int# -> ByteArray# -> Addr# -> Int# -> State# s -> (# State# s, Word# #) -- | -- diff --git a/GHC/Integer/Type.lhs b/GHC/Integer/Type.lhs index 2a654ea..1ebe19f 100644 --- a/GHC/Integer/Type.lhs +++ b/GHC/Integer/Type.lhs @@ -23,7 +23,7 @@ module GHC.Integer.Type where import GHC.Prim ( -- Other types we use, convert from, or convert to - Int#, Word#, Double#, Float#, ByteArray#, MutableByteArray#, State#, + Int#, Word#, Double#, Float#, ByteArray#, MutableByteArray#, Addr#, State#, -- Conversions between those types int2Word#, int2Double#, int2Float#, word2Int#, -- Operations on Int# that we use for operations on S# @@ -47,7 +47,9 @@ import GHC.Integer.GMP.Prim ( testBitInteger#, mul2ExpInteger#, fdivQ2ExpInteger#, powInteger#, powModInteger#, powModSecInteger#, recipModInteger#, nextPrimeInteger#, testPrimeInteger#, - sizeInBaseInteger#, exportIntegerToMutableByteArray#, importIntegerFromByteArray#, + sizeInBaseInteger#, + importIntegerFromByteArray#, importIntegerFromAddr#, + exportIntegerToMutableByteArray#, exportIntegerToAddr#, #if WORD_SIZE_IN_BITS < 64 int64ToInteger#, integerToInt64#, word64ToInteger#, integerToWord64#, @@ -729,6 +731,14 @@ exportIntegerToMutableByteArray :: Integer -> MutableByteArray# s -> Word# -> In exportIntegerToMutableByteArray j@(S# _) mba o e = exportIntegerToMutableByteArray (toBig j) mba o e -- TODO exportIntegerToMutableByteArray (J# s d) mba o e = exportIntegerToMutableByteArray# s d mba o e +-- | Dump 'Integer' (without sign) to 'Addr#' in base-256 representation. +-- +-- See description of 'exportIntegerToMutableByteArray' for more details. +{-# NOINLINE exportIntegerToAddr #-} +exportIntegerToAddr :: Integer -> Addr# -> Int# -> State# s -> (# State# s, Word# #) +exportIntegerToAddr (J# s d) addr o e = exportIntegerToAddr# s d addr o e +exportIntegerToAddr j@(S# _) addr o e = exportIntegerToAddr (toBig j) addr o e -- TODO + -- | Read 'Integer' (without sign) from byte-array in base-256 representation. -- -- The call @importIntegerFromByteArray ba offset size order@ reads @@ -747,6 +757,15 @@ exportIntegerToMutableByteArray (J# s d) mba o e = exportIntegerToMutableByteArr importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer importIntegerFromByteArray ba o l e = case importIntegerFromByteArray# ba o l e of (# s', d' #) -> J# s' d' +-- | Read 'Integer' (without sign) from memory location at 'Addr#' in +-- base-256 representation. +-- +-- See description of 'importIntegerFromByteArray' for more details. +{-# NOINLINE importIntegerFromAddr #-} +importIntegerFromAddr :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Integer #) +importIntegerFromAddr addr l e st = case importIntegerFromAddr# addr l e st of + (# st', s', d' #) -> (# st', J# s' d' #) + \end{code} %********************************************************* diff --git a/cbits/gmp-wrappers.cmm b/cbits/gmp-wrappers.cmm index a4f4f0c..a578a1b 100644 --- a/cbits/gmp-wrappers.cmm +++ b/cbits/gmp-wrappers.cmm @@ -69,6 +69,7 @@ import "integer-gmp" integer_cbits_decodeDouble; the case for all the platforms that GHC supports, currently. -------------------------------------------------------------------------- */ +/* :: ByteArray# -> Word# -> Word# -> Int# -> (# Int#, ByteArray# #) */ integer_cmm_importIntegerFromByteArrayzh (P_ ba, W_ of, W_ sz, W_ e) { W_ src_ptr; @@ -89,6 +90,24 @@ again: MP_INT__mp_d(mp_result) - SIZEOF_StgArrWords); } +/* :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Int#, ByteArray# #) */ +integer_cmm_importIntegerFromAddrzh (W_ src_ptr, W_ sz, W_ e) +{ + W_ mp_result; + +again: + STK_CHK_GEN_N (SIZEOF_MP_INT); + MAYBE_GC(again); + + mp_result = Sp - SIZEOF_MP_INT; + + ccall __gmpz_init(mp_result "ptr"); + ccall __gmpz_import(mp_result "ptr", sz, W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, src_ptr "ptr"); + + return(TO_W_(MP_INT__mp_size(mp_result)), + MP_INT__mp_d(mp_result) - SIZEOF_StgArrWords); +} + /* :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) */ integer_cmm_exportIntegerToMutableByteArrayzh (W_ s1, P_ d1, P_ mba, W_ of, W_ e) { @@ -115,6 +134,29 @@ again: return (W_[cnt_result]); } +/* :: Int# -> ByteArray# -> Addr# -> Int# -> State# s -> (# State# s, Word# #) */ +integer_cmm_exportIntegerToAddrzh (W_ s1, P_ d1, W_ dst_ptr, W_ e) +{ + W_ mp_tmp; + W_ cnt_result; + +again: + STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_W); + MAYBE_GC(again); + + mp_tmp = Sp - SIZEOF_MP_INT; + MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d1)); + MP_INT__mp_size(mp_tmp) = (s1); + MP_INT__mp_d(mp_tmp) = BYTE_ARR_CTS(d1); + + cnt_result = Sp - (SIZEOF_MP_INT + SIZEOF_W); + W_[cnt_result] = 0; + + ccall __gmpz_export(dst_ptr "ptr", cnt_result "ptr", W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, mp_tmp "ptr"); + + return (W_[cnt_result]); +} + integer_cmm_int2Integerzh (W_ val) { W_ s, p; /* to avoid aliasing */ From git at git.haskell.org Thu Nov 7 23:38:33 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 23:38:33 +0000 (UTC) Subject: [commit: packages/integer-gmp] master: Optimize order of pattern matches for export operations (d43d362) Message-ID: <20131107233834.1535D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/integer-gmp On branch : master Link : http://git.haskell.org/packages/integer-gmp.git/commitdiff/d43d362c0977e681ef9f71f3e38d45cc5b6be8da >--------------------------------------------------------------- commit d43d362c0977e681ef9f71f3e38d45cc5b6be8da Author: Herbert Valerio Riedel Date: Thu Nov 7 23:52:46 2013 +0100 Optimize order of pattern matches for export operations These are supposed to be called with `J#`-kind `Integer`s, so check that constructor first. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- d43d362c0977e681ef9f71f3e38d45cc5b6be8da GHC/Integer/Type.lhs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GHC/Integer/Type.lhs b/GHC/Integer/Type.lhs index 1ebe19f..85bccf8 100644 --- a/GHC/Integer/Type.lhs +++ b/GHC/Integer/Type.lhs @@ -702,8 +702,8 @@ nextPrimeInteger (J# s d) = case nextPrimeInteger# s d of (# s', d' #) -> J# s' -- significant bit of @i at . {-# NOINLINE sizeInBaseInteger #-} sizeInBaseInteger :: Integer -> Int# -> Word# -sizeInBaseInteger j@(S# _) b = sizeInBaseInteger (toBig j) b -- TODO sizeInBaseInteger (J# s d) b = sizeInBaseInteger# s d b +sizeInBaseInteger j@(S# _) b = sizeInBaseInteger (toBig j) b -- TODO -- | Dump 'Integer' (without sign) to mutable byte-array in base-256 representation. -- @@ -728,8 +728,8 @@ sizeInBaseInteger (J# s d) b = sizeInBaseInteger# s d b -- integers in order to call @mpz_export()@. {-# NOINLINE exportIntegerToMutableByteArray #-} exportIntegerToMutableByteArray :: Integer -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) -exportIntegerToMutableByteArray j@(S# _) mba o e = exportIntegerToMutableByteArray (toBig j) mba o e -- TODO exportIntegerToMutableByteArray (J# s d) mba o e = exportIntegerToMutableByteArray# s d mba o e +exportIntegerToMutableByteArray j@(S# _) mba o e = exportIntegerToMutableByteArray (toBig j) mba o e -- TODO -- | Dump 'Integer' (without sign) to 'Addr#' in base-256 representation. -- From git at git.haskell.org Thu Nov 7 23:38:35 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 23:38:35 +0000 (UTC) Subject: [commit: packages/integer-gmp] master: Improve Haddock documentation (3990c28) Message-ID: <20131107233835.3F8222406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/integer-gmp On branch : master Link : http://git.haskell.org/packages/integer-gmp.git/commitdiff/3990c28b297b0ddfde0d37b0e3ced69b2154de3e >--------------------------------------------------------------- commit 3990c28b297b0ddfde0d37b0e3ced69b2154de3e Author: Herbert Valerio Riedel Date: Fri Nov 8 00:36:16 2013 +0100 Improve Haddock documentation Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 3990c28b297b0ddfde0d37b0e3ced69b2154de3e GHC/Integer/GMP/Internals.hs | 30 +++++++++-- GHC/Integer/Type.lhs | 112 +++++++++++++++++++++++++----------------- 2 files changed, 95 insertions(+), 47 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3990c28b297b0ddfde0d37b0e3ced69b2154de3e From git at git.haskell.org Thu Nov 7 23:38:51 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 23:38:51 +0000 (UTC) Subject: [commit: testsuite] master: Add tests for new import/export GMP primitives (9431918) Message-ID: <20131107233851.CD9582406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9431918fe4c8ceb23f120a67cd6d80b151bbb69b/testsuite >--------------------------------------------------------------- commit 9431918fe4c8ceb23f120a67cd6d80b151bbb69b Author: Herbert Valerio Riedel Date: Thu Nov 7 23:49:44 2013 +0100 Add tests for new import/export GMP primitives Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 9431918fe4c8ceb23f120a67cd6d80b151bbb69b tests/lib/integer/integerGmpInternals.hs | 146 ++++++++++++++++++++++---- tests/lib/integer/integerGmpInternals.stdout | 23 ++++ 2 files changed, 147 insertions(+), 22 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9431918fe4c8ceb23f120a67cd6d80b151bbb69b From git at git.haskell.org Thu Nov 7 23:40:47 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Nov 2013 23:40:47 +0000 (UTC) Subject: [commit: ghc] master: Update aux files `config.{guess, sub}` and `install-sh` (9378e39) Message-ID: <20131107234047.977BE2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9378e39b86e33a25a3507f62560134c487ce8a68/ghc >--------------------------------------------------------------- commit 9378e39b86e33a25a3507f62560134c487ce8a68 Author: Herbert Valerio Riedel Date: Fri Nov 8 00:39:28 2013 +0100 Update aux files `config.{guess,sub}` and `install-sh` This updates the files to the versions bundled with GNU automake 1.13.3 Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 9378e39b86e33a25a3507f62560134c487ce8a68 config.guess | 184 +++++++++++++++++++--------------- config.sub | 314 +++++++++++++++++++++++++++++++++++++++------------------- install-sh | 38 ++++--- 3 files changed, 343 insertions(+), 193 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 9378e39b86e33a25a3507f62560134c487ce8a68 From git at git.haskell.org Fri Nov 8 07:20:34 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Nov 2013 07:20:34 +0000 (UTC) Subject: [commit: packages/base] master: Spelling in comments (e312692) Message-ID: <20131108072034.691AD2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/base On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e31269229f80795a845091d930e21b153dc0cd0a/base >--------------------------------------------------------------- commit e31269229f80795a845091d930e21b153dc0cd0a Author: Gabor Greif Date: Fri Nov 8 08:20:14 2013 +0100 Spelling in comments >--------------------------------------------------------------- e31269229f80795a845091d930e21b153dc0cd0a GHC/Event/Poll.hsc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GHC/Event/Poll.hsc b/GHC/Event/Poll.hsc index 572cff6..a832789 100644 --- a/GHC/Event/Poll.hsc +++ b/GHC/Event/Poll.hsc @@ -105,7 +105,7 @@ poll p mtout f = do return (fromIntegral n) where -- The poll timeout is specified as an Int, but c_poll takes a CInt. These - -- can't be safely coerced as on many systems (e.g. x86_64) CInt has a a + -- can't be safely coerced as on many systems (e.g. x86_64) CInt has a -- maxBound of (2^32 - 1), even though Int may have a significantly higher -- bound. -- @@ -132,7 +132,7 @@ poll p mtout f = do -- which is the largest value accepted by c_poll. This will result in -- c_pollLoop recursing if the provided timeout is larger. -- - -- In case 3, "fromIntegral (maxBound :: CInt) :: Int" wil result in a + -- In case 3, "fromIntegral (maxBound :: CInt) :: Int" will result in a -- negative Int, max will thus return maxBound :: Int. Since poll doesn't -- accept values bigger than maxBound :: Int and CInt is larger than Int, -- there is no problem converting Int to CInt for the c_poll call. From git at git.haskell.org Fri Nov 8 10:51:48 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Nov 2013 10:51:48 +0000 (UTC) Subject: [commit: ghc] master: Make worker/wrapper robust to bogus unsafeCorece (a1b6932) Message-ID: <20131108105148.A03D52406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a1b6932419a2d425b2a3b7672926a0f9c368f234/ghc >--------------------------------------------------------------- commit a1b6932419a2d425b2a3b7672926a0f9c368f234 Author: Simon Peyton Jones Date: Fri Nov 8 10:51:20 2013 +0000 Make worker/wrapper robust to bogus unsafeCorece Fixes Trac #8037 >--------------------------------------------------------------- a1b6932419a2d425b2a3b7672926a0f9c368f234 compiler/stranal/WwLib.lhs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs index 2548b0e..10e5ed3 100644 --- a/compiler/stranal/WwLib.lhs +++ b/compiler/stranal/WwLib.lhs @@ -444,6 +444,8 @@ mkWWstr_one dflags arg -- See Note [Unpacking arguments with product and polymorphic demands] , Just (data_con, inst_tys, inst_con_arg_tys, co) <- deepSplitProductType_maybe (idType arg) + , cs `equalLength` inst_con_arg_tys + -- See Note [mkWWstr and unsafeCore] = do { (uniq1:uniqs) <- getUniquesM ; let unpk_args = zipWith mk_ww_local uniqs inst_con_arg_tys unpk_args_w_ds = zipWithEqual "mkWWstr" set_worker_arg_info unpk_args cs @@ -473,6 +475,13 @@ nop_fn :: CoreExpr -> CoreExpr nop_fn body = body \end{code} +Note [mkWWstr and unsafeCoerce] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Byy using usafeCoerce, it is possible to make the number of demands fail to +match the number of constructor arguments; this happened in Trac #8037. +If so, the worker/wrapper split doesn't work right and we get a Core Lint +bug. The fix here is simply to decline to do w/w if that happens. + \begin{code} deepSplitProductType_maybe :: Type -> Maybe (DataCon, [Type], [Type], Coercion) -- If deepSplitProductType_maybe ty = Just (dc, tys, arg_tys, co) From git at git.haskell.org Fri Nov 8 10:52:32 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Nov 2013 10:52:32 +0000 (UTC) Subject: [commit: testsuite] master: Test Trac #8037 (9441b7f) Message-ID: <20131108105232.C8D8A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/testsuite On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9441b7fbf952adf9a3a4402167ba40d8d2166d98/testsuite >--------------------------------------------------------------- commit 9441b7fbf952adf9a3a4402167ba40d8d2166d98 Author: Simon Peyton Jones Date: Fri Nov 8 10:52:14 2013 +0000 Test Trac #8037 >--------------------------------------------------------------- 9441b7fbf952adf9a3a4402167ba40d8d2166d98 tests/stranal/should_compile/T8037.hs | 17 +++++++++++++++++ tests/stranal/should_compile/all.T | 1 + 2 files changed, 18 insertions(+) diff --git a/tests/stranal/should_compile/T8037.hs b/tests/stranal/should_compile/T8037.hs new file mode 100644 index 0000000..62d2a13 --- /dev/null +++ b/tests/stranal/should_compile/T8037.hs @@ -0,0 +1,17 @@ +module T8037 where + +import Unsafe.Coerce +import Foreign.C.Types +import System.IO.Unsafe + +data D4 = D4 CInt CInt CInt +data Color3 = Color3 CInt CInt + +crash :: D4 -> IO () +crash x = color (unsafeCoerce x) + +color :: Color3 -> IO () +color (Color3 r g) = f (unsafePerformIO undefined) r g + +foreign import ccall f :: CInt -> CInt -> CInt -> IO () + diff --git a/tests/stranal/should_compile/all.T b/tests/stranal/should_compile/all.T index 9467a7e..7ee45ad 100644 --- a/tests/stranal/should_compile/all.T +++ b/tests/stranal/should_compile/all.T @@ -17,3 +17,4 @@ test('unu', normal, compile, ['']) test('newtype', req_profiling, compile, ['-prof -auto-all']) test('T1988', normal, compile, ['']) test('T8467', normal, compile, ['']) +test('T8037', normal, compile, ['']) From git at git.haskell.org Fri Nov 8 12:16:09 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Nov 2013 12:16:09 +0000 (UTC) Subject: [commit: packages/unix] master: Fix `forkProcess` to inherit caller's `MaskingState` (897d66a) Message-ID: <20131108121609.F37262406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/897d66ad9d77d17dae1b5ac94af792e671a76c13/unix >--------------------------------------------------------------- commit 897d66ad9d77d17dae1b5ac94af792e671a76c13 Author: Herbert Valerio Riedel Date: Fri Nov 8 12:42:56 2013 +0100 Fix `forkProcess` to inherit caller's `MaskingState` ...and while at it, use `bracket` to fix a potential resource leak due to `freeStablePtr` not being called if `throwErrnoIfMinus1` throws an exception. This fixes #8433 Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 897d66ad9d77d17dae1b5ac94af792e671a76c13 System/Posix/Process/Common.hsc | 22 ++++++++++++++++++---- changelog | 4 +++- 2 files changed, 21 insertions(+), 5 deletions(-) diff --git a/System/Posix/Process/Common.hsc b/System/Posix/Process/Common.hsc index 51c75b3..1b504df 100644 --- a/System/Posix/Process/Common.hsc +++ b/System/Posix/Process/Common.hsc @@ -81,7 +81,9 @@ import System.Posix.Types import Control.Monad #ifdef __GLASGOW_HASKELL__ +import Control.Exception.Base ( bracket, getMaskingState, MaskingState(..) ) -- used by forkProcess import GHC.TopHandler ( runIO ) +import GHC.IO ( unsafeUnmask, uninterruptibleMask_ ) #endif #ifdef __HUGS__ @@ -278,6 +280,9 @@ threads will be copied to the child process. On success, 'forkProcess' returns the child's 'ProcessID' to the parent process; in case of an error, an exception is thrown. +The exception masking state of the executed action is inherited +(c.f. 'forkIO'), see also 'forkProcessWithUnmask' (/since: 2.7.0.0/). + 'forkProcess' comes with a giant warning: since any other running threads are not copied into the child process, it's easy to go wrong: e.g. by accessing some shared resource that was held by another thread @@ -286,10 +291,19 @@ in the parent. forkProcess :: IO () -> IO ProcessID forkProcess action = do - stable <- newStablePtr (runIO action) - pid <- throwErrnoIfMinus1 "forkProcess" (forkProcessPrim stable) - freeStablePtr stable - return pid + -- wrap action to re-establish caller's masking state, as + -- 'forkProcessPrim' starts in 'MaskedInterruptible' state by + -- default; see also #1048 + mstate <- getMaskingState + let action' = case mstate of + Unmasked -> unsafeUnmask action + MaskedInterruptible -> action + MaskedUninterruptible -> uninterruptibleMask_ action + + bracket + (newStablePtr (runIO action')) + freeStablePtr + (\stable -> throwErrnoIfMinus1 "forkProcess" (forkProcessPrim stable)) foreign import ccall "forkProcess" forkProcessPrim :: StablePtr (IO ()) -> IO CPid #endif /* __GLASGOW_HASKELL__ */ diff --git a/changelog b/changelog index 165cf82..ec0fbc8 100644 --- a/changelog +++ b/changelog @@ -1,6 +1,8 @@ -*-changelog-*- -2.7.0.0 Oct 2013 +2.7.0.0 Nov 2013 + + * Change `forkProcess` to inherit the exception masking state of its caller * Add new `Bool` flag to `ProcessStatus(Terminated)` constructor indicating whether a core dump occured From git at git.haskell.org Fri Nov 8 12:16:11 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Nov 2013 12:16:11 +0000 (UTC) Subject: [commit: packages/unix] master: Add `forkProcessWithUnmask` function (17192d8) Message-ID: <20131108121612.3037A2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/17192d89e642c463a1987fa3cc5cca2eb546bec7/unix >--------------------------------------------------------------- commit 17192d89e642c463a1987fa3cc5cca2eb546bec7 Author: Herbert Valerio Riedel Date: Fri Nov 8 12:48:54 2013 +0100 Add `forkProcessWithUnmask` function This seemed to be an obvious addition while working on #8433. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 17192d89e642c463a1987fa3cc5cca2eb546bec7 System/Posix/Process/ByteString.hsc | 1 + System/Posix/Process/Common.hsc | 10 +++++++++- changelog | 4 ++++ unix.cabal | 1 + 4 files changed, 15 insertions(+), 1 deletion(-) diff --git a/System/Posix/Process/ByteString.hsc b/System/Posix/Process/ByteString.hsc index 30f40cd..4c6840a 100644 --- a/System/Posix/Process/ByteString.hsc +++ b/System/Posix/Process/ByteString.hsc @@ -22,6 +22,7 @@ module System.Posix.Process.ByteString ( -- ** Forking and executing #ifdef __GLASGOW_HASKELL__ forkProcess, + forkProcessWithUnmask, #endif executeFile, diff --git a/System/Posix/Process/Common.hsc b/System/Posix/Process/Common.hsc index 1b504df..b760caa 100644 --- a/System/Posix/Process/Common.hsc +++ b/System/Posix/Process/Common.hsc @@ -1,4 +1,4 @@ -{-# LANGUAGE InterruptibleFFI #-} +{-# LANGUAGE InterruptibleFFI, RankNTypes #-} #ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} #endif @@ -23,6 +23,7 @@ module System.Posix.Process.Common ( -- ** Forking and executing #ifdef __GLASGOW_HASKELL__ forkProcess, + forkProcessWithUnmask, #endif -- ** Exiting @@ -306,6 +307,13 @@ forkProcess action = do (\stable -> throwErrnoIfMinus1 "forkProcess" (forkProcessPrim stable)) foreign import ccall "forkProcess" forkProcessPrim :: StablePtr (IO ()) -> IO CPid + +-- | Variant of 'forkProcess' in the style of 'forkIOWithUnmask'. +-- +-- /Since: 2.7.0.0/ +forkProcessWithUnmask :: ((forall a . IO a -> IO a) -> IO ()) -> IO ProcessID +forkProcessWithUnmask action = forkProcess (action unsafeUnmask) + #endif /* __GLASGOW_HASKELL__ */ -- ----------------------------------------------------------------------------- diff --git a/changelog b/changelog index ec0fbc8..ce72345 100644 --- a/changelog +++ b/changelog @@ -2,6 +2,8 @@ 2.7.0.0 Nov 2013 + * New `forkProcessWithUnmask` function in the style of `forkIOWithUnmask` + * Change `forkProcess` to inherit the exception masking state of its caller * Add new `Bool` flag to `ProcessStatus(Terminated)` constructor @@ -26,6 +28,8 @@ * Fix library detection of `shm*` on openSUSE (#8350) + * Minor documentation fixes/updates + * Update package to `cabal-version >= 1.10` format 2.6.0.1 Jan 2013 diff --git a/unix.cabal b/unix.cabal index 2f729ba..3ad3c98 100644 --- a/unix.cabal +++ b/unix.cabal @@ -54,6 +54,7 @@ library InterruptibleFFI NoMonomorphismRestriction OverloadedStrings + RankNTypes if impl(ghc) other-extensions: From git at git.haskell.org Fri Nov 8 12:16:14 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Nov 2013 12:16:14 +0000 (UTC) Subject: [commit: packages/unix] master: Fix markup for function names in DEPRECATION messages (a6bc389) Message-ID: <20131108121614.110FB2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a6bc389df2b25cbf9340f54b123a08831350d3f0/unix >--------------------------------------------------------------- commit a6bc389df2b25cbf9340f54b123a08831350d3f0 Author: Herbert Valerio Riedel Date: Fri Nov 8 12:54:22 2013 +0100 Fix markup for function names in DEPRECATION messages This helps Haddock make tose hyperlinked functions. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- a6bc389df2b25cbf9340f54b123a08831350d3f0 System/Posix/Process/Common.hsc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/System/Posix/Process/Common.hsc b/System/Posix/Process/Common.hsc index b760caa..e8fd415 100644 --- a/System/Posix/Process/Common.hsc +++ b/System/Posix/Process/Common.hsc @@ -407,7 +407,7 @@ foreign import ccall unsafe "exit" -- ----------------------------------------------------------------------------- -- Deprecated or subject to change -{-# DEPRECATED createProcessGroup "This function is scheduled to be replaced by something different in the future, we therefore recommend that you do not use this version and use createProcessGroupFor instead." #-} -- deprecated in 7.2 +{-# DEPRECATED createProcessGroup "This function is scheduled to be replaced by something different in the future, we therefore recommend that you do not use this version and use 'createProcessGroupFor' instead." #-} -- deprecated in 7.2 -- | @'createProcessGroup' pid@ calls @setpgid@ to make -- process @pid@ a new process group leader. -- This function is currently deprecated, @@ -418,7 +418,7 @@ createProcessGroup pid = do throwErrnoIfMinus1_ "createProcessGroup" (c_setpgid pid 0) return pid -{-# DEPRECATED setProcessGroupID "This function is scheduled to be replaced by something different in the future, we therefore recommend that you do not use this version and use setProcessGroupIdOf instead." #-} -- deprecated in 7.2 +{-# DEPRECATED setProcessGroupID "This function is scheduled to be replaced by something different in the future, we therefore recommend that you do not use this version and use 'setProcessGroupIDOf' instead." #-} -- deprecated in 7.2 -- | @'setProcessGroupID' pid pgid@ calls @setpgid@ to set the -- 'ProcessGroupID' for process @pid@ to @pgid at . -- This function is currently deprecated, From git at git.haskell.org Fri Nov 8 14:49:36 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Nov 2013 14:49:36 +0000 (UTC) Subject: [commit: packages/unix] master: `M-x untabify` & `M-x delete-trailing-whitespace` (a5aa36d) Message-ID: <20131108144936.AD3CC2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a5aa36d7a86ccfea758fdeec39127d552f322285/unix >--------------------------------------------------------------- commit a5aa36d7a86ccfea758fdeec39127d552f322285 Author: Herbert Valerio Riedel Date: Fri Nov 8 15:48:18 2013 +0100 `M-x untabify` & `M-x delete-trailing-whitespace` ...on recently touched files Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- a5aa36d7a86ccfea758fdeec39127d552f322285 System/Posix/Process/ByteString.hsc | 23 +++++++++++------------ System/Posix/Process/Common.hsc | 30 +++++++++++++++--------------- System/Posix/Signals.hsc | 19 +++++++++---------- 3 files changed, 35 insertions(+), 37 deletions(-) diff --git a/System/Posix/Process/ByteString.hsc b/System/Posix/Process/ByteString.hsc index 4c6840a..294970e 100644 --- a/System/Posix/Process/ByteString.hsc +++ b/System/Posix/Process/ByteString.hsc @@ -100,7 +100,7 @@ import System.Posix.ByteString.FilePath -- the argument list passed to 'executeFile' therefore -- begins with @arg[1]@. executeFile :: RawFilePath -- ^ Command - -> Bool -- ^ Search PATH? + -> Bool -- ^ Search PATH? -> [ByteString] -- ^ Arguments -> Maybe [(ByteString, ByteString)] -- ^ Environment -> IO a @@ -108,10 +108,10 @@ executeFile path search args Nothing = do withFilePath path $ \s -> withMany withFilePath (path:args) $ \cstrs -> withArray0 nullPtr cstrs $ \arr -> do - pPrPr_disableITimers - if search - then throwErrnoPathIfMinus1_ "executeFile" path (c_execvp s arr) - else throwErrnoPathIfMinus1_ "executeFile" path (c_execv s arr) + pPrPr_disableITimers + if search + then throwErrnoPathIfMinus1_ "executeFile" path (c_execvp s arr) + else throwErrnoPathIfMinus1_ "executeFile" path (c_execv s arr) return undefined -- never reached executeFile path search args (Just env) = do @@ -121,12 +121,12 @@ executeFile path search args (Just env) = do let env' = map (\ (name, val) -> name `BC.append` ('=' `BC.cons` val)) env in withMany withFilePath env' $ \cenv -> withArray0 nullPtr cenv $ \env_arr -> do - pPrPr_disableITimers - if search - then throwErrnoPathIfMinus1_ "executeFile" path - (c_execvpe s arg_arr env_arr) - else throwErrnoPathIfMinus1_ "executeFile" path - (c_execve s arg_arr env_arr) + pPrPr_disableITimers + if search + then throwErrnoPathIfMinus1_ "executeFile" path + (c_execvpe s arg_arr env_arr) + else throwErrnoPathIfMinus1_ "executeFile" path + (c_execve s arg_arr env_arr) return undefined -- never reached foreign import ccall unsafe "execvp" @@ -137,4 +137,3 @@ foreign import ccall unsafe "execv" foreign import ccall unsafe "execve" c_execve :: CString -> Ptr CString -> Ptr CString -> IO CInt - diff --git a/System/Posix/Process/Common.hsc b/System/Posix/Process/Common.hsc index e8fd415..66e0d20 100644 --- a/System/Posix/Process/Common.hsc +++ b/System/Posix/Process/Common.hsc @@ -83,7 +83,7 @@ import Control.Monad #ifdef __GLASGOW_HASKELL__ import Control.Exception.Base ( bracket, getMaskingState, MaskingState(..) ) -- used by forkProcess -import GHC.TopHandler ( runIO ) +import GHC.TopHandler ( runIO ) import GHC.IO ( unsafeUnmask, uninterruptibleMask_ ) #endif @@ -188,11 +188,11 @@ foreign import ccall unsafe "setsid" data ProcessTimes = ProcessTimes { elapsedTime :: ClockTick - , userTime :: ClockTick - , systemTime :: ClockTick - , childUserTime :: ClockTick - , childSystemTime :: ClockTick - } + , userTime :: ClockTick + , systemTime :: ClockTick + , childUserTime :: ClockTick + , childSystemTime :: ClockTick + } -- | 'getProcessTimes' calls @times@ to obtain time-accounting -- information for the current process and its children. @@ -205,11 +205,11 @@ getProcessTimes = do cut <- (#peek struct tms, tms_cutime) p_tms cst <- (#peek struct tms, tms_cstime) p_tms return (ProcessTimes{ elapsedTime = elapsed, - userTime = ut, - systemTime = st, - childUserTime = cut, - childSystemTime = cst - }) + userTime = ut, + systemTime = st, + childUserTime = cut, + childSystemTime = cst + }) type CTms = () @@ -329,11 +329,11 @@ getProcessStatus :: Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus) getProcessStatus block stopped pid = alloca $ \wstatp -> do pid' <- throwErrnoIfMinus1Retry "getProcessStatus" - (c_waitpid pid wstatp (waitOptions block stopped)) + (c_waitpid pid wstatp (waitOptions block stopped)) case pid' of 0 -> return Nothing _ -> do ps <- readWaitStatus wstatp - return (Just ps) + return (Just ps) -- safe/interruptible, because this call might block foreign import ccall interruptible "waitpid" @@ -356,11 +356,11 @@ getGroupProcessStatus :: Bool getGroupProcessStatus block stopped pgid = alloca $ \wstatp -> do pid <- throwErrnoIfMinus1Retry "getGroupProcessStatus" - (c_waitpid (-pgid) wstatp (waitOptions block stopped)) + (c_waitpid (-pgid) wstatp (waitOptions block stopped)) case pid of 0 -> return Nothing _ -> do ps <- readWaitStatus wstatp - return (Just (pid, ps)) + return (Just (pid, ps)) -- | @'getAnyProcessStatus' blk stopped@ calls @waitpid@, returning -- @'Just' (pid, tc)@, the 'ProcessID' and 'ProcessStatus' for any diff --git a/System/Posix/Signals.hsc b/System/Posix/Signals.hsc index 4b5321e..d4c6d51 100644 --- a/System/Posix/Signals.hsc +++ b/System/Posix/Signals.hsc @@ -315,7 +315,7 @@ type Signal = CInt -- | The actions to perform when a signal is received. data Handler = Default | Ignore - -- not yet: | Hold + -- not yet: | Hold | Catch (IO ()) | CatchOnce (IO ()) | CatchInfo (SignalInfo -> IO ()) -- ^ /Since: 2.7.0.0/ @@ -354,8 +354,8 @@ data SignalSpecificInfo -- signal handler for @int@ is returned installHandler :: Signal -> Handler - -> Maybe SignalSet -- ^ other signals to block - -> IO Handler -- ^ old handler + -> Maybe SignalSet -- ^ other signals to block + -> IO Handler -- ^ old handler #ifdef __PARALLEL_HASKELL__ installHandler = @@ -417,10 +417,10 @@ installHandler sig handler _maybe_mask = do foreign import ccall unsafe stg_sig_install - :: CInt -- sig no. - -> CInt -- action code (STG_SIG_HAN etc.) - -> Ptr CSigset -- (in, out) blocked - -> IO CInt -- (ret) old action code + :: CInt -- sig no. + -> CInt -- action code (STG_SIG_HAN etc.) + -> Ptr CSigset -- (in, out) blocked + -> IO CInt -- (ret) old action code getinfo :: (SignalInfo -> IO ()) -> ForeignPtr Word8 -> IO () getinfo handler fp_info = do @@ -593,8 +593,8 @@ getPendingSignals = do awaitSignal :: Maybe SignalSet -> IO () awaitSignal maybe_sigset = do fp <- case maybe_sigset of - Nothing -> do SignalSet fp <- getSignalMask; return fp - Just (SignalSet fp) -> return fp + Nothing -> do SignalSet fp <- getSignalMask; return fp + Just (SignalSet fp) -> return fp withForeignPtr fp $ \p -> do _ <- c_sigsuspend p return () @@ -640,4 +640,3 @@ foreign import capi unsafe "signal.h sigismember" foreign import ccall unsafe "sigpending" c_sigpending :: Ptr CSigset -> IO CInt - From git at git.haskell.org Fri Nov 8 15:18:30 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Nov 2013 15:18:30 +0000 (UTC) Subject: [commit: packages/unix] master: Add `cabal install` step to Travis CI script (5ccab3c) Message-ID: <20131108151830.AA2652406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5ccab3c64a2e37903111755c6b99795c410bed0e/unix >--------------------------------------------------------------- commit 5ccab3c64a2e37903111755c6b99795c410bed0e Author: Herbert Valerio Riedel Date: Fri Nov 8 16:18:17 2013 +0100 Add `cabal install` step to Travis CI script Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 5ccab3c64a2e37903111755c6b99795c410bed0e .travis.yml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/.travis.yml b/.travis.yml index af63a5e..2bab2ff 100644 --- a/.travis.yml +++ b/.travis.yml @@ -21,3 +21,11 @@ script: - cabal-1.18 build - cabal-1.18 check - cabal-1.18 sdist + - export SRC_TGZ=$(cabal-1.18 info . | awk '{print $2 ".tar.gz";exit}') ; + cd dist/; + if [ -f "$SRC_TGZ" ]; then + cabal-1.18 install "$SRC_TGZ"; + else + echo "expected '$SRC_TGZ' not found"; + exit 1; + fi \ No newline at end of file From git at git.haskell.org Fri Nov 8 15:42:10 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Nov 2013 15:42:10 +0000 (UTC) Subject: [commit: packages/unix] master: Export `forkProcessWithUnmask` from `System.Posix.Process` (18a54fa) Message-ID: <20131108154211.0B4122406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/unix On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/18a54fa5ac929d07baaaa6fb9669632a10fd78d7/unix >--------------------------------------------------------------- commit 18a54fa5ac929d07baaaa6fb9669632a10fd78d7 Author: Herbert Valerio Riedel Date: Fri Nov 8 16:33:11 2013 +0100 Export `forkProcessWithUnmask` from `System.Posix.Process` This is a follow-up to 17192d89e6 which missed that export. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 18a54fa5ac929d07baaaa6fb9669632a10fd78d7 System/Posix/Process.hsc | 1 + 1 file changed, 1 insertion(+) diff --git a/System/Posix/Process.hsc b/System/Posix/Process.hsc index 992fd9a..2acb57e 100644 --- a/System/Posix/Process.hsc +++ b/System/Posix/Process.hsc @@ -22,6 +22,7 @@ module System.Posix.Process ( -- ** Forking and executing #ifdef __GLASGOW_HASKELL__ forkProcess, + forkProcessWithUnmask, #endif executeFile, From git at git.haskell.org Fri Nov 8 20:50:50 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Nov 2013 20:50:50 +0000 (UTC) Subject: [commit: ghc] master: SysTools.getTempDir: don't retry after catching a does-not-exist error (12369d6) Message-ID: <20131108205050.4F74D2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/12369d6065547215337fdec9587e5fdecd57a45e/ghc >--------------------------------------------------------------- commit 12369d6065547215337fdec9587e5fdecd57a45e Author: Patrick Palka Date: Fri Nov 8 09:41:24 2013 -0500 SysTools.getTempDir: don't retry after catching a does-not-exist error Previously, a command like $ ghc -tmpdir blah Foo where the directory blah/ does not exist, would loop forever: getTempDir would repeatedly try to create a temporary subdirectory inside blah/, catching the does-not-exist error thrown by createDirectory and retrying, in vain, with another suffix. Now instead the above compiler invocation will fail with an error: blah/ghc25781_0: createDirectory: does not exist (No such file or directory) >--------------------------------------------------------------- 12369d6065547215337fdec9587e5fdecd57a45e compiler/main/SysTools.lhs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 0db5e06..46f8a86 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -910,7 +910,7 @@ getTempDir dflags = do Just dir -> do removeDirectory our_dir return dir - `catchIO` \e -> if isAlreadyExistsError e || isDoesNotExistError e + `catchIO` \e -> if isAlreadyExistsError e then mkTempDir prefix else ioError e addFilesToClean :: DynFlags -> [FilePath] -> IO () From git at git.haskell.org Fri Nov 8 21:14:10 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Nov 2013 21:14:10 +0000 (UTC) Subject: [commit: packages/array] master: Tweak Cabal description field and update bug-reports url (82abd74) Message-ID: <20131108211410.5794E2406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/array On branch : master Link : http://git.haskell.org/packages/array.git/commitdiff/82abd749a34df42f50041ddb12cd8b513e0ec713 >--------------------------------------------------------------- commit 82abd749a34df42f50041ddb12cd8b513e0ec713 Author: Herbert Valerio Riedel Date: Fri Nov 8 22:03:24 2013 +0100 Tweak Cabal description field and update bug-reports url This also realigns the top-level Cabal fields. Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 82abd749a34df42f50041ddb12cd8b513e0ec713 array.cabal | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/array.cabal b/array.cabal index e037dc6..68e826e 100644 --- a/array.cabal +++ b/array.cabal @@ -1,19 +1,21 @@ -name: array -version: 0.5.0.0 +name: array +version: 0.5.0.0 -- GHC 7.6.1 released with 0.4.0.1 -license: BSD3 -license-file: LICENSE +license: BSD3 +license-file: LICENSE maintainer: libraries at haskell.org -bug-reports: http://ghc.haskell.org/trac/ghc/newticket?component=libraries%20%28other%29 -synopsis: Mutable and immutable arrays -category: Data Structures -description: - This package defines the classes @IArray@ of immutable arrays and - @MArray@ of arrays mutable within appropriate monads, as well as - some instances of these classes. +bug-reports: http://ghc.haskell.org/trac/ghc/newticket?component=libraries%20%28other%29&keywords=array +synopsis: Mutable and immutable arrays +category: Data Structures +build-type: Simple cabal-version: >=1.10 -build-type: Simple -tested-with: GHC==7.6.3, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1 +tested-with: GHC==7.6.3, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1 +description: + In addition to providing the "Data.Array" module + , + this package also defines the classes 'IArray' of + immutable arrays and 'MArray' of arrays mutable within appropriate + monads, as well as some instances of these classes. extra-source-files: changelog From git at git.haskell.org Fri Nov 8 21:14:12 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Nov 2013 21:14:12 +0000 (UTC) Subject: [commit: packages/array] master: Untabify changelog and bump release date for 0.5.0.0 (26ff047) Message-ID: <20131108211412.6A6D12406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/array On branch : master Link : http://git.haskell.org/packages/array.git/commitdiff/26ff04744117b0ad8233a1a2b5635fa1277b88d9 >--------------------------------------------------------------- commit 26ff04744117b0ad8233a1a2b5635fa1277b88d9 Author: Herbert Valerio Riedel Date: Fri Nov 8 22:04:46 2013 +0100 Untabify changelog and bump release date for 0.5.0.0 Signed-off-by: Herbert Valerio Riedel >--------------------------------------------------------------- 26ff04744117b0ad8233a1a2b5635fa1277b88d9 changelog | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/changelog b/changelog index 157357c..6654c9f 100644 --- a/changelog +++ b/changelog @@ -1,23 +1,23 @@ -*-change-log-*- -0.5.0.0 Oct 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.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 + * 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 + * 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 Mon Nov 11 21:27:28 2013 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Nov 2013 21:27:28 +0000 (UTC) Subject: [commit: haddock] master: Update HTML tests (e27f116) Message-ID: <20131111212728.4C5862406B@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haddock On branch : master Link : http://git.haskell.org/haddock.git/commitdiff/e27f11697ccaa31ee43383207da9b710d10d278a >--------------------------------------------------------------- commit e27f11697ccaa31ee43383207da9b710d10d278a Author: Simon Hengel Date: Sat Nov 9 00:15:13 2013 +0100 Update HTML tests >--------------------------------------------------------------- e27f11697ccaa31ee43383207da9b710d10d278a .../ref/{Hyperlinks.html => Ticket253_1.html} | 20 +++--- html-test/ref/{Ticket75.html => Ticket253_2.html} | 64 +++++++++----------- .../ref/{mini_Bug4.html => mini_Ticket253_1.html} | 4 +- .../{mini_Ticket75.html => mini_Ticket253_2.html} | 20 +++--- 4 files changed, 54 insertions(+), 54 deletions(-) diff --git a/html-test/ref/Hyperlinks.html b/html-test/ref/Ticket253_1.html similarity index 86% copy from html-test/ref/Hyperlinks.html copy to html-test/ref/Ticket253_1.html index 6224c9b..129096c 100644 --- a/html-test/ref/Hyperlinks.html +++ b/html-test/ref/Ticket253_1.html @@ -3,13 +3,13 @@ >HyperlinksTicket253_1

Hyperlinks

Ticket253_1

A plain URL: http://example.com/ + >See bar.

A URL with a label: some linkAlso see Baz

Ticket75Ticket253_2

Ticket75

Ticket253_2

Synopsis

Documentation

bar :: Int

Comment +

data a :- b

Baz

Constructors

QBaz 

f :: Int

A reference to :- -