From git at git.haskell.org Wed Aug 1 00:20:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 1 Aug 2018 00:20:59 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix some casts. (06c29dd) Message-ID: <20180801002059.876223A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/06c29ddc113e5225ebc0aa37a81d9d1cf0b7f15a/ghc >--------------------------------------------------------------- commit 06c29ddc113e5225ebc0aa37a81d9d1cf0b7f15a Author: Ben Gamari Date: Tue Jul 31 16:44:12 2018 -0400 Fix some casts. This fixes #15346, and is a team effort between Ryan Scott and myself (mostly Ryan). We discovered two errors related to FC's "push" rules, one in the TPush rule (as implemented in pushCoTyArg) and one in KPush rule (it shows up in liftCoSubstVarBndr). The solution: do what the paper says, instead of whatever random thoughts popped into my head as I was actually implementing. Note that this is a backport of the fix merged to master, af624071fa063158d6e963e171280676f9c0a0b0. Also fixes #15419, which is actually the same underlying problem. Test case: dependent/should_compile/T{15346,15419}. >--------------------------------------------------------------- 06c29ddc113e5225ebc0aa37a81d9d1cf0b7f15a compiler/coreSyn/CoreOpt.hs | 6 +++--- compiler/types/Coercion.hs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 0353ab6..5e37fee 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -979,7 +979,7 @@ pushCoTyArg co ty | isForAllTy tyL = ASSERT2( isForAllTy tyR, ppr co $$ ppr ty ) - Just (ty `mkCastTy` mkSymCo co1, MCo co2) + Just (ty `mkCastTy` co1, MCo co2) | otherwise = Nothing @@ -989,8 +989,8 @@ pushCoTyArg co ty -- tyL = forall (a1 :: k1). ty1 -- tyR = forall (a2 :: k2). ty2 - co1 = mkNthCo Nominal 0 co - -- co1 :: k1 ~N k2 + co1 = mkSymCo (mkNthCo Nominal 0 co) + -- co1 :: k2 ~N k1 -- Note that NthCo can extract a Nominal equality between the -- kinds of the types related by a coercion between forall-types. -- See the NthCo case in CoreLint. diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 4111516..651e5bf 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1732,7 +1732,7 @@ liftCoSubstVarBndrUsing fun lc@(LC subst cenv) old_var Pair k1 _ = coercionKind eta new_var = uniqAway (getTCvInScope subst) (setVarType old_var k1) - lifted = Refl Nominal (TyVarTy new_var) + lifted = mkNomReflCo (TyVarTy new_var) `mkCoherenceRightCo` eta new_cenv = extendVarEnv cenv old_var lifted -- | Is a var in the domain of a lifting context? From git at git.haskell.org Wed Aug 1 00:21:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 1 Aug 2018 00:21:12 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: testsuite: Add test for #15346 (f579162) Message-ID: <20180801002112.743FD3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/f579162afbacc21a264d0fe7a117bc9c241220bb/ghc >--------------------------------------------------------------- commit f579162afbacc21a264d0fe7a117bc9c241220bb Author: Richard Eisenberg Date: Thu Jul 19 00:16:13 2018 -0400 testsuite: Add test for #15346 Test case: dependent/should_compile/T{15346,15419}. >--------------------------------------------------------------- f579162afbacc21a264d0fe7a117bc9c241220bb testsuite/tests/dependent/should_compile/T15346.hs | 31 ++++++++++++ testsuite/tests/dependent/should_compile/T15419.hs | 55 ++++++++++++++++++++++ testsuite/tests/dependent/should_compile/all.T | 2 + 3 files changed, 88 insertions(+) diff --git a/testsuite/tests/dependent/should_compile/T15346.hs b/testsuite/tests/dependent/should_compile/T15346.hs new file mode 100644 index 0000000..3d8d49b --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T15346.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeApplications #-} +module T15346 where + +import Data.Kind +import Data.Proxy + +----- + +type family Rep (a :: Type) :: Type +type instance Rep () = () + +type family PFrom (x :: a) :: Rep a + +----- + +class SDecide k where + test :: forall (a :: k). Proxy a + +instance SDecide () where + test = undefined + +test1 :: forall (a :: k). SDecide (Rep k) => Proxy a +test1 = seq (test @_ @(PFrom a)) Proxy + +test2 :: forall (a :: ()). Proxy a +test2 = test1 diff --git a/testsuite/tests/dependent/should_compile/T15419.hs b/testsuite/tests/dependent/should_compile/T15419.hs new file mode 100644 index 0000000..68f20e5 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T15419.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE UndecidableInstances #-} +module T15419 where + +import Data.Kind + +data Prod a b +data Proxy p = Proxy + +----- + +data family Sing :: forall k. k -> Type +data instance Sing x = STuple + +----- + +type family Rep1 (f :: k -> Type) :: k -> Type +type instance Rep1 ((,) a) = Prod a + +type family From1 (f :: Type -> Type) a (z :: f a) :: Rep1 f a +type family To1 (f :: Type -> Type) a (z :: Rep1 f a) :: f a + +class Generic1 (f :: Type -> Type) where + sFrom1 :: forall (a :: Type) (z :: f a). Proxy z -> Sing (From1 f a z) + sTo1 :: forall (a :: Type) (r :: Rep1 f a). Proxy r -> Proxy (To1 f a r :: f a) + +instance Generic1 ((,) a) where + sFrom1 Proxy = undefined + sTo1 Proxy = undefined + +----- + +type family Fmap (g :: b) (x :: f a) :: f b +type instance Fmap (g :: b) (x :: (u, a)) = To1 ((,) u) b (Fmap g (From1 ((,) u) a x)) + +class PFunctor (f :: Type -> Type) where + sFmap :: forall a b (g :: b) (x :: f a). + Proxy g -> Sing x -> Proxy (Fmap g x) + +instance PFunctor (Prod a) where + sFmap _ STuple = undefined + +sFmap1 :: forall (f :: Type -> Type) (u :: Type) (b :: Type) (g :: b) (x :: f u). + (Generic1 f, + PFunctor (Rep1 f), + Fmap g x ~ To1 f b (Fmap g (From1 f u x)) ) + => Proxy g -> Proxy x -> Proxy (Fmap g x) +sFmap1 sg sx = sTo1 (sFmap sg (sFrom1 sx)) + +sFmap2 :: forall (p :: Type) (a :: Type) (b :: Type) (g :: b) (x :: (p, a)). + Proxy g -> Proxy x -> Proxy (Fmap g x) +sFmap2 = sFmap1 diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index 64782c0..4e096c1 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -51,3 +51,5 @@ test('T14845_compile', normal, compile, ['']) test('T14991', normal, compile, ['']) test('T15264', normal, compile, ['']) test('DkNameRes', normal, compile, ['']) +test('T15346', normal, compile, ['']) +test('T15419', normal, compile, ['']) From git at git.haskell.org Wed Aug 1 10:54:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 1 Aug 2018 10:54:40 +0000 (UTC) Subject: [commit: ghc] master: rts: Fix unused function (9bd4864) Message-ID: <20180801105440.592EA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9bd48643c917f8e38a0ddca0b6ac1777bbf66f99/ghc >--------------------------------------------------------------- commit 9bd48643c917f8e38a0ddca0b6ac1777bbf66f99 Author: Ben Gamari Date: Wed Aug 1 06:15:59 2018 -0400 rts: Fix unused function >--------------------------------------------------------------- 9bd48643c917f8e38a0ddca0b6ac1777bbf66f99 rts/posix/OSMem.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index 3c4455e..347c7c1 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -249,10 +249,11 @@ my_mmap (void *addr, W_ size, int operation) if (ret == MAP_FAILED) { return NULL; } +#endif /* defined(darwin_HOST_OS) */ + // Map in committed pages rather than take a fault for each chunk. // Also arrange to include them in core-dump files. post_mmap_madvise(operation, size, ret); -#endif /* defined(darwin_HOST_OS) */ return ret; } From git at git.haskell.org Wed Aug 1 10:54:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 1 Aug 2018 10:54:54 +0000 (UTC) Subject: [commit: ghc] master: Revert "Don't inline functions with RULES too early" (1df50a0) Message-ID: <20180801105454.EF0F63A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1df50a0f61f320428f2e6dd07b3c9ce49c4acd31/ghc >--------------------------------------------------------------- commit 1df50a0f61f320428f2e6dd07b3c9ce49c4acd31 Author: Ben Gamari Date: Wed Aug 1 06:42:19 2018 -0400 Revert "Don't inline functions with RULES too early" This commit causes significant performance regressions: ``` bytes allocated value is too high: Expected T9872d(normal) bytes allocated: 578498120 +/-5% Lower bound T9872d(normal) bytes allocated: 549573214 Upper bound T9872d(normal) bytes allocated: 607423026 Actual T9872d(normal) bytes allocated: 677179968 Deviation T9872d(normal) bytes allocated: 17.1 % bytes allocated value is too high: Expected T9872c(normal) bytes allocated: 3096670112 +/-5% Lower bound T9872c(normal) bytes allocated: 2941836606 Upper bound T9872c(normal) bytes allocated: 3251503618 Actual T9872c(normal) bytes allocated: 3601872536 Deviation T9872c(normal) bytes allocated: 16.3 % bytes allocated value is too high: Expected T9872b(normal) bytes allocated: 3730686224 +/-5% Lower bound T9872b(normal) bytes allocated: 3544151912 Upper bound T9872b(normal) bytes allocated: 3917220536 Actual T9872b(normal) bytes allocated: 4374298272 Deviation T9872b(normal) bytes allocated: 17.3 % bytes allocated value is too high: Expected T9872a(normal) bytes allocated: 2729927408 +/-5% Lower bound T9872a(normal) bytes allocated: 2593431037 Upper bound T9872a(normal) bytes allocated: 2866423779 Actual T9872a(normal) bytes allocated: 3225788896 Deviation T9872a(normal) bytes allocated: 18.2 % ``` It's not clear that this was intentional so I'm going to revert for now. This reverts commit 2110738b280543698407924a16ac92b6d804dc36. >--------------------------------------------------------------- 1df50a0f61f320428f2e6dd07b3c9ce49c4acd31 compiler/basicTypes/BasicTypes.hs | 10 ----- compiler/basicTypes/MkId.hs | 2 +- compiler/specialise/Rules.hs | 49 ++++------------------ compiler/stranal/WorkWrap.hs | 4 +- testsuite/tests/simplCore/should_compile/T15445.hs | 8 ---- .../tests/simplCore/should_compile/T15445.stderr | 13 ------ .../tests/simplCore/should_compile/T15445a.hs | 10 ----- testsuite/tests/simplCore/should_compile/all.T | 1 - 8 files changed, 10 insertions(+), 87 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 1df50a0f61f320428f2e6dd07b3c9ce49c4acd31 From git at git.haskell.org Wed Aug 1 18:42:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 1 Aug 2018 18:42:54 +0000 (UTC) Subject: [commit: ghc] master: Remove the type-checking knot. (f8618a9) Message-ID: <20180801184254.6AF6D3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f8618a9b15177ee8c84771b927cb3583c9cd8408/ghc >--------------------------------------------------------------- commit f8618a9b15177ee8c84771b927cb3583c9cd8408 Author: Richard Eisenberg Date: Tue Jul 17 00:12:34 2018 -0400 Remove the type-checking knot. Bug #15380 hangs because a knot-tied TyCon ended up in a kind. Looking at the code in tcInferApps, I'm amazed this hasn't happened before! I couldn't think of a good way to fix it (with dependent types, we can't really keep types out of kinds, after all), so I just went ahead and removed the knot. This was remarkably easy to do. In tcTyVar, when we find a TcTyCon, just use it. (Previously, we looked up the knot-tied TyCon and used that.) Then, during the final zonk, replace TcTyCons with the real, full-blooded TyCons in the global environment. It's all very easy. The new bit is explained in the existing Note [Type checking recursive type and class declarations] in TcTyClsDecls. Naturally, I removed various references to the knot and the zonkTcTypeInKnot (and related) functions. Now, we can print types during type checking with abandon! NB: There is a teensy error message regression with this patch, around the ordering of quantified type variables. This ordering problem is fixed (I believe) with the patch for #14880. The ordering affects only internal variables that cannot be instantiated with any kind of visible type application. There is also a teensy regression around the printing of types in TH splices. I think this is really a TH bug and will file separately. Test case: dependent/should_fail/T15380 >--------------------------------------------------------------- f8618a9b15177ee8c84771b927cb3583c9cd8408 compiler/basicTypes/DataCon.hs | 46 +++---- compiler/iface/BuildTyCl.hs | 14 ++- compiler/typecheck/FamInst.hs | 2 +- compiler/typecheck/TcEnv.hs | 11 +- compiler/typecheck/TcHsSyn.hs | 45 ++++--- compiler/typecheck/TcHsType.hs | 137 ++++++--------------- compiler/typecheck/TcMType.hs | 24 ++-- compiler/typecheck/TcTyClsDecls.hs | 64 +++++----- compiler/typecheck/TcType.hs | 24 ++-- compiler/types/TyCoRep.hs | 6 + compiler/types/TyCon.hs | 21 ++-- compiler/types/Type.hs | 25 ++-- .../tests/dependent/should_compile/T14066a.stderr | 2 +- testsuite/tests/dependent/should_fail/T15380.hs | 20 +++ .../tests/dependent/should_fail/T15380.stderr | 6 + testsuite/tests/dependent/should_fail/all.T | 2 +- testsuite/tests/ghci/scripts/T6018ghcifail.stderr | 2 +- testsuite/tests/polykinds/T7524.stderr | 2 +- testsuite/tests/th/T10267.stderr | 6 +- .../tests/typecheck/should_fail/T6018fail.stderr | 5 +- .../typecheck/should_fail/T6018failclosed.stderr | 4 +- 21 files changed, 232 insertions(+), 236 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 f8618a9b15177ee8c84771b927cb3583c9cd8408 From git at git.haskell.org Wed Aug 1 23:39:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 1 Aug 2018 23:39:19 +0000 (UTC) Subject: [commit: ghc] master: Plugin dependency information is stored separately (52065e9) Message-ID: <20180801233919.C31B73A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/52065e95c6df89d0048c6e3f35d6cc26ce8246f9/ghc >--------------------------------------------------------------- commit 52065e95c6df89d0048c6e3f35d6cc26ce8246f9 Author: Christiaan Baaij Date: Wed Aug 1 14:21:22 2018 -0400 Plugin dependency information is stored separately We need to store the used plugins so that we recompile a module when a plugin that it uses is recompiled. However, storing the `ModuleName`s of the plugins used by a module in the `dep_mods` field made the rest of GHC think that they belong in the HPT, causing at least the issues reported in #15234 We therefor store the `ModuleName`s of the plugins in a new field, `dep_plgins`, which is only used the the recompilation logic. Reviewers: mpickering, bgamari Reviewed By: mpickering, bgamari Subscribers: alpmestan, rwbarton, thomie, carter GHC Trac Issues: #15234 Differential Revision: https://phabricator.haskell.org/D4937 >--------------------------------------------------------------- 52065e95c6df89d0048c6e3f35d6cc26ce8246f9 compiler/deSugar/Desugar.hs | 5 +- compiler/deSugar/DsUsage.hs | 103 ++++++++++++++++++++- compiler/iface/MkIface.hs | 11 ++- compiler/main/DynamicLoading.hs | 11 ++- compiler/main/HscTypes.hs | 9 +- compiler/main/Plugins.hs | 4 +- testsuite/tests/plugins/Makefile | 7 ++ testsuite/tests/plugins/all.T | 6 ++ ...p-impure.stderr => plugin-recomp-change.stderr} | 2 +- testsuite/tests/plugins/plugin-recomp/Common.hs | 5 + testsuite/tests/plugins/plugin-recomp/Makefile | 3 +- 11 files changed, 145 insertions(+), 21 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 52065e95c6df89d0048c6e3f35d6cc26ce8246f9 From git at git.haskell.org Wed Aug 1 23:39:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 1 Aug 2018 23:39:34 +0000 (UTC) Subject: [commit: ghc] master: linker: Nub rpaths (b803c40) Message-ID: <20180801233934.60ED63A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b803c40608119469bdda330cb88860be2cbed25b/ghc >--------------------------------------------------------------- commit b803c40608119469bdda330cb88860be2cbed25b Author: Moritz Angermann Date: Wed Aug 1 14:25:03 2018 -0400 linker: Nub rpaths When compiling and linking files in `ghci`, we keep adding rpath arguments to the linker command invoation. If those are identical we should `nub` them out. Otherwise we not only risk overflowing the argument limit, but also embed huge amounts of identical rpath values into the dynamic library, eventually leading to the overflow of the load command size limit, due to the number of rpath entries alone. A further improvement could be to pass `-Xlinker -dead_strip_dylibs`; that however might be stipping too aggressively, and potentially lead to missing symbols? For the time being I suggest to only do the nubbing and if need be to provide -Wl,-dead_strip_dylibs when invoking ghci. Test Plan: ./validate Reviewers: bgamari, hvr Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15446 Differential Revision: https://phabricator.haskell.org/D5021 >--------------------------------------------------------------- b803c40608119469bdda330cb88860be2cbed25b compiler/ghci/Linker.hs | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 2af03dd..286cd0d 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -919,16 +919,14 @@ dynLoadObjs hsc_env pls objs = do -- can resolve dependencies when it loads this -- library. ldInputs = - concatMap - (\(lp, l) -> - [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp - , Option ("-l" ++ l) - ]) - (temp_sos pls) + concatMap (\l -> [ Option ("-l" ++ l) ]) + (nub $ snd <$> temp_sos pls) + ++ concatMap (\lp -> [ Option ("-L" ++ lp) + , Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ]) + (nub $ fst <$> temp_sos pls) ++ concatMap (\lp -> [ Option ("-L" ++ lp) From git at git.haskell.org Wed Aug 1 23:39:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 1 Aug 2018 23:39:50 +0000 (UTC) Subject: [commit: ghc] master: Fix #15450 by refactoring checkEmptyCase' (7f3cb50) Message-ID: <20180801233950.6E3D73A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7f3cb50dd311caefb536d582f1e3d1b33d6650f6/ghc >--------------------------------------------------------------- commit 7f3cb50dd311caefb536d582f1e3d1b33d6650f6 Author: Ryan Scott Date: Wed Aug 1 14:26:44 2018 -0400 Fix #15450 by refactoring checkEmptyCase' `checkEmptyCase'` (the code path for coverage-checking `EmptyCase` expressions) had a fair bit of code duplication from the code path for coverage-checking non-`EmptyCase` expressions, and to make things worse, it behaved subtly different in some respects (for instance, emitting different warnings under unsatisfiable constraints, as shown in #15450). This patch attempts to clean up both this discrepancy and the code duplication by doing the following: * Factor out a `pmInitialTmTyCs` function, which returns the initial set of term and type constraints to use when beginning coverage checking. If either set of constraints is unsatisfiable, we use an empty set in its place so that we can continue to emit as many warnings as possible. (The code path for non-`EmptyCase` expressions was doing this already, but not the code path for `EmptyCase` expressions, which is the root cause of #15450.) Along the way, I added a `Note` to explain why we do this. * Factor out a `pmIsSatisfiable` constraint which checks if a set of term and type constraints are satisfiable. This does not change any existing behavior; this is just for the sake of deduplicating code. Test Plan: make test TEST=T15450 Reviewers: simonpj, bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15450 Differential Revision: https://phabricator.haskell.org/D5017 >--------------------------------------------------------------- 7f3cb50dd311caefb536d582f1e3d1b33d6650f6 compiler/deSugar/Check.hs | 137 +++++++++++++++------ testsuite/tests/pmcheck/should_compile/T15450.hs | 9 ++ .../tests/pmcheck/should_compile/T15450.stderr | 11 ++ testsuite/tests/pmcheck/should_compile/all.T | 2 + 4 files changed, 119 insertions(+), 40 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 7f3cb50dd311caefb536d582f1e3d1b33d6650f6 From git at git.haskell.org Wed Aug 1 23:40:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 1 Aug 2018 23:40:07 +0000 (UTC) Subject: [commit: ghc] master: Fix #15415 and simplify tcWildCardBinders (120cc9f) Message-ID: <20180801234007.098073A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/120cc9f85ee1120072eb44c5bf37ac3055883605/ghc >--------------------------------------------------------------- commit 120cc9f85ee1120072eb44c5bf37ac3055883605 Author: Vladislav Zavialov Date: Wed Aug 1 14:28:16 2018 -0400 Fix #15415 and simplify tcWildCardBinders Test Plan: Validate Reviewers: goldfire, simonpj, bgamari Reviewed By: simonpj Subscribers: RyanGlScott, rwbarton, thomie, carter GHC Trac Issues: #15415 Differential Revision: https://phabricator.haskell.org/D5022 >--------------------------------------------------------------- 120cc9f85ee1120072eb44c5bf37ac3055883605 compiler/typecheck/TcHsType.hs | 32 ++++++---------------- compiler/typecheck/TcRnDriver.hs | 9 ++++-- .../should_run/GHCiWildcardKind.script | 1 + .../tests/partial-sigs/should_run/T15415.script | 17 ++++++++++++ .../tests/partial-sigs/should_run/T15415.stderr | 27 ++++++++++++++++++ .../tests/partial-sigs/should_run/T15415.stdout | 6 ++++ testsuite/tests/partial-sigs/should_run/all.T | 1 + testsuite/tests/unboxedsums/T12711.script | 2 +- 8 files changed, 67 insertions(+), 28 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 120cc9f85ee1120072eb44c5bf37ac3055883605 From git at git.haskell.org Thu Aug 2 00:36:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 00:36:28 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Enable two-step allocator on FreeBSD (79e1361) Message-ID: <20180802003628.B270C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/79e136104922aa4dcb555084731a890294cda106/ghc >--------------------------------------------------------------- commit 79e136104922aa4dcb555084731a890294cda106 Author: Ben Gamari Date: Mon Jul 30 18:01:40 2018 -0400 Enable two-step allocator on FreeBSD Simplify #ifdef nesting and use MAP_GUARD on FreeBSD and similar systems. This allows the two-step allocator to be used on FreeBSD, fixing #15348. (cherry picked from commit 123aeb916cba93018039e583d42408dae80a6dc9) >--------------------------------------------------------------- 79e136104922aa4dcb555084731a890294cda106 rts/posix/OSMem.c | 141 ++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 88 insertions(+), 53 deletions(-) diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index e63e798..5058f03 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -49,6 +49,29 @@ #include #endif +#ifndef MAP_FAILED +# define MAP_FAILED ((void *)-1) +#endif + +#if defined(hpux_HOST_OS) +# ifndef MAP_ANON +# define MAP_ANON MAP_ANONYMOUS +# endif +#endif + +#ifndef darwin_HOST_OS +# undef RESERVE_FLAGS +# if defined(MAP_GUARD) +# define RESERVE_FLAGS MAP_GUARD /* FreeBSD */ +# elif defined(MAP_NORESERVE) +# define RESERVE_FLAGS MAP_NORESERVE | MAP_ANON | MAP_PRIVATE; +# else +# if defined(USE_LARGE_ADDRESS_SPACE) +# error USE_LARGE_ADDRESS_SPACE needs MAP_NORESERVE or MAP_GUARD +# endif +# endif +#endif + static void *next_request = 0; void osMemInit(void) @@ -102,8 +125,10 @@ void osMemInit(void) The naming is chosen from the Win32 API (VirtualAlloc) which does the same thing and has done so forever, while support for this in Unix systems has only been added recently and is hidden in the posix portability mess. - It is confusing because to get the reserve behavior we need MAP_NORESERVE - (which tells the kernel not to allocate backing space), but heh... + The Linux manpage suggests that mmap must be passed MAP_NORESERVE in order + to get reservation-only behavior. It is confusing because to get the reserve + behavior we need MAP_NORESERVE (which tells the kernel not to allocate backing + space), but heh... */ enum { @@ -112,6 +137,44 @@ enum MEM_RESERVE_AND_COMMIT = MEM_RESERVE | MEM_COMMIT }; +#if defined(linux_HOST_OS) +static void * +linux_retry_mmap(int operation, W_ size, void *ret, void *addr, int prot, int flags) +{ + if (addr != 0 && (operation & MEM_RESERVE)) { + // Try again with no hint address. + // It's not clear that this can ever actually help, + // but since our alternative is to abort, we may as well try. + ret = mmap(0, size, prot, flags, -1, 0); + } + if (ret == MAP_FAILED && errno == EPERM) { + // Linux is not willing to give us any mapping, + // so treat this as an out-of-memory condition + // (really out of virtual address space). + errno = ENOMEM; + } + return ret; +} +#endif /* defined(linux_HOST_OS) */ + +static void +post_mmap_madvise(int operation, W_ size, void *ret) +{ +#if defined(MADV_WILLNEED) + if (operation & MEM_COMMIT) { + madvise(ret, size, MADV_WILLNEED); +# if defined(MADV_DODUMP) + madvise(ret, size, MADV_DODUMP); +# endif + } else { + madvise(ret, size, MADV_DONTNEED); +# if defined(MADV_DONTDUMP) + madvise(ret, size, MADV_DONTDUMP); +# endif + } +#endif +} + /* Returns NULL on failure; errno set */ static void * my_mmap (void *addr, W_ size, int operation) @@ -153,71 +216,43 @@ my_mmap (void *addr, W_ size, int operation) VM_PROT_READ|VM_PROT_WRITE); } -#else +#else /* defined(darwin_HOST_OS) */ int prot, flags; - if (operation & MEM_COMMIT) + if (operation & MEM_COMMIT) { prot = PROT_READ | PROT_WRITE; - else + } else { prot = PROT_NONE; - if (operation == MEM_RESERVE) -# if defined(MAP_NORESERVE) - flags = MAP_NORESERVE; + } + + if (operation == MEM_RESERVE) { +# if defined(RESERVE_FLAGS) + flags = RESERVE_FLAGS; # else -# if defined(USE_LARGE_ADDRESS_SPACE) -# error USE_LARGE_ADDRESS_SPACE needs MAP_NORESERVE -# endif errorBelch("my_mmap(,,MEM_RESERVE) not supported on this platform"); # endif - else if (operation == MEM_COMMIT) - flags = MAP_FIXED; - else - flags = 0; + } else if (operation == MEM_COMMIT) { + flags = MAP_FIXED | MAP_ANON | MAP_PRIVATE; + } else { + flags = MAP_ANON | MAP_PRIVATE; + } -#if defined(hpux_HOST_OS) - ret = mmap(addr, size, prot, flags | MAP_ANONYMOUS | MAP_PRIVATE, -1, 0); -#elif defined(linux_HOST_OS) - ret = mmap(addr, size, prot, flags | MAP_ANON | MAP_PRIVATE, -1, 0); - if (ret == (void *)-1 && errno == EPERM) { + ret = mmap(addr, size, prot, flags, -1, 0); +# if defined(linux_HOST_OS) + if (ret == MAP_FAILED && errno == EPERM) { // Linux may return EPERM if it tried to give us // a chunk of address space below mmap_min_addr, // See Trac #7500. - if (addr != 0 && (operation & MEM_RESERVE)) { - // Try again with no hint address. - // It's not clear that this can ever actually help, - // but since our alternative is to abort, we may as well try. - ret = mmap(0, size, prot, flags | MAP_ANON | MAP_PRIVATE, -1, 0); - } - if (ret == (void *)-1 && errno == EPERM) { - // Linux is not willing to give us any mapping, - // so treat this as an out-of-memory condition - // (really out of virtual address space). - errno = ENOMEM; - } + ret = linux_retry_mmap(operation, size, ret, addr, prot, flags); } - - if (ret != (void *)-1) { - if (operation & MEM_COMMIT) { - madvise(ret, size, MADV_WILLNEED); -#if defined(MADV_DODUMP) - madvise(ret, size, MADV_DODUMP); -#endif - } else { - madvise(ret, size, MADV_DONTNEED); -#if defined(MADV_DONTDUMP) - madvise(ret, size, MADV_DONTDUMP); -#endif - } - } - -#else - ret = mmap(addr, size, prot, flags | MAP_ANON | MAP_PRIVATE, -1, 0); -#endif -#endif - - if (ret == (void *)-1) { +# endif + if (ret == MAP_FAILED) { return NULL; } + // Map in committed pages rather than take a fault for each chunk. + // Also arrange to include them in core-dump files. + post_mmap_madvise(operation, size, ret); +#endif /* defined(darwin_HOST_OS) */ return ret; } From git at git.haskell.org Thu Aug 2 00:36:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 00:36:31 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix #15453: bug in ForAllCo case in opt_trans_rule (eb2b71c) Message-ID: <20180802003631.F244F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/eb2b71c55df329570361e78f2f0ecdfcf3fe5974/ghc >--------------------------------------------------------------- commit eb2b71c55df329570361e78f2f0ecdfcf3fe5974 Author: Ningning Xie Date: Sun Jul 29 13:15:33 2018 +0200 Fix #15453: bug in ForAllCo case in opt_trans_rule Summary: Given ``` co1 = \/ tv1 : eta1. r1 co2 = \/ tv2 : eta2. r2 ``` We would like to optimize `co1; co2` so we push transitivity inside forall. It should be ``` \/tv1 : (eta1;eta2). (r1; r2[tv2 |-> tv1 |> eta1]) ``` It is implemented in the ForAllCo case in opt_trans_rule in OptCoercion. However current implementation is not right: ``` r2' = substCoWithUnchecked [tv2] [TyVarTy tv1] r2 -- ill-kinded! ``` This patch corrects it to be ``` r2' = substCoWithUnchecked [tv2] [mkCastTy (TyVarTy tv1) eta1] r2 ``` Test Plan: validate Reviewers: bgamari, goldfire, RyanGlScott Reviewed By: RyanGlScott Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15453 Differential Revision: https://phabricator.haskell.org/D5018 (cherry picked from commit 11de4380c2f16f374c6e8fbacf8dce00376e7efb) >--------------------------------------------------------------- eb2b71c55df329570361e78f2f0ecdfcf3fe5974 compiler/types/OptCoercion.hs | 7 +++++- testsuite/tests/simplCore/should_compile/T15453.hs | 25 ++++++++++++++++++++++ testsuite/tests/simplCore/should_compile/all.T | 1 + 3 files changed, 32 insertions(+), 1 deletion(-) diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs index db4bc8c..213c0a7 100644 --- a/compiler/types/OptCoercion.hs +++ b/compiler/types/OptCoercion.hs @@ -594,11 +594,16 @@ opt_trans_rule is co1 co2 where push_trans tv1 eta1 r1 tv2 eta2 r2 + -- Given: + -- co1 = \/ tv1 : eta1. r1 + -- co2 = \/ tv2 : eta2. r2 + -- Wanted: + -- \/tv1 : (eta1;eta2). (r1; r2[tv2 |-> tv1 |> eta1]) = fireTransRule "EtaAllTy" co1 co2 $ mkForAllCo tv1 (opt_trans is eta1 eta2) (opt_trans is' r1 r2') where is' = is `extendInScopeSet` tv1 - r2' = substCoWithUnchecked [tv2] [TyVarTy tv1] r2 + r2' = substCoWithUnchecked [tv2] [mkCastTy (TyVarTy tv1) eta1] r2 -- Push transitivity inside axioms opt_trans_rule is co1 co2 diff --git a/testsuite/tests/simplCore/should_compile/T15453.hs b/testsuite/tests/simplCore/should_compile/T15453.hs new file mode 100644 index 0000000..a452bef --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15453.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module T15453 where + +import Data.Kind +import Data.Proxy +import Data.Type.Equality + +type family S :: Type where + S = T +type family T :: Type where + T = Int + +f :: (forall (x :: S). Proxy x) :~: (forall (x :: T). Proxy x) +f = Refl + +g :: (forall (x :: T). Proxy x) :~: (forall (x :: Int). Proxy x) +g = Refl + +h :: (forall (x :: S). Proxy x) :~: (forall (x :: Int). Proxy x) +h = f `trans` g diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 5ad7dba..fe9cb05 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -316,3 +316,4 @@ test('T15005', normal, compile, ['-O']) # we omit profiling because it affects the optimiser and makes the test fail test('T15056', [extra_files(['T15056a.hs']), omit_ways(['profasm'])], multimod_compile, ['T15056', '-O -v0 -ddump-rule-firings']) test('T15186', normal, multimod_compile, ['T15186', '-v0']) +test('T15453', normal, compile, ['-dcore-lint -O1']) From git at git.haskell.org Thu Aug 2 00:36:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 00:36:36 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix #15415 and simplify tcWildCardBinders (a97ead7) Message-ID: <20180802003636.4792F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/a97ead78b76bfd914adb7c5b331ee364fc6f1928/ghc >--------------------------------------------------------------- commit a97ead78b76bfd914adb7c5b331ee364fc6f1928 Author: Vladislav Zavialov Date: Wed Aug 1 14:28:16 2018 -0400 Fix #15415 and simplify tcWildCardBinders Test Plan: Validate Reviewers: goldfire, simonpj, bgamari Reviewed By: simonpj Subscribers: RyanGlScott, rwbarton, thomie, carter GHC Trac Issues: #15415 Differential Revision: https://phabricator.haskell.org/D5022 (cherry picked from commit 120cc9f85ee1120072eb44c5bf37ac3055883605) >--------------------------------------------------------------- a97ead78b76bfd914adb7c5b331ee364fc6f1928 compiler/typecheck/TcHsType.hs | 32 ++++++---------------- compiler/typecheck/TcRnDriver.hs | 9 ++++-- .../should_run/GHCiWildcardKind.script | 1 + .../tests/partial-sigs/should_run/T15415.script | 17 ++++++++++++ .../tests/partial-sigs/should_run/T15415.stderr | 27 ++++++++++++++++++ .../tests/partial-sigs/should_run/T15415.stdout | 6 ++++ testsuite/tests/partial-sigs/should_run/all.T | 1 + testsuite/tests/unboxedsums/T12711.script | 2 +- 8 files changed, 67 insertions(+), 28 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a97ead78b76bfd914adb7c5b331ee364fc6f1928 From git at git.haskell.org Thu Aug 2 00:36:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 00:36:39 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: linker: Nub rpaths (c9be859) Message-ID: <20180802003639.143493A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/c9be85961829845b2442fba74dc61c3e8cbad09f/ghc >--------------------------------------------------------------- commit c9be85961829845b2442fba74dc61c3e8cbad09f Author: Moritz Angermann Date: Wed Aug 1 14:25:03 2018 -0400 linker: Nub rpaths When compiling and linking files in `ghci`, we keep adding rpath arguments to the linker command invoation. If those are identical we should `nub` them out. Otherwise we not only risk overflowing the argument limit, but also embed huge amounts of identical rpath values into the dynamic library, eventually leading to the overflow of the load command size limit, due to the number of rpath entries alone. A further improvement could be to pass `-Xlinker -dead_strip_dylibs`; that however might be stipping too aggressively, and potentially lead to missing symbols? For the time being I suggest to only do the nubbing and if need be to provide -Wl,-dead_strip_dylibs when invoking ghci. Test Plan: ./validate Reviewers: bgamari, hvr Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15446 Differential Revision: https://phabricator.haskell.org/D5021 (cherry picked from commit b803c40608119469bdda330cb88860be2cbed25b) >--------------------------------------------------------------- c9be85961829845b2442fba74dc61c3e8cbad09f compiler/ghci/Linker.hs | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 8d0338a..3b030be 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -918,16 +918,14 @@ dynLoadObjs hsc_env pls objs = do -- can resolve dependencies when it loads this -- library. ldInputs = - concatMap - (\(lp, l) -> - [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp - , Option ("-l" ++ l) - ]) - (temp_sos pls) + concatMap (\l -> [ Option ("-l" ++ l) ]) + (nub $ snd <$> temp_sos pls) + ++ concatMap (\lp -> [ Option ("-L" ++ lp) + , Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ]) + (nub $ fst <$> temp_sos pls) ++ concatMap (\lp -> [ Option ("-L" ++ lp) From git at git.haskell.org Thu Aug 2 00:36:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 00:36:42 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix #15450 by refactoring checkEmptyCase' (ebd773a) Message-ID: <20180802003642.F25D03A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/ebd773a09be134157880eaa1099f4b5d30a67aac/ghc >--------------------------------------------------------------- commit ebd773a09be134157880eaa1099f4b5d30a67aac Author: Ryan Scott Date: Wed Aug 1 14:26:44 2018 -0400 Fix #15450 by refactoring checkEmptyCase' `checkEmptyCase'` (the code path for coverage-checking `EmptyCase` expressions) had a fair bit of code duplication from the code path for coverage-checking non-`EmptyCase` expressions, and to make things worse, it behaved subtly different in some respects (for instance, emitting different warnings under unsatisfiable constraints, as shown in #15450). This patch attempts to clean up both this discrepancy and the code duplication by doing the following: * Factor out a `pmInitialTmTyCs` function, which returns the initial set of term and type constraints to use when beginning coverage checking. If either set of constraints is unsatisfiable, we use an empty set in its place so that we can continue to emit as many warnings as possible. (The code path for non-`EmptyCase` expressions was doing this already, but not the code path for `EmptyCase` expressions, which is the root cause of #15450.) Along the way, I added a `Note` to explain why we do this. * Factor out a `pmIsSatisfiable` constraint which checks if a set of term and type constraints are satisfiable. This does not change any existing behavior; this is just for the sake of deduplicating code. Test Plan: make test TEST=T15450 Reviewers: simonpj, bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15450 Differential Revision: https://phabricator.haskell.org/D5017 (cherry picked from commit 7f3cb50dd311caefb536d582f1e3d1b33d6650f6) >--------------------------------------------------------------- ebd773a09be134157880eaa1099f4b5d30a67aac compiler/deSugar/Check.hs | 137 +++++++++++++++------ testsuite/tests/pmcheck/should_compile/T15450.hs | 9 ++ .../tests/pmcheck/should_compile/T15450.stderr | 11 ++ testsuite/tests/pmcheck/should_compile/all.T | 2 + 4 files changed, 119 insertions(+), 40 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 ebd773a09be134157880eaa1099f4b5d30a67aac From git at git.haskell.org Thu Aug 2 00:36:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 00:36:45 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump Cabal submodule to 2.4 (ff086cc) Message-ID: <20180802003645.C1AEA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/ff086cc10da176ca16a349969f0b8a049cc691ef/ghc >--------------------------------------------------------------- commit ff086cc10da176ca16a349969f0b8a049cc691ef Author: Ben Gamari Date: Wed Aug 1 19:42:53 2018 -0400 Bump Cabal submodule to 2.4 >--------------------------------------------------------------- ff086cc10da176ca16a349969f0b8a049cc691ef libraries/Cabal | 2 +- testsuite/tests/driver/T4437.hs | 4 +--- utils/check-api-annotations/check-api-annotations.cabal | 2 +- utils/check-ppr/check-ppr.cabal | 2 +- utils/ghc-cabal/ghc-cabal.cabal | 2 +- utils/ghctags/ghctags.cabal | 2 +- 6 files changed, 6 insertions(+), 8 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 8fbacca..8828258 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 8fbacca029f3ad764576aefb610a0408c4b6aaad +Subproject commit 8828258813f726150cd748433a8ad0df3310c6bc diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs index a75990e..2818851 100644 --- a/testsuite/tests/driver/T4437.hs +++ b/testsuite/tests/driver/T4437.hs @@ -41,9 +41,7 @@ expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRuleTransitional", "DerivingVia", "EmptyDataDeriving", - "GeneralisedNewtypeDeriving", - "StarIsType", -- FIXME: add StarIsType to cabal - "QuantifiedConstraints"] + "GeneralisedNewtypeDeriving"] expectedCabalOnlyExtensions :: [String] expectedCabalOnlyExtensions = ["Generics", diff --git a/utils/check-api-annotations/check-api-annotations.cabal b/utils/check-api-annotations/check-api-annotations.cabal index 3a014a6..5007625 100644 --- a/utils/check-api-annotations/check-api-annotations.cabal +++ b/utils/check-api-annotations/check-api-annotations.cabal @@ -24,6 +24,6 @@ Executable check-api-annotations Build-Depends: base >= 4 && < 5, containers, - Cabal >= 2.3 && < 2.4, + Cabal >= 2.4 && < 2.5, directory, ghc diff --git a/utils/check-ppr/check-ppr.cabal b/utils/check-ppr/check-ppr.cabal index e0d8b9d..2da21d7 100644 --- a/utils/check-ppr/check-ppr.cabal +++ b/utils/check-ppr/check-ppr.cabal @@ -25,7 +25,7 @@ Executable check-ppr Build-Depends: base >= 4 && < 5, bytestring, containers, - Cabal >= 2.3 && < 2.4, + Cabal >= 2.4 && < 2.5, directory, filepath, ghc diff --git a/utils/ghc-cabal/ghc-cabal.cabal b/utils/ghc-cabal/ghc-cabal.cabal index cc0d98d..baa7a17 100644 --- a/utils/ghc-cabal/ghc-cabal.cabal +++ b/utils/ghc-cabal/ghc-cabal.cabal @@ -21,7 +21,7 @@ Executable ghc-cabal Build-Depends: base >= 3 && < 5, bytestring >= 0.10 && < 0.11, - Cabal >= 2.3 && < 2.4, + Cabal >= 2.4 && < 2.5, directory >= 1.1 && < 1.4, filepath >= 1.2 && < 1.5 diff --git a/utils/ghctags/ghctags.cabal b/utils/ghctags/ghctags.cabal index 391eb7a..f74bc4f 100644 --- a/utils/ghctags/ghctags.cabal +++ b/utils/ghctags/ghctags.cabal @@ -18,6 +18,6 @@ Executable ghctags Build-Depends: base >= 4 && < 5, containers, - Cabal >= 2.3 && <2.4, + Cabal >= 2.4 && <2.5, ghc From git at git.haskell.org Thu Aug 2 02:42:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 02:42:37 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Remove the type-checking knot. (59f3858) Message-ID: <20180802024237.768C33A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/59f38587d44efd00b10a6d98f6a7a1b22e87f13a/ghc >--------------------------------------------------------------- commit 59f38587d44efd00b10a6d98f6a7a1b22e87f13a Author: Richard Eisenberg Date: Tue Jul 17 00:12:34 2018 -0400 Remove the type-checking knot. Bug #15380 hangs because a knot-tied TyCon ended up in a kind. Looking at the code in tcInferApps, I'm amazed this hasn't happened before! I couldn't think of a good way to fix it (with dependent types, we can't really keep types out of kinds, after all), so I just went ahead and removed the knot. This was remarkably easy to do. In tcTyVar, when we find a TcTyCon, just use it. (Previously, we looked up the knot-tied TyCon and used that.) Then, during the final zonk, replace TcTyCons with the real, full-blooded TyCons in the global environment. It's all very easy. The new bit is explained in the existing Note [Type checking recursive type and class declarations] in TcTyClsDecls. Naturally, I removed various references to the knot and the zonkTcTypeInKnot (and related) functions. Now, we can print types during type checking with abandon! NB: There is a teensy error message regression with this patch, around the ordering of quantified type variables. This ordering problem is fixed (I believe) with the patch for #14880. The ordering affects only internal variables that cannot be instantiated with any kind of visible type application. There is also a teensy regression around the printing of types in TH splices. I think this is really a TH bug and will file separately. Test case: dependent/should_fail/T15380 (cherry picked from commit f8618a9b15177ee8c84771b927cb3583c9cd8408) >--------------------------------------------------------------- 59f38587d44efd00b10a6d98f6a7a1b22e87f13a compiler/basicTypes/DataCon.hs | 46 +++---- compiler/iface/BuildTyCl.hs | 14 +- compiler/typecheck/FamInst.hs | 2 +- compiler/typecheck/TcEnv.hs | 11 +- compiler/typecheck/TcHsSyn.hs | 45 ++++--- compiler/typecheck/TcHsType.hs | 146 ++++++--------------- compiler/typecheck/TcMType.hs | 24 +--- compiler/typecheck/TcTyClsDecls.hs | 64 +++++---- compiler/typecheck/TcType.hs | 24 +--- compiler/types/TyCoRep.hs | 6 + compiler/types/TyCon.hs | 21 ++- compiler/types/Type.hs | 25 +++- .../tests/dependent/should_compile/T14066a.stderr | 2 +- testsuite/tests/dependent/should_fail/T15380.hs | 20 +++ .../tests/dependent/should_fail/T15380.stderr | 6 + testsuite/tests/dependent/should_fail/all.T | 2 +- testsuite/tests/ghci/scripts/T6018ghcifail.stderr | 2 +- testsuite/tests/polykinds/T7524.stderr | 2 +- testsuite/tests/th/T10267.stderr | 6 +- .../tests/typecheck/should_fail/T6018fail.stderr | 5 +- .../typecheck/should_fail/T6018failclosed.stderr | 4 +- 21 files changed, 240 insertions(+), 237 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 59f38587d44efd00b10a6d98f6a7a1b22e87f13a From git at git.haskell.org Thu Aug 2 02:42:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 02:42:40 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Small refactor in desugar of pattern matching (42c51e2) Message-ID: <20180802024240.4C5573A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/42c51e2f39ce829fa4a380b604c9a7f5ea71d28d/ghc >--------------------------------------------------------------- commit 42c51e2f39ce829fa4a380b604c9a7f5ea71d28d Author: Simon Peyton Jones Date: Fri Jul 27 09:17:20 2018 +0100 Small refactor in desugar of pattern matching In reviewing Phab:D4968 for Trac #15385 I saw a small but simple refactor to avoid unnecessary work in the desugarer. This patch just arranges to call matchSinglePatVar v ... rather than matchSinglePat (Var v) ... The more specialised function already existed, as match_single_pat_var I also added more comments about decideBangHood (cherry picked from commit 45cfe6514afb47c26883687e25ff7eb1e40c5a52) >--------------------------------------------------------------- 42c51e2f39ce829fa4a380b604c9a7f5ea71d28d compiler/deSugar/DsExpr.hs | 2 +- compiler/deSugar/DsListComp.hs | 2 +- compiler/deSugar/DsMonad.hs | 3 +++ compiler/deSugar/DsUtils.hs | 46 +++++++++++++++++++++++++++++++++--------- compiler/deSugar/Match.hs | 21 ++++++++++--------- 5 files changed, 54 insertions(+), 20 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 42c51e2f39ce829fa4a380b604c9a7f5ea71d28d From git at git.haskell.org Thu Aug 2 02:42:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 02:42:43 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix #15385 by using addDictsDs in matchGuards (e649085) Message-ID: <20180802024243.E1E3E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/e649085bb35628e10b08a9a1ef27095ad0510b40/ghc >--------------------------------------------------------------- commit e649085bb35628e10b08a9a1ef27095ad0510b40 Author: Ryan Scott Date: Mon Jul 30 08:47:39 2018 -0400 Fix #15385 by using addDictsDs in matchGuards When coverage checking pattern-matches, we rely on the call sites in the desugarer to populate the local dictionaries and term evidence in scope using `addDictsDs` and `addTmCsDs`. But it turns out that only the call site for desugaring `case` expressions was actually doing this properly. In another part of the desugarer, `matchGuards` (which handles pattern guards), it did not update the local dictionaries in scope at all, leading to #15385. Fixing this is relatively straightforward: just augment the `BindStmt` case of `matchGuards` to use `addDictsDs` and `addTmCsDs`. Accomplishing this took a little bit of import/export tweaking: * We now need to export `collectEvVarsPat` from `HsPat.hs`. * To avoid an import cycle with `Check.hs`, I moved `isTrueLHsExpr` from `DsGRHSs.hs` to `DsUtils.hs`, which resides lower on the import chain. Test Plan: make test TEST=T15385 Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15385 Differential Revision: https://phabricator.haskell.org/D4968 (cherry picked from commit 9d388eb83e797fd28e14868009c4786f3f1a8aa6) >--------------------------------------------------------------- e649085bb35628e10b08a9a1ef27095ad0510b40 compiler/deSugar/Check.hs | 2 +- compiler/deSugar/DsGRHSs.hs | 49 +++++++----------------- compiler/deSugar/DsUtils.hs | 32 +++++++++++++++- compiler/deSugar/Match.hs-boot | 4 +- compiler/hsSyn/HsPat.hs | 2 +- testsuite/tests/pmcheck/should_compile/T15385.hs | 21 ++++++++++ testsuite/tests/pmcheck/should_compile/all.T | 2 + 7 files changed, 72 insertions(+), 40 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 e649085bb35628e10b08a9a1ef27095ad0510b40 From git at git.haskell.org Thu Aug 2 02:42:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 02:42:47 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Treat isConstraintKind more consistently (6a7cb80) Message-ID: <20180802024247.884B53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/6a7cb80648253ebcc84be5f11e2cc78eae085aa8/ghc >--------------------------------------------------------------- commit 6a7cb80648253ebcc84be5f11e2cc78eae085aa8 Author: Simon Peyton Jones Date: Wed Jul 25 11:35:43 2018 +0100 Treat isConstraintKind more consistently It turned out that we were not being consistent about our use of isConstraintKind. It's delicate, because the typechecker treats Constraint and Type as /distinct/, whereas they are the /same/ in the rest of the compiler (Trac #11715). And had it wrong, which led to Trac #15412. This patch does the following: * Rename isConstraintKind to tcIsConstraintKind returnsConstraintKind to tcReturnsConstraintKind to emphasise that they use the 'tcView' view of types. * Move these functions, and some related ones (tcIsLiftedTypeKind), from Kind.hs, to group together in Type.hs, alongside isPredTy. It feels very unsatisfactory that these 'tcX' functions live in Type, but it happens because isPredTy is called later in the compiler too. But it's a consequence of the 'Constraint vs Type' dilemma. (cherry picked from commit c5d31df70b16dc346b5860077c8bbe585ddb7a78) >--------------------------------------------------------------- 6a7cb80648253ebcc84be5f11e2cc78eae085aa8 compiler/typecheck/TcErrors.hs | 6 +- compiler/typecheck/TcHsType.hs | 9 +- compiler/typecheck/TcInstDcls.hs | 1 - compiler/typecheck/TcInteract.hs | 3 +- compiler/typecheck/TcMType.hs | 5 +- compiler/typecheck/TcSplice.hs | 1 - compiler/typecheck/TcTyClsDecls.hs | 4 +- compiler/typecheck/TcType.hs | 69 ++++++------ compiler/typecheck/TcValidity.hs | 8 +- compiler/types/Kind.hs | 31 +---- compiler/types/TyCoRep.hs | 22 +--- compiler/types/Type.hs | 125 ++++++++++++++------- compiler/types/Unify.hs | 1 - testsuite/tests/rename/should_fail/T5513.stderr | 2 +- testsuite/tests/typecheck/should_compile/T15412.hs | 17 +++ testsuite/tests/typecheck/should_compile/all.T | 1 + 16 files changed, 156 insertions(+), 149 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6a7cb80648253ebcc84be5f11e2cc78eae085aa8 From git at git.haskell.org Thu Aug 2 02:42:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 02:42:51 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Plugin dependency information is stored separately (e86db0d) Message-ID: <20180802024251.25A203A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/e86db0d59dc2f9d8f4140c6b3052762a1ae82428/ghc >--------------------------------------------------------------- commit e86db0d59dc2f9d8f4140c6b3052762a1ae82428 Author: Christiaan Baaij Date: Wed Aug 1 14:21:22 2018 -0400 Plugin dependency information is stored separately We need to store the used plugins so that we recompile a module when a plugin that it uses is recompiled. However, storing the `ModuleName`s of the plugins used by a module in the `dep_mods` field made the rest of GHC think that they belong in the HPT, causing at least the issues reported in #15234 We therefor store the `ModuleName`s of the plugins in a new field, `dep_plgins`, which is only used the the recompilation logic. Reviewers: mpickering, bgamari Reviewed By: mpickering, bgamari Subscribers: alpmestan, rwbarton, thomie, carter GHC Trac Issues: #15234 Differential Revision: https://phabricator.haskell.org/D4937 (cherry picked from commit 52065e95c6df89d0048c6e3f35d6cc26ce8246f9) >--------------------------------------------------------------- e86db0d59dc2f9d8f4140c6b3052762a1ae82428 compiler/deSugar/Desugar.hs | 5 +- compiler/deSugar/DsUsage.hs | 103 ++++++++++++++++++++- compiler/iface/MkIface.hs | 11 ++- compiler/main/DynamicLoading.hs | 11 ++- compiler/main/HscTypes.hs | 9 +- compiler/main/Plugins.hs | 4 +- testsuite/tests/plugins/Makefile | 7 ++ testsuite/tests/plugins/all.T | 6 ++ ...p-impure.stderr => plugin-recomp-change.stderr} | 2 +- testsuite/tests/plugins/plugin-recomp/Common.hs | 5 + testsuite/tests/plugins/plugin-recomp/Makefile | 3 +- 11 files changed, 145 insertions(+), 21 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e86db0d59dc2f9d8f4140c6b3052762a1ae82428 From git at git.haskell.org Thu Aug 2 09:03:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 09:03:43 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T14880-baseline' created Message-ID: <20180802090343.6D18B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T14880-baseline Referencing: 4887050fa8073b4ed5c1980b5b41cb0f91689b54 From git at git.haskell.org Thu Aug 2 09:03:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 09:03:46 +0000 (UTC) Subject: [commit: ghc] wip/T14880-baseline: Upgrade haddock submodule to avoid bug (4887050) Message-ID: <20180802090346.422E53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880-baseline Link : http://ghc.haskell.org/trac/ghc/changeset/4887050fa8073b4ed5c1980b5b41cb0f91689b54/ghc >--------------------------------------------------------------- commit 4887050fa8073b4ed5c1980b5b41cb0f91689b54 Author: Tobias Dammers Date: Wed Aug 1 16:59:44 2018 +0200 Upgrade haddock submodule to avoid bug >--------------------------------------------------------------- 4887050fa8073b4ed5c1980b5b41cb0f91689b54 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 0d903e5..0731855 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 0d903e5e7ea877cbf6e8a7a84c9c8b6ef8c78ef6 +Subproject commit 0731855bd1c05379a91a3d761458b05c2d75b6d9 From git at git.haskell.org Thu Aug 2 09:05:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 09:05:20 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T14880-just-tvs' created Message-ID: <20180802090520.E0D713A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T14880-just-tvs Referencing: 8b567b3c94eb61adde1a72be11225d68ae649f13 From git at git.haskell.org Thu Aug 2 09:05:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 09:05:23 +0000 (UTC) Subject: [commit: ghc] wip/T14880-just-tvs: Rewrite tyCoVarsOfType in terms of TypeSet (0ac162f) Message-ID: <20180802090523.B60D03A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880-just-tvs Link : http://ghc.haskell.org/trac/ghc/changeset/0ac162f81646b9db3ae99f9868e10c10bf0fe9bc/ghc >--------------------------------------------------------------- commit 0ac162f81646b9db3ae99f9868e10c10bf0fe9bc Author: Tobias Dammers Date: Tue Jul 31 22:32:34 2018 +0200 Rewrite tyCoVarsOfType in terms of TypeSet >--------------------------------------------------------------- 0ac162f81646b9db3ae99f9868e10c10bf0fe9bc compiler/types/TyCoRep.hs | 15 ++++++++++++++- utils/haddock | 2 +- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index ec4607a..2fdf172 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -1484,7 +1484,15 @@ so, so it's easiest to do it here. -- synonym. tyCoVarsOfType :: Type -> TyCoVarSet -- See Note [Free variables of types] -tyCoVarsOfType ty = fvVarSet $ tyCoFVsOfType ty +-- tyCoVarsOfType ty = fvVarSet $ tyCoFVsOfType ty +tyCoVarsOfType (TyVarTy v) = extendVarSet (tyCoVarsOfType (tyVarKind v)) v +tyCoVarsOfType (TyConApp _ tys) = tyCoVarsOfTypes tys +tyCoVarsOfType (LitTy {}) = emptyVarSet +tyCoVarsOfType (AppTy fun arg) = (tyCoVarsOfType fun `unionVarSet` tyCoVarsOfType arg) +tyCoVarsOfType (FunTy arg res) = (tyCoVarsOfType arg `unionVarSet` tyCoVarsOfType res) +tyCoVarsOfType (ForAllTy bndr ty) = tyCoVarSetsBndr bndr (tyCoVarsOfType ty) +tyCoVarsOfType (CastTy ty co) = (tyCoVarsOfType ty `unionVarSet` tyCoVarsOfCo co) +tyCoVarsOfType (CoercionTy co) = tyCoVarsOfCo co -- | `tyCoFVsOfType` that returns free variables of a type in a deterministic -- set. For explanation of why using `VarSet` is not deterministic see @@ -1493,6 +1501,11 @@ tyCoVarsOfTypeDSet :: Type -> DTyCoVarSet -- See Note [Free variables of types] tyCoVarsOfTypeDSet ty = fvDVarSet $ tyCoFVsOfType ty +tyCoVarSetsBndr :: TyVarBinder -> VarSet -> VarSet +-- Free vars of (forall b. ) +tyCoVarSetsBndr (TvBndr tv _) fvs = (delVarSet fvs tv) + `unionVarSet` tyCoVarsOfType (tyVarKind tv) + -- | `tyCoFVsOfType` that returns free variables of a type in deterministic -- order. For explanation of why using `VarSet` is not deterministic see -- Note [Deterministic FV] in FV. diff --git a/utils/haddock b/utils/haddock index 0d903e5..76d0f9b 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 0d903e5e7ea877cbf6e8a7a84c9c8b6ef8c78ef6 +Subproject commit 76d0f9b90a7b2f65ae12e1ce5dd0552909493252 From git at git.haskell.org Thu Aug 2 09:05:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 09:05:26 +0000 (UTC) Subject: [commit: ghc] wip/T14880-just-tvs: Implement tyCoVarsOfCo(s) in terms of VarSet (649f852) Message-ID: <20180802090526.825903A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880-just-tvs Link : http://ghc.haskell.org/trac/ghc/changeset/649f8523170ef33d855e24f39b1b1248f6de9d49/ghc >--------------------------------------------------------------- commit 649f8523170ef33d855e24f39b1b1248f6de9d49 Author: Tobias Dammers Date: Wed Aug 1 11:59:52 2018 +0200 Implement tyCoVarsOfCo(s) in terms of VarSet >--------------------------------------------------------------- 649f8523170ef33d855e24f39b1b1248f6de9d49 compiler/types/TyCoRep.hs | 45 +++++++++++++++++++++++++++++++++++++++------ 1 file changed, 39 insertions(+), 6 deletions(-) diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 2fdf172..3d68f2a 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -1543,14 +1543,15 @@ tyCoFVsBndr (TvBndr tv _) fvs = (delFV tv fvs) -- synonym. tyCoVarsOfTypes :: [Type] -> TyCoVarSet -- See Note [Free variables of types] -tyCoVarsOfTypes tys = fvVarSet $ tyCoFVsOfTypes tys +-- tyCoVarsOfTypes tys = fvVarSet $ tyCoFVsOfTypes tys +tyCoVarsOfTypes tys = mapUnionVarSet tyCoVarsOfType tys -- | Returns free variables of types, including kind variables as -- a non-deterministic set. For type synonyms it does /not/ expand the -- synonym. tyCoVarsOfTypesSet :: TyVarEnv Type -> TyCoVarSet -- See Note [Free variables of types] -tyCoVarsOfTypesSet tys = fvVarSet $ tyCoFVsOfTypes $ nonDetEltsUFM tys +tyCoVarsOfTypesSet tys = tyCoVarsOfTypes $ nonDetEltsUFM tys -- It's OK to use nonDetEltsUFM here because we immediately forget the -- ordering by returning a set @@ -1575,8 +1576,38 @@ tyCoFVsOfTypes [] fv_cand in_scope acc = emptyFV fv_cand in_scope acc tyCoVarsOfCo :: Coercion -> TyCoVarSet -- See Note [Free variables of types] -tyCoVarsOfCo co = fvVarSet $ tyCoFVsOfCo co - +-- tyCoVarsOfCo co = fvVarSet $ tyCoFVsOfCo co +tyCoVarsOfCo (Refl _ ty) = tyCoVarsOfType ty +tyCoVarsOfCo (TyConAppCo _ _ cos) = tyCoVarsOfCos cos +tyCoVarsOfCo (AppCo co arg) + = (tyCoVarsOfCo co `unionVarSet` tyCoVarsOfCo arg) +tyCoVarsOfCo (ForAllCo tv kind_co co) + = (delVarSet (tyCoVarsOfCo co) tv `unionVarSet` tyCoVarsOfCo kind_co) +tyCoVarsOfCo (FunCo _ co1 co2) + = (tyCoVarsOfCo co1 `unionVarSet` tyCoVarsOfCo co2) +tyCoVarsOfCo (CoVarCo v) + = tyCoVarsOfCoVar v +tyCoVarsOfCo (HoleCo h) + = tyCoVarsOfCoVar (coHoleCoVar h) + -- See Note [CoercionHoles and coercion free variables] +tyCoVarsOfCo (AxiomInstCo _ _ cos) = tyCoVarsOfCos cos +tyCoVarsOfCo (UnivCo p _ t1 t2) + = (tyCoVarsOfProv p `unionVarSet` tyCoVarsOfType t1 + `unionVarSet` tyCoVarsOfType t2) +tyCoVarsOfCo (SymCo co) = tyCoVarsOfCo co +tyCoVarsOfCo (TransCo co1 co2) = (tyCoVarsOfCo co1 `unionVarSet` tyCoVarsOfCo co2) +tyCoVarsOfCo (NthCo _ _ co) = tyCoVarsOfCo co +tyCoVarsOfCo (LRCo _ co) = tyCoVarsOfCo co +tyCoVarsOfCo (InstCo co arg) = (tyCoVarsOfCo co `unionVarSet` tyCoVarsOfCo arg) +tyCoVarsOfCo (CoherenceCo c1 c2) = (tyCoVarsOfCo c1 `unionVarSet` tyCoVarsOfCo c2) +tyCoVarsOfCo (KindCo co) = tyCoVarsOfCo co +tyCoVarsOfCo (SubCo co) = tyCoVarsOfCo co +tyCoVarsOfCo (AxiomRuleCo _ cs) = tyCoVarsOfCos cs + +tyCoVarsOfCoVar :: CoVar -> VarSet +tyCoVarsOfCoVar v + = (unitVarSet v `unionVarSet` tyCoVarsOfType (varType v)) +-- -- | Get a deterministic set of the vars free in a coercion tyCoVarsOfCoDSet :: Coercion -> DTyCoVarSet -- See Note [Free variables of types] @@ -1630,10 +1661,12 @@ tyCoFVsOfProv (ProofIrrelProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand tyCoFVsOfProv (PluginProv _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc tyCoVarsOfCos :: [Coercion] -> TyCoVarSet -tyCoVarsOfCos cos = fvVarSet $ tyCoFVsOfCos cos +-- tyCoVarsOfCos cos = fvVarSet $ tyCoFVsOfCos cos +tyCoVarsOfCos cos = mapUnionVarSet tyCoVarsOfCo cos tyCoVarsOfCosSet :: CoVarEnv Coercion -> TyCoVarSet -tyCoVarsOfCosSet cos = fvVarSet $ tyCoFVsOfCos $ nonDetEltsUFM cos +-- tyCoVarsOfCosSet cos = fvVarSet $ tyCoFVsOfCos $ nonDetEltsUFM cos +tyCoVarsOfCosSet cos = tyCoVarsOfCos $ nonDetEltsUFM cos -- It's OK to use nonDetEltsUFM here because we immediately forget the -- ordering by returning a set From git at git.haskell.org Thu Aug 2 09:05:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 09:05:29 +0000 (UTC) Subject: [commit: ghc] wip/T14880-just-tvs: Upgrade haddock submodule to avoid bug (8b567b3) Message-ID: <20180802090529.51C8F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880-just-tvs Link : http://ghc.haskell.org/trac/ghc/changeset/8b567b3c94eb61adde1a72be11225d68ae649f13/ghc >--------------------------------------------------------------- commit 8b567b3c94eb61adde1a72be11225d68ae649f13 Author: Tobias Dammers Date: Wed Aug 1 16:59:44 2018 +0200 Upgrade haddock submodule to avoid bug >--------------------------------------------------------------- 8b567b3c94eb61adde1a72be11225d68ae649f13 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 76d0f9b..0731855 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 76d0f9b90a7b2f65ae12e1ce5dd0552909493252 +Subproject commit 0731855bd1c05379a91a3d761458b05c2d75b6d9 From git at git.haskell.org Thu Aug 2 13:48:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 13:48:29 +0000 (UTC) Subject: [commit: ghc] master: Remove obsolete file (c50574a) Message-ID: <20180802134829.E7E5D3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c50574a8e006ff26911f6762187d01210a1dda0f/ghc >--------------------------------------------------------------- commit c50574a8e006ff26911f6762187d01210a1dda0f Author: Herbert Valerio Riedel Date: Thu Aug 2 15:46:21 2018 +0200 Remove obsolete file This was missed by 0960a37868e6d08857e86465c8ca346b29b1c813 [skip ci] >--------------------------------------------------------------- c50574a8e006ff26911f6762187d01210a1dda0f compiler/DEPEND-NOTES | 4 ---- 1 file changed, 4 deletions(-) diff --git a/compiler/DEPEND-NOTES b/compiler/DEPEND-NOTES deleted file mode 100644 index f2ba244..0000000 --- a/compiler/DEPEND-NOTES +++ /dev/null @@ -1,4 +0,0 @@ -Module dependency information is now given in the GHC commentary - - ghc/docs/comm/genesis/modules.html - From git at git.haskell.org Thu Aug 2 20:42:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 20:42:19 +0000 (UTC) Subject: [commit: ghc] master: Remove decideKindGeneralisationPlan (c955a51) Message-ID: <20180802204219.B70A03A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c955a514f033a12f6d0ab0fbacec3e18a5757ab5/ghc >--------------------------------------------------------------- commit c955a514f033a12f6d0ab0fbacec3e18a5757ab5 Author: Richard Eisenberg Date: Sat Jul 14 16:02:13 2018 -0400 Remove decideKindGeneralisationPlan TypeInType came with a new function: decideKindGeneralisationPlan. This type-level counterpart to the term-level decideGeneralisationPlan chose whether or not a kind should be generalized. The thinking was that if `let` should not be generalized, then kinds shouldn't either (under the same circumstances around -XMonoLocalBinds). However, this is too conservative -- the situation described in the motivation for "let should be be generalized" does not occur in types. This commit thus removes decideKindGeneralisationPlan, always generalizing. One consequence is that tc_hs_sig_type_and_gen no longer calls solveEqualities, which reports all unsolved constraints, instead relying on the solveLocalEqualities in tcImplicitTKBndrs. An effect of this is that reporing kind errors gets delayed more frequently. This seems to be a net benefit in error reporting; often, alongside a kind error, the type error is now reported (and users might find type errors easier to understand). Some of these errors ended up at the top level, where it was discovered that the GlobalRdrEnv containing the definitions in the local module was not in the TcGblEnv, and thus errors were reported with qualified names unnecessarily. This commit rejiggers some of the logic around captureTopConstraints accordingly. One error message (typecheck/should_fail/T1633) is a regression, mentioning the name of a default method. However, that problem is already reported as #10087, its solution is far from clear, and so I'm not addressing it here. This commit fixes #15141. As it's an internal refactor, there is no concrete test case for it. Along the way, we no longer need the hsib_closed field of HsImplicitBndrs (it was used only in decideKindGeneralisationPlan) and so it's been removed, simplifying the datatype structure. Along the way, I removed code in the validity checker that looks at coercions. This isn't related to this patch, really (though it was, at one point), but it's an improvement, so I kept it. This updates the haddock submodule. >--------------------------------------------------------------- c955a514f033a12f6d0ab0fbacec3e18a5757ab5 compiler/deSugar/DsMeta.hs | 10 +- compiler/hsSyn/HsTypes.hs | 31 ++-- compiler/rename/RnSource.hs | 5 +- compiler/rename/RnTypes.hs | 19 +- compiler/typecheck/TcDeriv.hs | 7 +- compiler/typecheck/TcEnv.hs | 6 +- compiler/typecheck/TcHsType.hs | 204 +++++++++++---------- compiler/typecheck/TcInstDcls.hs | 5 +- compiler/typecheck/TcMType.hs | 2 + compiler/typecheck/TcRnDriver.hs | 54 +++--- compiler/typecheck/TcSigs.hs | 9 +- compiler/typecheck/TcSimplify.hs | 23 ++- compiler/typecheck/TcSplice.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 7 +- compiler/typecheck/TcValidity.hs | 37 +--- compiler/types/TyCoRep.hs | 40 +++- docs/users_guide/glasgow_exts.rst | 43 ----- .../{should_fail => should_compile}/T14066h.hs | 2 +- testsuite/tests/dependent/should_compile/all.T | 1 + .../tests/dependent/should_fail/DepFail1.stderr | 22 ++- .../tests/dependent/should_fail/T13895.stderr | 24 +++ .../tests/dependent/should_fail/T14066.stderr | 6 +- .../tests/dependent/should_fail/T14066e.stderr | 11 +- .../tests/dependent/should_fail/T14066h.stderr | 16 -- testsuite/tests/dependent/should_fail/all.T | 1 - .../parser/should_compile/DumpRenamedAst.stderr | 16 +- testsuite/tests/polykinds/T11142.stderr | 13 +- testsuite/tests/polykinds/T11516.hs | 1 + testsuite/tests/polykinds/T11516.stderr | 2 +- testsuite/tests/polykinds/T11520.hs | 2 +- testsuite/tests/polykinds/T11520.stderr | 4 + testsuite/tests/polykinds/T12593.stderr | 58 ++++-- testsuite/tests/polykinds/T13555.stderr | 20 -- testsuite/tests/polykinds/T14520.hs | 2 +- testsuite/tests/polykinds/T14520.stderr | 3 +- testsuite/tests/polykinds/T14846.stderr | 15 +- testsuite/tests/polykinds/T7224.stderr | 8 +- testsuite/tests/polykinds/T8616.stderr | 14 +- testsuite/tests/polykinds/all.T | 4 +- testsuite/tests/rename/should_fail/T5951.stderr | 4 + testsuite/tests/rename/should_fail/rnfail026.hs | 7 +- .../tests/rename/should_fail/rnfail026.stderr | 8 +- testsuite/tests/th/T5358.stderr | 20 -- testsuite/tests/typecheck/should_compile/T15141.hs | 35 ++++ testsuite/tests/typecheck/should_compile/all.T | 1 + .../tests/typecheck/should_fail/T11112.stderr | 12 +- .../tests/typecheck/should_fail/T11563.stderr | 6 + .../tests/typecheck/should_fail/T14232.stderr | 13 ++ testsuite/tests/typecheck/should_fail/T1633.stderr | 6 +- testsuite/tests/typecheck/should_fail/T2994.stderr | 13 ++ testsuite/tests/typecheck/should_fail/T3540.stderr | 10 + testsuite/tests/typecheck/should_fail/T7778.stderr | 6 + .../tests/typecheck/should_fail/tcfail057.stderr | 12 +- .../tests/typecheck/should_fail/tcfail058.stderr | 23 ++- .../tests/typecheck/should_fail/tcfail063.stderr | 20 +- .../tests/typecheck/should_fail/tcfail078.stderr | 13 ++ .../tests/typecheck/should_fail/tcfail113.stderr | 21 +++ .../tests/typecheck/should_fail/tcfail158.stderr | 7 +- .../tests/typecheck/should_fail/tcfail160.stderr | 9 +- .../tests/typecheck/should_fail/tcfail161.stderr | 11 +- .../tests/typecheck/should_fail/tcfail212.stderr | 26 ++- utils/haddock | 2 +- 62 files changed, 620 insertions(+), 414 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 c955a514f033a12f6d0ab0fbacec3e18a5757ab5 From git at git.haskell.org Thu Aug 2 21:31:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 21:31:42 +0000 (UTC) Subject: [commit: ghc] branch 'wip/D4889' created Message-ID: <20180802213142.284F93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/D4889 Referencing: dfb28494102c069bfea94fd5dfbc5b9ae77bf52f From git at git.haskell.org Thu Aug 2 21:31:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 21:31:45 +0000 (UTC) Subject: [commit: ghc] wip/D4889: Bump binary submodule (4fe6834) Message-ID: <20180802213145.02EB13A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/D4889 Link : http://ghc.haskell.org/trac/ghc/changeset/4fe6834163fbf127910c61fee087a66bb5bf9660/ghc >--------------------------------------------------------------- commit 4fe6834163fbf127910c61fee087a66bb5bf9660 Author: Ben Gamari Date: Thu Aug 2 08:29:52 2018 -0400 Bump binary submodule >--------------------------------------------------------------- 4fe6834163fbf127910c61fee087a66bb5bf9660 compiler/ghc.cabal.in | 2 +- libraries/Cabal | 2 +- libraries/binary | 2 +- libraries/ghc-boot/ghc-boot.cabal.in | 2 +- libraries/ghci/ghci.cabal.in | 2 +- libraries/libiserv/libiserv.cabal | 2 +- utils/iserv/iserv.cabal | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 5c9d88f..2c057bc 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -59,7 +59,7 @@ Library directory >= 1 && < 1.4, process >= 1 && < 1.7, bytestring >= 0.9 && < 0.11, - binary == 0.8.*, + binary == 0.10.*, time >= 1.4 && < 1.9, containers >= 0.5 && < 0.7, array >= 0.1 && < 0.6, diff --git a/libraries/Cabal b/libraries/Cabal index 2a3175f..71f9218 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 2a3175f886b86697194256f55c9487b7cfb4dc92 +Subproject commit 71f9218b037c82d208deebd1af95e74327656d7b diff --git a/libraries/binary b/libraries/binary index ecf48c4..b5a2454 160000 --- a/libraries/binary +++ b/libraries/binary @@ -1 +1 @@ -Subproject commit ecf48c4589b927de3ae3fff8455c1c25140df7e9 +Subproject commit b5a2454e331ba516a14bed77e30f7ef8251eea48 diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in index 0ca9c1e..ca1c19f 100644 --- a/libraries/ghc-boot/ghc-boot.cabal.in +++ b/libraries/ghc-boot/ghc-boot.cabal.in @@ -43,7 +43,7 @@ Library GHC.HandleEncoding build-depends: base >= 4.7 && < 4.13, - binary == 0.8.*, + binary == 0.10.*, bytestring == 0.10.*, directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, diff --git a/libraries/ghci/ghci.cabal.in b/libraries/ghci/ghci.cabal.in index 32ce79c..d7f112e 100644 --- a/libraries/ghci/ghci.cabal.in +++ b/libraries/ghci/ghci.cabal.in @@ -70,7 +70,7 @@ library Build-Depends: array == 0.5.*, base >= 4.8 && < 4.13, - binary == 0.8.*, + binary == 0.10.*, bytestring == 0.10.*, containers >= 0.5 && < 0.7, deepseq == 1.4.*, diff --git a/libraries/libiserv/libiserv.cabal b/libraries/libiserv/libiserv.cabal index f29875c..196d36c 100644 --- a/libraries/libiserv/libiserv.cabal +++ b/libraries/libiserv/libiserv.cabal @@ -21,7 +21,7 @@ Library Exposed-Modules: Lib , GHCi.Utils Build-Depends: base >= 4 && < 5, - binary >= 0.7 && < 0.9, + binary >= 0.7 && < 0.11, bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.7, deepseq >= 1.4 && < 1.5, diff --git a/utils/iserv/iserv.cabal b/utils/iserv/iserv.cabal index af0e385..0f45c8d 100644 --- a/utils/iserv/iserv.cabal +++ b/utils/iserv/iserv.cabal @@ -31,7 +31,7 @@ Executable iserv include-dirs: . Build-Depends: array >= 0.5 && < 0.6, base >= 4 && < 5, - binary >= 0.7 && < 0.9, + binary >= 0.7 && < 0.11, bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.7, deepseq >= 1.4 && < 1.5, From git at git.haskell.org Thu Aug 2 21:31:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Aug 2018 21:31:47 +0000 (UTC) Subject: [commit: ghc] wip/D4889: rts: Specialize hashing at call site rather than in struct (dfb2849) Message-ID: <20180802213147.EC4973A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/D4889 Link : http://ghc.haskell.org/trac/ghc/changeset/dfb28494102c069bfea94fd5dfbc5b9ae77bf52f/ghc >--------------------------------------------------------------- commit dfb28494102c069bfea94fd5dfbc5b9ae77bf52f Author: Crazycolorz5 Date: Thu Aug 2 17:30:36 2018 -0400 rts: Specialize hashing at call site rather than in struct Separate word and string hash tables on the type level, and do not store the hashing function. Thus when a different hash function is desire it is provided upon accessing the table. This is worst case the same as before the change, and in the majority of cases is better. Also mark the functions for aggressive inlining to improve performance. {F1686506} Reviewers: bgamari, erikd, simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #13165 Differential Revision: https://phabricator.haskell.org/D4889 >--------------------------------------------------------------- dfb28494102c069bfea94fd5dfbc5b9ae77bf52f rts/FileLock.c | 12 ++--- rts/Hash.c | 124 +++++++++++++++++++++++++++++++++++--------------- rts/Hash.h | 46 +++++++++++++------ rts/Hpc.c | 12 ++--- rts/Linker.c | 12 ++--- rts/LinkerInternals.h | 8 ++-- rts/RtsSymbolInfo.c | 6 +-- rts/StaticPtrTable.c | 14 +++--- 8 files changed, 152 insertions(+), 82 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 dfb28494102c069bfea94fd5dfbc5b9ae77bf52f From git at git.haskell.org Fri Aug 3 20:18:41 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:18:41 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Clone relevant constraints to avoid side-effects on HoleDests. Fixes #15370. (588364c) Message-ID: <20180803201841.6CDD13A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/588364c38530b51902d79d0175deed359796d172/ghc >--------------------------------------------------------------- commit 588364c38530b51902d79d0175deed359796d172 Author: Matthías Páll Gissurarson Date: Tue Jul 24 23:57:48 2018 +0200 Clone relevant constraints to avoid side-effects on HoleDests. Fixes #15370. Summary: When looking for valid hole fits, the constraints relevant to the hole may sometimes contain a HoleDest. Previously, these were not cloned, which could cause the filling of filled coercion hole being, which would cause an assert to fail. This is now fixed. Test Plan: Regression test included. Reviewers: simonpj, bgamari, goldfire Reviewed By: simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15370 Differential Revision: https://phabricator.haskell.org/D5004 (cherry picked from commit 0dc86f6bc454253969dedc31bed477eded4cf82d) >--------------------------------------------------------------- 588364c38530b51902d79d0175deed359796d172 compiler/typecheck/TcHoleErrors.hs | 13 ++++--- compiler/typecheck/TcMType.hs | 9 ++--- testsuite/tests/typecheck/should_compile/T15370.hs | 20 +++++++++++ .../tests/typecheck/should_compile/T15370.stderr | 42 ++++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 77 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/TcHoleErrors.hs b/compiler/typecheck/TcHoleErrors.hs index ee4d617..74f199a 100644 --- a/compiler/typecheck/TcHoleErrors.hs +++ b/compiler/typecheck/TcHoleErrors.hs @@ -900,16 +900,21 @@ tcCheckHoleFit relevantCts implics hole_ty ty = discardErrs $ do { (wrp, wanted) <- captureConstraints $ tcSubType_NC ExprSigCtxt ty hole_ty ; traceTc "Checking hole fit {" empty ; traceTc "wanteds are: " $ ppr wanted - -- We add the relevantCts to the wanteds generated by the call to - -- tcSubType_NC, see Note [Relevant Constraints] - ; let w_rel_cts = addSimples wanted relevantCts - ; if isEmptyWC w_rel_cts + ; if isEmptyWC wanted && isEmptyBag relevantCts then traceTc "}" empty >> return (True, wrp) else do { fresh_binds <- newTcEvBinds + -- The relevant constraints may contain HoleDests, so we must + -- take care to clone them as well (to avoid #15370). + ; cloned_relevants <- mapBagM cloneSimple relevantCts -- We wrap the WC in the nested implications, see -- Note [Nested Implications] ; let outermost_first = reverse implics setWC = setWCAndBinds fresh_binds + -- We add the cloned relevants to the wanteds generated by + -- the call to tcSubType_NC, see Note [Relevant Constraints] + -- There's no need to clone the wanteds, because they are + -- freshly generated by `tcSubtype_NC`. + w_rel_cts = addSimples wanted cloned_relevants w_givens = foldr setWC w_rel_cts outermost_first ; traceTc "w_givens are: " $ ppr w_givens ; rem <- runTcSDeriveds $ simpl_top w_givens diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 3f3252f..6ab86dd 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -43,7 +43,7 @@ module TcMType ( -------------------------------- -- Creating new evidence variables newEvVar, newEvVars, newDict, - newWanted, newWanteds, cloneWanted, cloneWC, + newWanted, newWanteds, cloneWanted, cloneSimple, cloneWC, emitWanted, emitWantedEq, emitWantedEvVar, emitWantedEvVars, newTcEvBinds, newNoTcEvBinds, addTcEvBind, @@ -190,14 +190,15 @@ cloneWanted ct where ev = ctEvidence ct +cloneSimple :: Ct -> TcM Ct +cloneSimple = fmap mkNonCanonical . cloneWanted + cloneWC :: WantedConstraints -> TcM WantedConstraints cloneWC wc@(WC { wc_simple = simples, wc_impl = implics }) - = do { simples' <- mapBagM clone_one simples + = do { simples' <- mapBagM cloneSimple simples ; implics' <- mapBagM clone_implic implics ; return (wc { wc_simple = simples', wc_impl = implics' }) } where - clone_one ct = do { ev <- cloneWanted ct; return (mkNonCanonical ev) } - clone_implic implic@(Implic { ic_wanted = inner_wanted }) = do { inner_wanted' <- cloneWC inner_wanted ; return (implic { ic_wanted = inner_wanted' }) } diff --git a/testsuite/tests/typecheck/should_compile/T15370.hs b/testsuite/tests/typecheck/should_compile/T15370.hs new file mode 100644 index 0000000..acccf03 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15370.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +module Bug where + +import Data.Type.Equality + +data S (a :: Either x y) + +mkRefl :: n :~: j +mkRefl = Refl + +right :: forall (r :: Either x y). + S r -> () +right no = + case mkRefl @x @y of + Refl -> no + _ diff --git a/testsuite/tests/typecheck/should_compile/T15370.stderr b/testsuite/tests/typecheck/should_compile/T15370.stderr new file mode 100644 index 0000000..f26cf92 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15370.stderr @@ -0,0 +1,42 @@ + +T15370.hs:14:10: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘n’ with ‘j’ + ‘n’ is a rigid type variable bound by + the type signature for: + mkRefl :: forall k (n :: k) (j :: k). n :~: j + at T15370.hs:13:1-17 + ‘j’ is a rigid type variable bound by + the type signature for: + mkRefl :: forall k (n :: k) (j :: k). n :~: j + at T15370.hs:13:1-17 + Expected type: n :~: j + Actual type: n :~: n + • In the expression: Refl + In an equation for ‘mkRefl’: mkRefl = Refl + • Relevant bindings include + mkRefl :: n :~: j (bound at T15370.hs:14:1) + +T15370.hs:20:13: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘S r’ with ‘()’ + Expected type: () + Actual type: S r + • In the expression: no + _ + In a case alternative: Refl -> no + _ + In the expression: case mkRefl @x @y of { Refl -> no + _ } + • Relevant bindings include + no :: S r (bound at T15370.hs:18:7) + right :: S r -> () (bound at T15370.hs:18:1) + +T15370.hs:20:18: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: S r + Where: ‘r’, ‘y’, ‘x’ are rigid type variables bound by + the type signature for: + right :: forall x y (r :: Either x y). S r -> () + at T15370.hs:(16,1)-(17,18) + • In the second argument of ‘(+)’, namely ‘_’ + In the expression: no + _ + In a case alternative: Refl -> no + _ + • Relevant bindings include + no :: S r (bound at T15370.hs:18:7) + right :: S r -> () (bound at T15370.hs:18:1) + Constraints include y ~ x (from T15370.hs:20:5-8) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 5887b3c..2d20491 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -398,6 +398,7 @@ test('abstract_refinement_hole_fits', normal, compile, ['-fdefer-type-errors -fn test('free_monad_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -fno-max-refinement-hole-fits -frefinement-level-hole-fits=2 -funclutter-valid-hole-fits']) test('constraint_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -fno-max-refinement-hole-fits -frefinement-level-hole-fits=2 -funclutter-valid-hole-fits']) test('type_in_type_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits']) +test('T15370', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -funclutter-valid-hole-fits']) test('T7408', normal, compile, ['']) test('UnboxStrictPrimitiveFields', normal, compile, ['']) test('T7541', normal, compile, ['']) From git at git.haskell.org Fri Aug 3 20:18:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:18:44 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: fixup! Disable T10962 on llvm for now (48fe84e) Message-ID: <20180803201844.42E1E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/48fe84e248b2a1e72ca4b48893655477c7deb5c1/ghc >--------------------------------------------------------------- commit 48fe84e248b2a1e72ca4b48893655477c7deb5c1 Author: Krzysztof Gogolewski Date: Sun Jul 22 22:50:06 2018 +0200 fixup! Disable T10962 on llvm for now (cherry picked from commit a606750b36862367d038813f9fe7170f93c36222) >--------------------------------------------------------------- 48fe84e248b2a1e72ca4b48893655477c7deb5c1 testsuite/tests/numeric/should_run/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index eac0278..d582f05 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -62,7 +62,7 @@ test('CarryOverflow', omit_ways(['ghci']), compile_and_run, ['']) test('T9407', normal, compile_and_run, ['']) test('T9810', normal, compile_and_run, ['']) test('T10011', normal, compile_and_run, ['']) -test('T10962', [omit_ways(['ghci']), extra_ways(['llvm'])], compile_and_run, ['-O2']) +test('T10962', [omit_ways(['ghci'])], compile_and_run, ['-O2']) test('T11702', extra_ways(['optasm']), compile_and_run, ['']) test('T12136', normal, compile_and_run, ['']) test('T15301', normal, compile_and_run, ['-O2']) From git at git.haskell.org Fri Aug 3 20:28:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:28:22 +0000 (UTC) Subject: [commit: packages/binary] master: Add other-modules for the tests and benchmarks. (5a8511f) Message-ID: <20180803202822.208603A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/5a8511fe403dcb048b1afb57cedfb3e5a441e56c >--------------------------------------------------------------- commit 5a8511fe403dcb048b1afb57cedfb3e5a441e56c Author: Lennart Kolmodin Date: Wed Aug 1 21:15:10 2018 +0200 Add other-modules for the tests and benchmarks. GHC gave a warning that we needed modules but didn't explicitly depend on them in the .cabal file. >--------------------------------------------------------------- 5a8511fe403dcb048b1afb57cedfb3e5a441e56c binary.cabal | 72 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 71 insertions(+), 1 deletion(-) diff --git a/binary.cabal b/binary.cabal index 7e05176..c4997f1 100644 --- a/binary.cabal +++ b/binary.cabal @@ -64,6 +64,16 @@ test-suite qc other-modules: Action Arbitrary + other-modules: + Data.Binary + Data.Binary.Builder + Data.Binary.Class + Data.Binary.FloatCast + Data.Binary.Generic + Data.Binary.Get + Data.Binary.Get.Internal + Data.Binary.Internal + Data.Binary.Put build-depends: base >= 4.5.0.0 && < 5, bytestring >= 0.10.4, @@ -84,6 +94,16 @@ test-suite read-write-file type: exitcode-stdio-1.0 hs-source-dirs: src tests main-is: File.hs + other-modules: + Data.Binary + Data.Binary.Builder + Data.Binary.Class + Data.Binary.FloatCast + Data.Binary.Generic + Data.Binary.Get + Data.Binary.Get.Internal + Data.Binary.Internal + Data.Binary.Put build-depends: base >= 4.5.0.0 && < 5, bytestring >= 0.10.4, @@ -104,7 +124,17 @@ benchmark bench type: exitcode-stdio-1.0 hs-source-dirs: src benchmarks main-is: Benchmark.hs - other-modules: MemBench + other-modules: + MemBench + Data.Binary + Data.Binary.Builder + Data.Binary.Class + Data.Binary.FloatCast + Data.Binary.Generic + Data.Binary.Get + Data.Binary.Get.Internal + Data.Binary.Internal + Data.Binary.Put build-depends: base >= 4.5.0.0 && < 5, bytestring >= 0.10.4 @@ -122,6 +152,16 @@ benchmark get type: exitcode-stdio-1.0 hs-source-dirs: src benchmarks main-is: Get.hs + other-modules: + Data.Binary + Data.Binary.Builder + Data.Binary.Class + Data.Binary.FloatCast + Data.Binary.Generic + Data.Binary.Get + Data.Binary.Get.Internal + Data.Binary.Internal + Data.Binary.Put build-depends: attoparsec, base >= 4.5.0.0 && < 5, @@ -142,6 +182,16 @@ benchmark put type: exitcode-stdio-1.0 hs-source-dirs: src benchmarks main-is: Put.hs + other-modules: + Data.Binary + Data.Binary.Builder + Data.Binary.Class + Data.Binary.FloatCast + Data.Binary.Generic + Data.Binary.Get + Data.Binary.Get.Internal + Data.Binary.Internal + Data.Binary.Put build-depends: base >= 4.5.0.0 && < 5, bytestring >= 0.10.4, @@ -159,6 +209,16 @@ benchmark generics-bench type: exitcode-stdio-1.0 hs-source-dirs: src benchmarks main-is: GenericsBench.hs + other-modules: + Data.Binary + Data.Binary.Builder + Data.Binary.Class + Data.Binary.FloatCast + Data.Binary.Generic + Data.Binary.Get + Data.Binary.Get.Internal + Data.Binary.Internal + Data.Binary.Put build-depends: base >= 4.5.0.0 && < 5, bytestring >= 0.10.4, @@ -188,6 +248,16 @@ benchmark builder type: exitcode-stdio-1.0 hs-source-dirs: src benchmarks main-is: Builder.hs + other-modules: + Data.Binary + Data.Binary.Builder + Data.Binary.Class + Data.Binary.FloatCast + Data.Binary.Generic + Data.Binary.Get + Data.Binary.Get.Internal + Data.Binary.Internal + Data.Binary.Put build-depends: base >= 4.5.0.0 && < 5, bytestring >= 0.10.4, From git at git.haskell.org Fri Aug 3 20:28:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:28:24 +0000 (UTC) Subject: [commit: packages/binary] master: Hide 'total' from Test.QuickCheck. Fixes shadowing warning. (16c7035) Message-ID: <20180803202824.26D603A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/16c7035d5e1d347d16831145a26e6d862855f8fb >--------------------------------------------------------------- commit 16c7035d5e1d347d16831145a26e6d862855f8fb Author: Lennart Kolmodin Date: Wed Aug 1 21:30:13 2018 +0200 Hide 'total' from Test.QuickCheck. Fixes shadowing warning. >--------------------------------------------------------------- 16c7035d5e1d347d16831145a26e6d862855f8fb tests/QC.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/QC.hs b/tests/QC.hs index 7dc4275..71d9cb8 100644 --- a/tests/QC.hs +++ b/tests/QC.hs @@ -34,7 +34,7 @@ import qualified Data.Fixed as Fixed import Test.Framework import Test.Framework.Providers.QuickCheck2 -import Test.QuickCheck +import Test.QuickCheck hiding (total) import qualified Action (tests) import Arbitrary () From git at git.haskell.org Fri Aug 3 20:28:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:28:26 +0000 (UTC) Subject: [commit: packages/binary] master: Bump to 0.10.0.0 and add changelog. (71c6b4b) Message-ID: <20180803202826.2CBC13A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/71c6b4b6c5d6daab527cbd780e75c9a7004996e9 >--------------------------------------------------------------- commit 71c6b4b6c5d6daab527cbd780e75c9a7004996e9 Author: Lennart Kolmodin Date: Wed Aug 1 21:47:47 2018 +0200 Bump to 0.10.0.0 and add changelog. >--------------------------------------------------------------- 71c6b4b6c5d6daab527cbd780e75c9a7004996e9 binary.cabal | 2 +- changelog.md | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/binary.cabal b/binary.cabal index c4997f1..c37b46a 100644 --- a/binary.cabal +++ b/binary.cabal @@ -1,5 +1,5 @@ name: binary -version: 0.8.5.1 +version: 0.10.0.0 license: BSD3 license-file: LICENSE author: Lennart Kolmodin diff --git a/changelog.md b/changelog.md index 98afc48..a9b5e6a 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,12 @@ binary ====== +binary-0.10.0.0 +--------------- + +- Add binary instance for Data.Functor.Identity from base, #146. +- Don't use * when we have TypeOperators, #148. + binary-0.9.0.0 -------------- From git at git.haskell.org Fri Aug 3 20:28:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:28:28 +0000 (UTC) Subject: [commit: packages/binary] master: Fix build error. Duplicates in other-modules. (c3ba099) Message-ID: <20180803202828.331FF3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/c3ba0995bd5dddb460fb5a1b9e402802874d2eea >--------------------------------------------------------------- commit c3ba0995bd5dddb460fb5a1b9e402802874d2eea Author: Lennart Kolmodin Date: Wed Aug 1 22:27:09 2018 +0200 Fix build error. Duplicates in other-modules. >--------------------------------------------------------------- c3ba0995bd5dddb460fb5a1b9e402802874d2eea binary.cabal | 2 -- 1 file changed, 2 deletions(-) diff --git a/binary.cabal b/binary.cabal index c37b46a..e138c25 100644 --- a/binary.cabal +++ b/binary.cabal @@ -158,7 +158,6 @@ benchmark get Data.Binary.Class Data.Binary.FloatCast Data.Binary.Generic - Data.Binary.Get Data.Binary.Get.Internal Data.Binary.Internal Data.Binary.Put @@ -191,7 +190,6 @@ benchmark put Data.Binary.Get Data.Binary.Get.Internal Data.Binary.Internal - Data.Binary.Put build-depends: base >= 4.5.0.0 && < 5, bytestring >= 0.10.4, From git at git.haskell.org Fri Aug 3 20:28:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:28:30 +0000 (UTC) Subject: [commit: packages/binary] master: Remove more other-modules duplicates. (b5a2454) Message-ID: <20180803202830.397303A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/b5a2454e331ba516a14bed77e30f7ef8251eea48 >--------------------------------------------------------------- commit b5a2454e331ba516a14bed77e30f7ef8251eea48 Author: Lennart Kolmodin Date: Thu Aug 2 08:35:14 2018 +0200 Remove more other-modules duplicates. >--------------------------------------------------------------- b5a2454e331ba516a14bed77e30f7ef8251eea48 binary.cabal | 2 -- 1 file changed, 2 deletions(-) diff --git a/binary.cabal b/binary.cabal index e138c25..343903c 100644 --- a/binary.cabal +++ b/binary.cabal @@ -198,7 +198,6 @@ benchmark put -- build dependencies from using binary source rather than depending on the library build-depends: array, containers ghc-options: -O2 -Wall - other-modules: Data.Binary.Generic if impl(ghc <= 7.6) -- prior to ghc-7.4 generics lived in ghc-prim build-depends: ghc-prim @@ -234,7 +233,6 @@ benchmark generics-bench Cabal24 GenericsBenchCache GenericsBenchTypes - Data.Binary.Generic -- build dependencies from using binary source rather than depending on the library build-depends: array, containers ghc-options: -O2 -Wall From git at git.haskell.org Fri Aug 3 20:28:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:28:38 +0000 (UTC) Subject: [commit: ghc] master: Bump Cabal submodule (653dc5f) Message-ID: <20180803202838.8D4BE3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/653dc5f7eb85e86c959e5c7320022f935f82db1d/ghc >--------------------------------------------------------------- commit 653dc5f7eb85e86c959e5c7320022f935f82db1d Author: Ben Gamari Date: Thu Aug 2 17:45:00 2018 -0400 Bump Cabal submodule >--------------------------------------------------------------- 653dc5f7eb85e86c959e5c7320022f935f82db1d libraries/Cabal | 2 +- testsuite/tests/cabal/cabal05/cabal05.stderr | 4 ---- utils/check-api-annotations/check-api-annotations.cabal | 2 +- utils/check-ppr/check-ppr.cabal | 2 +- utils/ghc-cabal/ghc-cabal.cabal | 2 +- utils/ghctags/ghctags.cabal | 2 +- 6 files changed, 5 insertions(+), 9 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 2a3175f..6671506 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 2a3175f886b86697194256f55c9487b7cfb4dc92 +Subproject commit 6671506b488a0fe2079f9059a23510b35514c031 diff --git a/testsuite/tests/cabal/cabal05/cabal05.stderr b/testsuite/tests/cabal/cabal05/cabal05.stderr index 12a7334..eb51115 100644 --- a/testsuite/tests/cabal/cabal05/cabal05.stderr +++ b/testsuite/tests/cabal/cabal05/cabal05.stderr @@ -1,7 +1,3 @@ -the following packages have broken abi-depends fields: - p - q - r T.hs:3:1: error: Ambiguous module name ‘Conflict’: diff --git a/utils/check-api-annotations/check-api-annotations.cabal b/utils/check-api-annotations/check-api-annotations.cabal index 3a014a6..3d07608 100644 --- a/utils/check-api-annotations/check-api-annotations.cabal +++ b/utils/check-api-annotations/check-api-annotations.cabal @@ -24,6 +24,6 @@ Executable check-api-annotations Build-Depends: base >= 4 && < 5, containers, - Cabal >= 2.3 && < 2.4, + Cabal >= 2.4.0 && < 2.5, directory, ghc diff --git a/utils/check-ppr/check-ppr.cabal b/utils/check-ppr/check-ppr.cabal index e0d8b9d..2da21d7 100644 --- a/utils/check-ppr/check-ppr.cabal +++ b/utils/check-ppr/check-ppr.cabal @@ -25,7 +25,7 @@ Executable check-ppr Build-Depends: base >= 4 && < 5, bytestring, containers, - Cabal >= 2.3 && < 2.4, + Cabal >= 2.4 && < 2.5, directory, filepath, ghc diff --git a/utils/ghc-cabal/ghc-cabal.cabal b/utils/ghc-cabal/ghc-cabal.cabal index cc0d98d..baa7a17 100644 --- a/utils/ghc-cabal/ghc-cabal.cabal +++ b/utils/ghc-cabal/ghc-cabal.cabal @@ -21,7 +21,7 @@ Executable ghc-cabal Build-Depends: base >= 3 && < 5, bytestring >= 0.10 && < 0.11, - Cabal >= 2.3 && < 2.4, + Cabal >= 2.4 && < 2.5, directory >= 1.1 && < 1.4, filepath >= 1.2 && < 1.5 diff --git a/utils/ghctags/ghctags.cabal b/utils/ghctags/ghctags.cabal index 391eb7a..f74bc4f 100644 --- a/utils/ghctags/ghctags.cabal +++ b/utils/ghctags/ghctags.cabal @@ -18,6 +18,6 @@ Executable ghctags Build-Depends: base >= 4 && < 5, containers, - Cabal >= 2.3 && <2.4, + Cabal >= 2.4 && <2.5, ghc From git at git.haskell.org Fri Aug 3 20:28:41 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:28:41 +0000 (UTC) Subject: [commit: ghc] master: Bump filepath submodule (7535fd6) Message-ID: <20180803202841.5EA733A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7535fd6af74aaeb43ad1adca9273ae5dd8fc4f4c/ghc >--------------------------------------------------------------- commit 7535fd6af74aaeb43ad1adca9273ae5dd8fc4f4c Author: Ben Gamari Date: Thu Aug 2 17:56:30 2018 -0400 Bump filepath submodule >--------------------------------------------------------------- 7535fd6af74aaeb43ad1adca9273ae5dd8fc4f4c libraries/filepath | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/filepath b/libraries/filepath index 1be834e..b10724b 160000 --- a/libraries/filepath +++ b/libraries/filepath @@ -1 +1 @@ -Subproject commit 1be834e1b3a3f8c5a14a58d73ce30133b4c69679 +Subproject commit b10724be8a907e191d153ad6674415be0c1325fd From git at git.haskell.org Fri Aug 3 20:28:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:28:44 +0000 (UTC) Subject: [commit: ghc] master: Bump binary submodule (8d04822) Message-ID: <20180803202844.33AE93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8d04822e0ef1d390c3cffb55b1f75638c7a519e7/ghc >--------------------------------------------------------------- commit 8d04822e0ef1d390c3cffb55b1f75638c7a519e7 Author: Ben Gamari Date: Thu Aug 2 08:29:52 2018 -0400 Bump binary submodule >--------------------------------------------------------------- 8d04822e0ef1d390c3cffb55b1f75638c7a519e7 compiler/ghc.cabal.in | 2 +- libraries/binary | 2 +- libraries/ghc-boot/ghc-boot.cabal.in | 2 +- libraries/ghci/ghci.cabal.in | 2 +- libraries/libiserv/libiserv.cabal | 2 +- utils/iserv/iserv.cabal | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 5c9d88f..2c057bc 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -59,7 +59,7 @@ Library directory >= 1 && < 1.4, process >= 1 && < 1.7, bytestring >= 0.9 && < 0.11, - binary == 0.8.*, + binary == 0.10.*, time >= 1.4 && < 1.9, containers >= 0.5 && < 0.7, array >= 0.1 && < 0.6, diff --git a/libraries/binary b/libraries/binary index ecf48c4..b5a2454 160000 --- a/libraries/binary +++ b/libraries/binary @@ -1 +1 @@ -Subproject commit ecf48c4589b927de3ae3fff8455c1c25140df7e9 +Subproject commit b5a2454e331ba516a14bed77e30f7ef8251eea48 diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in index 0ca9c1e..ca1c19f 100644 --- a/libraries/ghc-boot/ghc-boot.cabal.in +++ b/libraries/ghc-boot/ghc-boot.cabal.in @@ -43,7 +43,7 @@ Library GHC.HandleEncoding build-depends: base >= 4.7 && < 4.13, - binary == 0.8.*, + binary == 0.10.*, bytestring == 0.10.*, directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, diff --git a/libraries/ghci/ghci.cabal.in b/libraries/ghci/ghci.cabal.in index 32ce79c..d7f112e 100644 --- a/libraries/ghci/ghci.cabal.in +++ b/libraries/ghci/ghci.cabal.in @@ -70,7 +70,7 @@ library Build-Depends: array == 0.5.*, base >= 4.8 && < 4.13, - binary == 0.8.*, + binary == 0.10.*, bytestring == 0.10.*, containers >= 0.5 && < 0.7, deepseq == 1.4.*, diff --git a/libraries/libiserv/libiserv.cabal b/libraries/libiserv/libiserv.cabal index f29875c..196d36c 100644 --- a/libraries/libiserv/libiserv.cabal +++ b/libraries/libiserv/libiserv.cabal @@ -21,7 +21,7 @@ Library Exposed-Modules: Lib , GHCi.Utils Build-Depends: base >= 4 && < 5, - binary >= 0.7 && < 0.9, + binary >= 0.7 && < 0.11, bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.7, deepseq >= 1.4 && < 1.5, diff --git a/utils/iserv/iserv.cabal b/utils/iserv/iserv.cabal index af0e385..0f45c8d 100644 --- a/utils/iserv/iserv.cabal +++ b/utils/iserv/iserv.cabal @@ -31,7 +31,7 @@ Executable iserv include-dirs: . Build-Depends: array >= 0.5 && < 0.6, base >= 4 && < 5, - binary >= 0.7 && < 0.9, + binary >= 0.7 && < 0.11, bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.7, deepseq >= 1.4 && < 1.5, From git at git.haskell.org Fri Aug 3 20:49:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:49:28 +0000 (UTC) Subject: [commit: ghc] branch 'wip/fix-docs' created Message-ID: <20180803204928.07C2B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/fix-docs Referencing: 592a6a37815f1a007b9ee36bc52c108f3379d82f From git at git.haskell.org Fri Aug 3 20:49:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:49:30 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: Disable T10962 on llvm for now (c30f2b6) Message-ID: <20180803204930.CEE3E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/c30f2b6023799405c2e2f3b4c3bad55051663ea6/ghc >--------------------------------------------------------------- commit c30f2b6023799405c2e2f3b4c3bad55051663ea6 Author: Krzysztof Gogolewski Date: Sun Jul 22 22:50:06 2018 +0200 Disable T10962 on llvm for now (cherry picked from commit a606750b36862367d038813f9fe7170f93c36222) >--------------------------------------------------------------- c30f2b6023799405c2e2f3b4c3bad55051663ea6 testsuite/tests/numeric/should_run/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index eac0278..d582f05 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -62,7 +62,7 @@ test('CarryOverflow', omit_ways(['ghci']), compile_and_run, ['']) test('T9407', normal, compile_and_run, ['']) test('T9810', normal, compile_and_run, ['']) test('T10011', normal, compile_and_run, ['']) -test('T10962', [omit_ways(['ghci']), extra_ways(['llvm'])], compile_and_run, ['-O2']) +test('T10962', [omit_ways(['ghci'])], compile_and_run, ['-O2']) test('T11702', extra_ways(['optasm']), compile_and_run, ['']) test('T12136', normal, compile_and_run, ['']) test('T15301', normal, compile_and_run, ['-O2']) From git at git.haskell.org Fri Aug 3 20:49:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:49:33 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: Bump Cabal submodule (c1a596b) Message-ID: <20180803204933.9DE7B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/c1a596b238a205039027c15d173ac9037cd16235/ghc >--------------------------------------------------------------- commit c1a596b238a205039027c15d173ac9037cd16235 Author: Ben Gamari Date: Fri Aug 3 16:33:13 2018 -0400 Bump Cabal submodule >--------------------------------------------------------------- c1a596b238a205039027c15d173ac9037cd16235 libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 8828258..6671506 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 8828258813f726150cd748433a8ad0df3310c6bc +Subproject commit 6671506b488a0fe2079f9059a23510b35514c031 From git at git.haskell.org Fri Aug 3 20:49:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:49:36 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: Bump binary submodule (d6d35bb) Message-ID: <20180803204936.6F09A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/d6d35bb37187390f4292213514b148956fd7fc80/ghc >--------------------------------------------------------------- commit d6d35bb37187390f4292213514b148956fd7fc80 Author: Ben Gamari Date: Thu Aug 2 08:29:52 2018 -0400 Bump binary submodule (cherry picked from commit 3110428dd63a2014fe131cb2abff192570cc89e9) >--------------------------------------------------------------- d6d35bb37187390f4292213514b148956fd7fc80 compiler/ghc.cabal.in | 2 +- libraries/binary | 2 +- libraries/ghc-boot/ghc-boot.cabal.in | 2 +- libraries/ghci/ghci.cabal.in | 2 +- libraries/libiserv/libiserv.cabal | 2 +- utils/iserv/iserv.cabal | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 01628dc..bf2d190 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -54,7 +54,7 @@ Library directory >= 1 && < 1.4, process >= 1 && < 1.7, bytestring >= 0.9 && < 0.11, - binary == 0.8.*, + binary == 0.10.*, time >= 1.4 && < 1.9, containers >= 0.5 && < 0.7, array >= 0.1 && < 0.6, diff --git a/libraries/binary b/libraries/binary index ecf48c4..b5a2454 160000 --- a/libraries/binary +++ b/libraries/binary @@ -1 +1 @@ -Subproject commit ecf48c4589b927de3ae3fff8455c1c25140df7e9 +Subproject commit b5a2454e331ba516a14bed77e30f7ef8251eea48 diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in index 0ca9c1e..ca1c19f 100644 --- a/libraries/ghc-boot/ghc-boot.cabal.in +++ b/libraries/ghc-boot/ghc-boot.cabal.in @@ -43,7 +43,7 @@ Library GHC.HandleEncoding build-depends: base >= 4.7 && < 4.13, - binary == 0.8.*, + binary == 0.10.*, bytestring == 0.10.*, directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, diff --git a/libraries/ghci/ghci.cabal.in b/libraries/ghci/ghci.cabal.in index 32ce79c..d7f112e 100644 --- a/libraries/ghci/ghci.cabal.in +++ b/libraries/ghci/ghci.cabal.in @@ -70,7 +70,7 @@ library Build-Depends: array == 0.5.*, base >= 4.8 && < 4.13, - binary == 0.8.*, + binary == 0.10.*, bytestring == 0.10.*, containers >= 0.5 && < 0.7, deepseq == 1.4.*, diff --git a/libraries/libiserv/libiserv.cabal b/libraries/libiserv/libiserv.cabal index 183e777..fc0a022 100644 --- a/libraries/libiserv/libiserv.cabal +++ b/libraries/libiserv/libiserv.cabal @@ -21,7 +21,7 @@ Library Exposed-Modules: Lib , GHCi.Utils Build-Depends: base >= 4 && < 5, - binary >= 0.7 && < 0.9, + binary >= 0.7 && < 0.11, bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.7, deepseq >= 1.4 && < 1.5, diff --git a/utils/iserv/iserv.cabal b/utils/iserv/iserv.cabal index 684da94..6e78317 100644 --- a/utils/iserv/iserv.cabal +++ b/utils/iserv/iserv.cabal @@ -31,7 +31,7 @@ Executable iserv include-dirs: . Build-Depends: array >= 0.5 && < 0.6, base >= 4 && < 5, - binary >= 0.7 && < 0.9, + binary >= 0.7 && < 0.11, bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.7, deepseq >= 1.4 && < 1.5, From git at git.haskell.org Fri Aug 3 20:49:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:49:39 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: Bump filepath submodule (09ed015) Message-ID: <20180803204939.423C13A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/09ed015f8bbc2e05993fbe6859adbeb504714a85/ghc >--------------------------------------------------------------- commit 09ed015f8bbc2e05993fbe6859adbeb504714a85 Author: Ben Gamari Date: Thu Aug 2 17:56:30 2018 -0400 Bump filepath submodule (cherry picked from commit 9472db132d2e455c106778c7daa30af71fbf6fee) >--------------------------------------------------------------- 09ed015f8bbc2e05993fbe6859adbeb504714a85 libraries/filepath | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/filepath b/libraries/filepath index 1be834e..b10724b 160000 --- a/libraries/filepath +++ b/libraries/filepath @@ -1 +1 @@ -Subproject commit 1be834e1b3a3f8c5a14a58d73ce30133b4c69679 +Subproject commit b10724be8a907e191d153ad6674415be0c1325fd From git at git.haskell.org Fri Aug 3 20:49:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Aug 2018 20:49:42 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Force BUILD_SPHINX_*=YES (592a6a3) Message-ID: <20180803204942.121DF3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/592a6a37815f1a007b9ee36bc52c108f3379d82f/ghc >--------------------------------------------------------------- commit 592a6a37815f1a007b9ee36bc52c108f3379d82f Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Force BUILD_SPHINX_*=YES >--------------------------------------------------------------- 592a6a37815f1a007b9ee36bc52c108f3379d82f .circleci/prepare-system.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index df0da01..c9320ed 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -7,8 +7,6 @@ fail() { exit 1 } -echo 'BUILD_SPHINX_HTML = NO' > mk/validate.mk -echo 'BUILD_SPHINX_PDF = NO' >> mk/validate.mk hackage_index_state="@1522046735" cat > mk/build.mk < Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/c32b8356704d8a714a5520826c26718fc6608d13/ghc >--------------------------------------------------------------- commit c32b8356704d8a714a5520826c26718fc6608d13 Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx on Darwin >--------------------------------------------------------------- c32b8356704d8a714a5520826c26718fc6608d13 .circleci/prepare-system.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..b09f4f8 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -55,6 +55,7 @@ case "$(uname)" in # does not work. brew upgrade python brew install ghc cabal-install ncurses gmp + pip install sphinx cabal update cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state # put them on the $PATH, don't fail if already installed From git at git.haskell.org Sat Aug 4 12:00:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Aug 2018 12:00:38 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Install sphinx on Darwin (aba2a32) Message-ID: <20180804120038.E65AD3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/aba2a323d5974c26c4a01da5040325fe58ec1dba/ghc >--------------------------------------------------------------- commit aba2a323d5974c26c4a01da5040325fe58ec1dba Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx on Darwin >--------------------------------------------------------------- aba2a323d5974c26c4a01da5040325fe58ec1dba .circleci/prepare-system.sh | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..df3af88 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -54,7 +54,8 @@ case "$(uname)" in # It looks like we already have python2 here and just installing python3 # does not work. brew upgrade python - brew install ghc cabal-install ncurses gmp + brew install ghc cabal-install ncurses gmp pip + pip install sphinx cabal update cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state # put them on the $PATH, don't fail if already installed From git at git.haskell.org Sat Aug 4 15:19:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Aug 2018 15:19:42 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Install sphinx on Darwin (25e7ffc) Message-ID: <20180804151942.20EED3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/25e7ffcdde86e348b3fcca4777377e8977598217/ghc >--------------------------------------------------------------- commit 25e7ffcdde86e348b3fcca4777377e8977598217 Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx on Darwin >--------------------------------------------------------------- 25e7ffcdde86e348b3fcca4777377e8977598217 .circleci/prepare-system.sh | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..044e2d7 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -42,6 +42,7 @@ case "$(uname)" in fail "TARGET=$target not supported" fi else + apt-get install -qy sphinx-build cabal update cabal install --reinstall hscolour sudo ln -s /home/ghc/.cabal/bin/HsColour /usr/local/bin/HsColour || true @@ -55,6 +56,7 @@ case "$(uname)" in # does not work. brew upgrade python brew install ghc cabal-install ncurses gmp + pip3 install sphinx cabal update cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state # put them on the $PATH, don't fail if already installed From git at git.haskell.org Sat Aug 4 16:55:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Aug 2018 16:55:40 +0000 (UTC) Subject: [commit: ghc] wip/T15050: Merge branch 'master' of git://git.haskell.org/ghc into wip/T15050 (ae80bb2) Message-ID: <20180804165540.1F12A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15050 Link : http://ghc.haskell.org/trac/ghc/changeset/ae80bb23dd46488e6b5b20f97e5c0d55fe5b4718/ghc >--------------------------------------------------------------- commit ae80bb23dd46488e6b5b20f97e5c0d55fe5b4718 Merge: 2b8eb54 7535fd6 Author: Joachim Breitner Date: Sat Aug 4 12:23:40 2018 -0400 Merge branch 'master' of git://git.haskell.org/ghc into wip/T15050 >--------------------------------------------------------------- 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 ae80bb23dd46488e6b5b20f97e5c0d55fe5b4718 From git at git.haskell.org Sat Aug 4 16:55:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Aug 2018 16:55:42 +0000 (UTC) Subject: [commit: ghc] wip/T15050: Turn the comment next to SigTv into a proper Note (256d523) Message-ID: <20180804165542.F3CE13A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15050 Link : http://ghc.haskell.org/trac/ghc/changeset/256d5237764491cb1740aca5db1b70adaa5c5e18/ghc >--------------------------------------------------------------- commit 256d5237764491cb1740aca5db1b70adaa5c5e18 Author: Joachim Breitner Date: Sat Aug 4 12:43:22 2018 -0400 Turn the comment next to SigTv into a proper Note >--------------------------------------------------------------- 256d5237764491cb1740aca5db1b70adaa5c5e18 compiler/typecheck/TcHsType.hs | 2 +- compiler/typecheck/TcMType.hs | 44 ++++++++++++++++++++++++++++-------------- 2 files changed, 31 insertions(+), 15 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 5fceee9..4855d61 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1572,7 +1572,7 @@ kcLHsQTyVars name flav cusk | otherwise = do { (scoped_kvs, (tc_tvs, res_kind)) -- Why kcImplicitTKBndrs which uses newSigTyVar? - -- See Note [Kind generalisation and sigTvs] + -- See Note [Kind generalisation and SigTvs] <- kcImplicitTKBndrs kv_ns $ kcLHsQTyVarBndrs cusk open_fam skol_info hs_tvs thing_inside diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 3e77e43..a44b5e0 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -620,13 +620,28 @@ instead of the buggous ************************************************************************ -} --- a SigTv can unify with type *variables* only, including other SigTvs --- and skolems. Sometimes, they can unify with type variables that the --- user would rather keep distinct; see #11203 for an example. --- So, any client of this --- function needs to either allow the SigTvs to unify with each other --- (say, for pattern-bound scoped type variables), or check that they --- don't (say, with a call to findDubSigTvs). +{- +Note [SigTv] +~~~~~~~~~~~~ + +A SigTv can unify with type *variables* only, including other SigTvs and +skolems. Sometimes, they can unify with type variables that the user would +rather keep distinct; see #11203 for an example. So, any client of this +function needs to either allow the SigTvs to unify with each other or check +that they don't (say, with a call to findDubSigTvs). + +Before #15050 this was used for ScopedTypeVariables in patterns, to make sure +these type variables only refer to other type variables, but this restriction +was dropped, and ScopedTypeVariables can now refer to full types (GHC Proposal +29). + +The remaining uses of newSigTyVars are +* in kind signatures, see Note [Kind generalisation and SigTvs] + and Note [Use SigTvs in kind-checking pass] +* in partial type signatures, see Note [Quantified variables in partial type signatures] +-} + +-- see Note [SigTv] newSigTyVar :: Name -> Kind -> TcM TcTyVar newSigTyVar name kind = do { details <- newMetaDetails SigTv @@ -634,13 +649,6 @@ newSigTyVar name kind ; traceTc "newSigTyVar" (ppr tyvar) ; return tyvar } -newTauTyVar :: Name -> Kind -> TcM TcTyVar -newTauTyVar name kind - = do { details <- newMetaDetails TauTv - ; let tyvar = mkTcTyVar name kind details - ; traceTc "newTauTyVar" (ppr tyvar) - ; return tyvar } - -- makes a new skolem tv newSkolemTyVar :: Name -> Kind -> TcM TcTyVar @@ -815,6 +823,14 @@ coercion variables, except for the special case of the promoted Eq#. But, that can't ever appear in user code, so we're safe! -} +newTauTyVar :: Name -> Kind -> TcM TcTyVar +newTauTyVar name kind + = do { details <- newMetaDetails TauTv + ; let tyvar = mkTcTyVar name kind details + ; traceTc "newTauTyVar" (ppr tyvar) + ; return tyvar } + + mkMetaTyVarName :: Unique -> FastString -> Name -- Makes a /System/ Name, which is eagerly eliminated by -- the unifier; see TcUnify.nicer_to_update_tv1, and From git at git.haskell.org Sat Aug 4 16:55:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Aug 2018 16:55:45 +0000 (UTC) Subject: [commit: ghc] wip/T15050: Update Note [Pattern signature binders] (1aef2b9) Message-ID: <20180804165545.CCD593A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15050 Link : http://ghc.haskell.org/trac/ghc/changeset/1aef2b9682bf4e10016aacd05a71b0761e5a7b01/ghc >--------------------------------------------------------------- commit 1aef2b9682bf4e10016aacd05a71b0761e5a7b01 Author: Joachim Breitner Date: Sat Aug 4 12:48:37 2018 -0400 Update Note [Pattern signature binders] >--------------------------------------------------------------- 1aef2b9682bf4e10016aacd05a71b0761e5a7b01 compiler/typecheck/TcHsType.hs | 24 +++--------------------- 1 file changed, 3 insertions(+), 21 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 4855d61..d50c570 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -2423,7 +2423,6 @@ tcHsPatSigType ctxt sig_ty RuleSigCtxt {} -> newSkolemTyVar _ -> newTauTyVar -- See Note [Pattern signature binders] - -- See Note [Unifying SigTvs] mk_tv_pair tv = do { tv' <- zonkTcTyVarToTyVar tv ; return (tyVarName tv, tv') } @@ -2509,10 +2508,10 @@ Here TcErrors.getSkolemInfo can thereby find the binding site for the skolem. * The type signature pattern (f :: b->Int) makes a fresh meta-tyvar b_sig - (a SigTv), and binds "b" :-> b_sig in the envt + (a TauTv), and binds "b" :-> b_sig in the envt * Then unification makes b_sig := a_sk - That's why we must make b_sig a MetaTv (albeit a SigTv), + That's why we must make b_sig a MetaTv, not a SkolemTv, so that it can unify to a_sk. * Finally, in 'blah' we must have the envt "b" :-> a_sk. The pair @@ -2526,7 +2525,7 @@ When we reach the pattern signature, 'l' is in scope from the outer 'forall': "a" :-> a_sk :: * "l" :-> l_sk :: [a_sk] -We make up a fresh meta-SigTv, y_sig, for 'y', and kind-check +We make up a fresh meta-TauTv, y_sig, for 'y', and kind-check the pattern signature Sing (l :: [y]) That unifies y_sig := a_sk. We return from tcHsPatSigType with @@ -2538,23 +2537,6 @@ Here this really is the binding site of the type variable so we'd like to use a skolem, so that we get a complaint if we unify two of them together. -Note [Unifying SigTvs] -~~~~~~~~~~~~~~~~~~~~~~ -ALAS we have no decent way of avoiding two SigTvs getting unified. -Consider - f (x::(a,b)) (y::c)) = [fst x, y] -Here we'd really like to complain that 'a' and 'c' are unified. But -for the reasons above we can't make a,b,c into skolems, so they -are just SigTvs that can unify. And indeed, this would be ok, - f x (y::c) = case x of - (x1 :: a1, True) -> [x,y] - (x1 :: a2, False) -> [x,y,y] -Here the type of x's first component is called 'a1' in one branch and -'a2' in the other. We could try insisting on the same OccName, but -they definitely won't have the sane lexical Name. - -I think we could solve this by recording in a SigTv a list of all the -in-scope variables that it should not unify with, but it's fiddly. ************************************************************************ From git at git.haskell.org Sat Aug 4 16:55:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Aug 2018 16:55:49 +0000 (UTC) Subject: [commit: ghc] wip/T15050: Merge remote-tracking branch 'origin/wip/T15050' into wip/T15050 (499bde5) Message-ID: <20180804165549.281523A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15050 Link : http://ghc.haskell.org/trac/ghc/changeset/499bde5caaf303df98514afa721bac2c264f50f6/ghc >--------------------------------------------------------------- commit 499bde5caaf303df98514afa721bac2c264f50f6 Merge: 1aef2b9 b32988f Author: Joachim Breitner Date: Sat Aug 4 12:54:46 2018 -0400 Merge remote-tracking branch 'origin/wip/T15050' into wip/T15050 >--------------------------------------------------------------- 499bde5caaf303df98514afa721bac2c264f50f6 testsuite/tests/typecheck/should_compile/tc141.stderr | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) From git at git.haskell.org Sat Aug 4 16:55:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Aug 2018 16:55:52 +0000 (UTC) Subject: [commit: ghc] wip/T15050's head updated: Merge remote-tracking branch 'origin/wip/T15050' into wip/T15050 (499bde5) Message-ID: <20180804165552.491A63A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T15050' now includes: 5e63a25 aclocal.m4: narrow down 'riscv*' to 'riscv-*' and 'riscv32*' ab0c238 Fix a typo 2c38a6e Fix spelling errors 1f924cb Correct spelling errors 932300b Fix some typos in docs b290f15 testsuite: force plugin tests sequentially on Windows. d0bbe1b stack: fix stack allocations on Windows e175aaf fix osReserveHeapMemory block alignment 176abdf Small spelling fixes for Unify.hs 99f45e2 Fix #15423 by using pprAStmtContext f64f06b Avoid redundant invocation of 'findTopDir' b202e7a Fix the TcLevel not being set correctly when finding valid hole fits 5a49651 Harden fixST 4ea9311 Fix the GHCi debugger with ApplicativeDo f629442 Fix a major copy'n'paste error in LLVM CodeGen 3aa09cc Fix pretty-printing of data declarations in splices fd1cf1f Disable T10962 on llvm for now a606750 fixup! Disable T10962 on llvm for now af62407 Fix some casts. f0d27f5 Stop marking soluble ~R# constraints as insoluble e1b5a11 Fix a nasty bug in piResultTys 44a7b9b Suppress -Winaccessible-code in derived code 47561c9 Remove dead code in TcUnify 0dc86f6 Clone relevant constraints to avoid side-effects on HoleDests. Fixes #15370. 6c19112 Build more implications 12c0f03 Set GenSigCtxt for the argument part of tcSubType f7d3054 Improve error message on un-satisfied import c5d31df Treat isConstraintKind more consistently 857ef25 Fix and document cloneWC a434bcb tc-tracing only 0f5a63e Comments only 9897f67 Fix PrelRules.caseRules to account for out-of-range tags 4c571f3 Comments only f265008 Refactor (~) to reduce the suerpclass stack 45cfe65 Small refactor in desugar of pattern matching 890f646 Bump haddock submodule 7a3e1b2 rts: Flush eventlog in hs_init_ghc (fixes #15440) 25e1ea9 Make :doc work for the ghc library 13d40ff Add a script for running a ghci that can load and run ghc 774f366 Fail instead of panic-ing when qAddTopDecls has conversion error 3c311e5 Run StgCse after unarise, fixes #15300 e431d75 Fix gcCAFs() 3581212 Add an expect_broken test for #14185 e5f3de2 update core-spec for GRefl and re-factored Refl 60ecf43 Modifications to support loading GHC into GHCi ccdc032 rts: More forceful cc debugging flags 40e9ec9 Disable GNUC_ATTR_HOT when compiling with DEBUG d7cb1bb Fix endian issues in ghc-heap 2cb08d7 Remove dead code in testsuite driver 754c3a5 Fix Ar crashing on odd-sized object files (Trac #15396) 3539561 Fix Git commit ID detection in Git worktrees 11de438 Fix #15453: bug in ForAllCo case in opt_trans_rule 9d388eb Fix #15385 by using addDictsDs in matchGuards a7c8acd GHC doesn't handle ./ prefixed paths correctly (#12674) c626246 Bump terminfo submodule to 0.4.1.2 a698bbf Fix minor formatting issue in users_guide/bugs.rst 56590db base: Make Foreign.Marshal.Alloc.allocBytes[Aligned] NOINLINE 2110738 Don't inline functions with RULES too early 3a06561 Add the paper "Evidence normalisation in System FC" 80b8540 rts: Disable -fkeep-inline-functions due to lack of support on Clang 123aeb9 Enable two-step allocator on FreeBSD cb8efe7 doc: Fix command for creating a shared library. 6d2a9ec Bump Cabal submodule f8e5da9 testsuite: Add test for #14346 0e34a9f users-guide: Document default +RTS -I value 5e103a1 base: Fix documentation of System.Environment.Blank 9bd4864 rts: Fix unused function 1df50a0 Revert "Don't inline functions with RULES too early" f8618a9 Remove the type-checking knot. 52065e9 Plugin dependency information is stored separately b803c40 linker: Nub rpaths 7f3cb50 Fix #15450 by refactoring checkEmptyCase' 120cc9f Fix #15415 and simplify tcWildCardBinders c50574a Remove obsolete file c955a51 Remove decideKindGeneralisationPlan 653dc5f Bump Cabal submodule 8d04822 Bump binary submodule 7535fd6 Bump filepath submodule ae80bb2 Merge branch 'master' of git://git.haskell.org/ghc into wip/T15050 256d523 Turn the comment next to SigTv into a proper Note 1aef2b9 Update Note [Pattern signature binders] 499bde5 Merge remote-tracking branch 'origin/wip/T15050' into wip/T15050 From git at git.haskell.org Sat Aug 4 19:27:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Aug 2018 19:27:11 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Install sphinx (9d1f50c) Message-ID: <20180804192711.038103A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/9d1f50c022183277965fbb0b6e6fbc56d110012a/ghc >--------------------------------------------------------------- commit 9d1f50c022183277965fbb0b6e6fbc56d110012a Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx >--------------------------------------------------------------- 9d1f50c022183277965fbb0b6e6fbc56d110012a .circleci/prepare-system.sh | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..bb675f5 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -42,6 +42,11 @@ case "$(uname)" in fail "TARGET=$target not supported" fi else + if [[ -e yum ]]; then + yum install sphinx-build + else + apt-get install -qy sphinx-build + fi cabal update cabal install --reinstall hscolour sudo ln -s /home/ghc/.cabal/bin/HsColour /usr/local/bin/HsColour || true @@ -55,6 +60,7 @@ case "$(uname)" in # does not work. brew upgrade python brew install ghc cabal-install ncurses gmp + pip3 install sphinx cabal update cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state # put them on the $PATH, don't fail if already installed From git at git.haskell.org Sat Aug 4 22:40:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Aug 2018 22:40:48 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Install sphinx (8765cc3) Message-ID: <20180804224048.9A9E03A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/8765cc377969b3ca1c5154e1add52dd4b6370fa2/ghc >--------------------------------------------------------------- commit 8765cc377969b3ca1c5154e1add52dd4b6370fa2 Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx >--------------------------------------------------------------- 8765cc377969b3ca1c5154e1add52dd4b6370fa2 .circleci/prepare-system.sh | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..56503ab 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -42,6 +42,11 @@ case "$(uname)" in fail "TARGET=$target not supported" fi else + if [[ -e yum ]]; then + yum install sphinx-build + else + sudo apt-get install -qy sphinx-build + fi cabal update cabal install --reinstall hscolour sudo ln -s /home/ghc/.cabal/bin/HsColour /usr/local/bin/HsColour || true @@ -55,6 +60,7 @@ case "$(uname)" in # does not work. brew upgrade python brew install ghc cabal-install ncurses gmp + pip3 install sphinx cabal update cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state # put them on the $PATH, don't fail if already installed From git at git.haskell.org Sat Aug 4 22:43:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Aug 2018 22:43:11 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Install sphinx (8a7f813) Message-ID: <20180804224311.0651A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/8a7f8136b1868a5f5dbb281bf395d4ca3de3f82c/ghc >--------------------------------------------------------------- commit 8a7f8136b1868a5f5dbb281bf395d4ca3de3f82c Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx >--------------------------------------------------------------- 8a7f8136b1868a5f5dbb281bf395d4ca3de3f82c .circleci/prepare-system.sh | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..488673e 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -42,6 +42,11 @@ case "$(uname)" in fail "TARGET=$target not supported" fi else + if [[ -e yum ]]; then + yum install sphinx-build + else + sudo apt-get install -qy sphinx-doc + fi cabal update cabal install --reinstall hscolour sudo ln -s /home/ghc/.cabal/bin/HsColour /usr/local/bin/HsColour || true @@ -55,6 +60,7 @@ case "$(uname)" in # does not work. brew upgrade python brew install ghc cabal-install ncurses gmp + pip3 install sphinx cabal update cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state # put them on the $PATH, don't fail if already installed From git at git.haskell.org Sat Aug 4 22:46:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Aug 2018 22:46:31 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Install sphinx (7925898) Message-ID: <20180804224631.022243A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/7925898f5d4901d2c949bce5fb40b16b917cc33b/ghc >--------------------------------------------------------------- commit 7925898f5d4901d2c949bce5fb40b16b917cc33b Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx >--------------------------------------------------------------- 7925898f5d4901d2c949bce5fb40b16b917cc33b .circleci/prepare-system.sh | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..f6e049a 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -42,6 +42,12 @@ case "$(uname)" in fail "TARGET=$target not supported" fi else + if [[ -e yum ]]; then + yum install sphinx-build + else + sudo apt-get update -qq + sudo apt-get install -qy sphinx-doc + fi cabal update cabal install --reinstall hscolour sudo ln -s /home/ghc/.cabal/bin/HsColour /usr/local/bin/HsColour || true @@ -55,6 +61,7 @@ case "$(uname)" in # does not work. brew upgrade python brew install ghc cabal-install ncurses gmp + pip3 install sphinx cabal update cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state # put them on the $PATH, don't fail if already installed From git at git.haskell.org Sat Aug 4 22:57:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Aug 2018 22:57:11 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Install sphinx (320f703) Message-ID: <20180804225711.771423A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/320f70332e4f74500b7501dcfe49de3870094101/ghc >--------------------------------------------------------------- commit 320f70332e4f74500b7501dcfe49de3870094101 Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx >--------------------------------------------------------------- 320f70332e4f74500b7501dcfe49de3870094101 .circleci/prepare-system.sh | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..fda2f64 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -42,6 +42,12 @@ case "$(uname)" in fail "TARGET=$target not supported" fi else + if [[ -e yum ]]; then + yum install sphinx-build + else + sudo apt-get update -qq + sudo apt-get install -qy python3-sphinx + fi cabal update cabal install --reinstall hscolour sudo ln -s /home/ghc/.cabal/bin/HsColour /usr/local/bin/HsColour || true @@ -55,6 +61,7 @@ case "$(uname)" in # does not work. brew upgrade python brew install ghc cabal-install ncurses gmp + pip3 install sphinx cabal update cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state # put them on the $PATH, don't fail if already installed From git at git.haskell.org Sat Aug 4 23:08:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Aug 2018 23:08:50 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Bump T3064 expected allocations (8801642) Message-ID: <20180804230850.6D9353A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/880164257914087bcecd2bbe41a56206dff5d19e/ghc >--------------------------------------------------------------- commit 880164257914087bcecd2bbe41a56206dff5d19e Author: Ben Gamari Date: Sat Aug 4 19:08:01 2018 -0400 testsuite: Bump T3064 expected allocations >--------------------------------------------------------------- 880164257914087bcecd2bbe41a56206dff5d19e testsuite/tests/perf/compiler/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 3488a59..cc8f814 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -340,7 +340,7 @@ test('T3064', # 2016-04-06: 153261024 (x86/Linux) probably wildcard refactor # 2017-03-24: 134044092 (x86/Linux, 64-bit machine) Update - (wordsize(64), 258505536, 5)]), + (wordsize(64), 272759920, 5)]), # (amd64/Linux) (2011-06-28): 73259544 # (amd64/Linux) (2013-02-07): 224798696 # (amd64/Linux) (2013-08-02): 236404384, increase from roles @@ -368,6 +368,7 @@ test('T3064', # (amd64/Linux) (2017-03-31): 265950920 Fix memory leak in simplifier # (amd64/Linux) (2017-05-01): 281509496 Avoid excessive space usage from unfoldings in CoreTidy # (amd64/Linux) (2017-05-01): 258505536 I think this is improvement in coercionKind e4ab65bd + # (amd64/Linux) (2018-08-04): 272759920 It's unclear ################################### # deactivated for now, as this metric became too volatile recently From git at git.haskell.org Sat Aug 4 23:11:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Aug 2018 23:11:50 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Install sphinx (582616e) Message-ID: <20180804231150.AEB303A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/582616ee55489d030a12897360361da633101608/ghc >--------------------------------------------------------------- commit 582616ee55489d030a12897360361da633101608 Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx >--------------------------------------------------------------- 582616ee55489d030a12897360361da633101608 .circleci/prepare-system.sh | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..96fb015 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -42,6 +42,12 @@ case "$(uname)" in fail "TARGET=$target not supported" fi else + if [[ -e yum ]]; then + yum install sphinx-build + else + sudo apt-get update -qq + sudo apt-get install -qy python3-sphinx texlive-xetex + fi cabal update cabal install --reinstall hscolour sudo ln -s /home/ghc/.cabal/bin/HsColour /usr/local/bin/HsColour || true @@ -55,6 +61,7 @@ case "$(uname)" in # does not work. brew upgrade python brew install ghc cabal-install ncurses gmp + pip3 install sphinx cabal update cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state # put them on the $PATH, don't fail if already installed From git at git.haskell.org Sun Aug 5 12:29:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Aug 2018 12:29:35 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Install sphinx (7081ded) Message-ID: <20180805122935.920233A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/7081ded9fc3133e1e712053e3da3a9be0f8d5115/ghc >--------------------------------------------------------------- commit 7081ded9fc3133e1e712053e3da3a9be0f8d5115 Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx >--------------------------------------------------------------- 7081ded9fc3133e1e712053e3da3a9be0f8d5115 .circleci/prepare-system.sh | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..45564ea 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -22,6 +22,17 @@ EOF case "$(uname)" in Linux) + # Install documentation tools + if [[ -e dnf ]]; then + dnf -y install sphinx-build \ + texlive texlive-latex texlive-xetex \ + texlive-collection-latex texlive-collection-latexrecommended \ + texlive-xetex-def texlive-collection-xetex + else + sudo apt-get update -qq + sudo apt-get install -qy python3-sphinx texlive-xetex + fi + if [[ -n ${TARGET:-} ]]; then if [[ $TARGET = FreeBSD ]]; then # cross-compiling to FreeBSD @@ -47,6 +58,7 @@ case "$(uname)" in sudo ln -s /home/ghc/.cabal/bin/HsColour /usr/local/bin/HsColour || true fi ;; + Darwin) if [[ -n ${TARGET:-} ]]; then fail "uname=$(uname) not supported for cross-compilation" @@ -55,6 +67,7 @@ case "$(uname)" in # does not work. brew upgrade python brew install ghc cabal-install ncurses gmp + pip3 install sphinx cabal update cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state # put them on the $PATH, don't fail if already installed From git at git.haskell.org Sun Aug 5 12:43:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Aug 2018 12:43:57 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Install sphinx and TexLive (7516dc1) Message-ID: <20180805124357.5676A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/7516dc1664df72119d4590822b67a6a7555f6723/ghc >--------------------------------------------------------------- commit 7516dc1664df72119d4590822b67a6a7555f6723 Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx and TexLive >--------------------------------------------------------------- 7516dc1664df72119d4590822b67a6a7555f6723 .circleci/prepare-system.sh | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..4644cf4 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -22,6 +22,17 @@ EOF case "$(uname)" in Linux) + # Install documentation tools + if [[ -e dnf ]]; then + dnf -y install sphinx-build \ + texlive texlive-latex texlive-xetex \ + texlive-collection-latex texlive-collection-latexrecommended \ + texlive-xetex-def texlive-collection-xetex + else + sudo apt-get update -qq + sudo apt-get install -qy python3-sphinx texlive-xetex + fi + if [[ -n ${TARGET:-} ]]; then if [[ $TARGET = FreeBSD ]]; then # cross-compiling to FreeBSD @@ -47,6 +58,7 @@ case "$(uname)" in sudo ln -s /home/ghc/.cabal/bin/HsColour /usr/local/bin/HsColour || true fi ;; + Darwin) if [[ -n ${TARGET:-} ]]; then fail "uname=$(uname) not supported for cross-compilation" @@ -55,6 +67,9 @@ case "$(uname)" in # does not work. brew upgrade python brew install ghc cabal-install ncurses gmp + brew install caskroom/cask/brew-cask + brew cask install mactex + pip3 install sphinx cabal update cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state # put them on the $PATH, don't fail if already installed From git at git.haskell.org Sun Aug 5 12:45:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Aug 2018 12:45:27 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Install sphinx and TexLive (2073719) Message-ID: <20180805124527.0C8993A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/20737199bf7fdc622cd048e467eb458ebffbe7ec/ghc >--------------------------------------------------------------- commit 20737199bf7fdc622cd048e467eb458ebffbe7ec Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx and TexLive >--------------------------------------------------------------- 20737199bf7fdc622cd048e467eb458ebffbe7ec .circleci/prepare-system.sh | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..1cdea61 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -22,6 +22,17 @@ EOF case "$(uname)" in Linux) + # Install documentation tools + if [[ -e yum ]]; then + yum -y install sphinx-build \ + texlive texlive-latex texlive-xetex \ + texlive-collection-latex texlive-collection-latexrecommended \ + texlive-xetex-def texlive-collection-xetex + else + sudo apt-get update -qq + sudo apt-get install -qy python3-sphinx texlive-xetex + fi + if [[ -n ${TARGET:-} ]]; then if [[ $TARGET = FreeBSD ]]; then # cross-compiling to FreeBSD @@ -47,6 +58,7 @@ case "$(uname)" in sudo ln -s /home/ghc/.cabal/bin/HsColour /usr/local/bin/HsColour || true fi ;; + Darwin) if [[ -n ${TARGET:-} ]]; then fail "uname=$(uname) not supported for cross-compilation" @@ -55,6 +67,9 @@ case "$(uname)" in # does not work. brew upgrade python brew install ghc cabal-install ncurses gmp + brew install caskroom/cask/brew-cask + brew cask install mactex + pip3 install sphinx cabal update cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state # put them on the $PATH, don't fail if already installed From git at git.haskell.org Sun Aug 5 14:13:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Aug 2018 14:13:02 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Install sphinx and TexLive (309be88) Message-ID: <20180805141302.A83BA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/309be88e26ade488fddd642322d307df4d4a3f70/ghc >--------------------------------------------------------------- commit 309be88e26ade488fddd642322d307df4d4a3f70 Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx and TexLive >--------------------------------------------------------------- 309be88e26ade488fddd642322d307df4d4a3f70 .circleci/config.yml | 10 ++++----- .circleci/images/update.sh | 29 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 12 +++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 ++++++++- .circleci/prepare-system.sh | 3 +++ 5 files changed, 57 insertions(+), 7 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index e52d38d..7a69381 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -93,7 +93,7 @@ jobs: "validate-x86_64-linux": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv GHC_COLLECTOR_FLAVOR: x86_64-linux @@ -154,7 +154,7 @@ jobs: "validate-hadrian-x86_64-linux": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv steps: @@ -184,7 +184,7 @@ jobs: "validate-x86_64-linux-llvm": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv BUILD_FLAVOUR: perf-llvm @@ -209,7 +209,7 @@ jobs: "validate-x86_64-linux-debug": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: BUILD_FLAVOUR: devel2 <<: *buildenv @@ -226,7 +226,7 @@ jobs: "validate-i386-linux": resource_class: xlarge docker: - - image: ghcci/i386-linux:0.0.2 + - image: ghcci/i386-linux:0.0.3 environment: <<: *buildenv GHC_COLLECTOR_FLAVOR: i386-linux diff --git a/.circleci/images/update.sh b/.circleci/images/update.sh new file mode 100644 index 0000000..4d99092 --- /dev/null +++ b/.circleci/images/update.sh @@ -0,0 +1,29 @@ +#!/usr/bin/env bash + +set -e + +repo=ghcci + +if [[ $# != 2 ]]; then + echo "Usage: $0 DIR VERSION" + echo + echo "Update Docker image in DIR, pushing it to the $repo repository as" + echo "version VERSION" + echo + echo "Example: $0 x86_64-linux-fedora 0.0.3" + exit 1 +fi + +name=$1 +version=$2 + +if curl -s https://registry.hub.docker.com/v1/repositories/$repo/$name/tags | jq -r .[].name | grep $version > /dev/null; then + echo "Version $version of $name already exists" + exit 1 +fi + +docker build $name -t $repo/$name:$version +docker push $repo/$name:$version + +sed -i -e "s%$repo/$name:[0-9]+(\.[0-9]+)*%$repo/$name:$version%" ../config.yml +echo "Built, pushed, and bumped $name:$version" diff --git a/.circleci/images/x86_64-linux-fedora/Dockerfile b/.circleci/images/x86_64-linux-fedora/Dockerfile index d976950..70253a0 100644 --- a/.circleci/images/x86_64-linux-fedora/Dockerfile +++ b/.circleci/images/x86_64-linux-fedora/Dockerfile @@ -2,7 +2,17 @@ FROM fedora:27 ENV LANG C.UTF-8 -RUN dnf -y install coreutils binutils which git make automake autoconf gcc perl python3 texinfo xz lbzip2 patch openssh-clients sudo curl zlib-devel sqlite ncurses-compat-libs gmp-devel ncurses-devel gcc-c++ findutils +# Core build utilities +RUN dnf -y install coreutils binutils which git make \ + automake autoconf gcc perl python3 texinfo xz lbzip2 \ + patch openssh-clients sudo curl zlib-devel sqlite \ + ncurses-compat-libs gmp-devel ncurses-devel gcc-c++ findutils + +# Documentation tools +RUN dnf -y install sphinx \ + texlive texlive-latex texlive-xetex \ + texlive-collection-latex texlive-collection-latexrecommended \ + texlive-xetex-def texlive-collection-xetex # systemd isn't running so remove it from nsswitch.conf # Failing to do this will result in testsuite failures due to diff --git a/.circleci/images/x86_64-linux/Dockerfile b/.circleci/images/x86_64-linux/Dockerfile index 512338b..4303e4d 100644 --- a/.circleci/images/x86_64-linux/Dockerfile +++ b/.circleci/images/x86_64-linux/Dockerfile @@ -5,7 +5,15 @@ ENV LANG C.UTF-8 RUN echo 'deb http://ppa.launchpad.net/hvr/ghc/ubuntu trusty main' > /etc/apt/sources.list.d/ghc.list RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys F6F88286 RUN apt-get update -qq -RUN apt-get install -qy cabal-install-2.2 ghc-8.4.2 happy alex zlib1g-dev libtinfo-dev libsqlite3-0 libsqlite3-dev ca-certificates g++ git curl git make automake autoconf gcc perl python3 texinfo xz-utils lbzip2 patch openssh-client sudo + +# Core build utilities +RUN apt-get install -qy cabal-install-2.2 ghc-8.4.2 happy alex zlib1g-dev \ + libtinfo-dev libsqlite3-0 libsqlite3-dev ca-certificates g++ git curl \ + git make automake autoconf gcc perl python3 texinfo xz-utils lbzip2 \ + patch openssh-client sudo + +# Documentation tools +RUN apt-get install -qy python3-sphinx texlive-xetex # Stack intallation RUN curl -fSL https://github.com/commercialhaskell/stack/releases/download/v1.6.5/stack-1.6.5-linux-x86_64-static.tar.gz -o stack.tar.gz diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..1b1a85f 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -47,6 +47,7 @@ case "$(uname)" in sudo ln -s /home/ghc/.cabal/bin/HsColour /usr/local/bin/HsColour || true fi ;; + Darwin) if [[ -n ${TARGET:-} ]]; then fail "uname=$(uname) not supported for cross-compilation" @@ -55,6 +56,8 @@ case "$(uname)" in # does not work. brew upgrade python brew install ghc cabal-install ncurses gmp + brew cask install mactex + pip3 install sphinx cabal update cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state # put them on the $PATH, don't fail if already installed From git at git.haskell.org Sun Aug 5 14:25:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Aug 2018 14:25:33 +0000 (UTC) Subject: [commit: hadrian] master: Remove the hack to use a patched Cabal submodule in CI (#650) (148006a) Message-ID: <20180805142533.755E83A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/148006a03eae0e91a17d4fd08b541a12fe5ece1b >--------------------------------------------------------------- commit 148006a03eae0e91a17d4fd08b541a12fe5ece1b Author: quasicomputational Date: Tue Jul 31 22:45:31 2018 +0100 Remove the hack to use a patched Cabal submodule in CI (#650) The fix has landed in GHC HEAD. Closes #634. >--------------------------------------------------------------- 148006a03eae0e91a17d4fd08b541a12fe5ece1b .travis.yml | 7 ------- appveyor.yml | 7 ------- circle.yml | 4 ---- 3 files changed, 18 deletions(-) diff --git a/.travis.yml b/.travis.yml index 8416e00..f80bca6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -104,13 +104,6 @@ install: - mv .git ghc/hadrian - cd ghc/hadrian && git reset --hard HEAD && cd .. - # We checkout a patched Cabal. - # See: https://github.com/snowleopard/hadrian/issues/634 - - cd libraries/Cabal/ - - git remote add quasicomputational https://github.com/quasicomputational/cabal.git - - git fetch quasicomputational && git checkout cwd-independent-check - - cd ../../ - cache: directories: - $HOME/.cabal diff --git a/appveyor.yml b/appveyor.yml index a1ac6c4..1a18abe 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -20,13 +20,6 @@ install: # Copy new Hadrian into ./ghc/hadrian - cp -r new-hadrian ghc\hadrian - # We checkout a patched Cabal. - # See: https://github.com/snowleopard/hadrian/issues/634 - - cd ghc/libraries/Cabal/ - - git remote add quasicomputational https://github.com/quasicomputational/cabal.git - - git fetch quasicomputational && git checkout cwd-independent-check - - cd ../../../ - # Install Alex and Happy - set PATH=C:\Users\appveyor\AppData\Roaming\local\bin;%PATH% - ghc\hadrian\stack install --install-ghc alex happy > nul diff --git a/circle.yml b/circle.yml index 998e46d..10b9094 100644 --- a/circle.yml +++ b/circle.yml @@ -31,10 +31,6 @@ compile: # in CircleCI is a separate process, thus you can't "cd" for the other lines - cd ghc/hadrian; git reset --hard HEAD - # We checkout a patched Cabal. - # See: https://github.com/snowleopard/hadrian/issues/634 - - cd ghc/libraries/Cabal/ && git remote add quasicomputational https://github.com/quasicomputational/cabal.git && git fetch quasicomputational && git checkout cwd-independent-check - - cd ghc; ./boot && PATH=~/.cabal/bin:$PATH ./configure # XXX: export PATH doesn't work well either, so we use inline env From git at git.haskell.org Sun Aug 5 14:25:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Aug 2018 14:25:35 +0000 (UTC) Subject: [commit: hadrian] master: Bump Cabal upper bound (#651) (4265e3a) Message-ID: <20180805142535.79F043A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/4265e3aab7df92722b81148cf8bf3954ebfc2d21 >--------------------------------------------------------------- commit 4265e3aab7df92722b81148cf8bf3954ebfc2d21 Author: Ben Gamari Date: Sat Aug 4 20:22:24 2018 -0400 Bump Cabal upper bound (#651) >--------------------------------------------------------------- 4265e3aab7df92722b81148cf8bf3954ebfc2d21 hadrian.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian.cabal b/hadrian.cabal index 469bc67..b0ea033 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -113,7 +113,7 @@ executable hadrian other-extensions: MultiParamTypeClasses , TypeFamilies build-depends: base >= 4.8 && < 5 - , Cabal >= 2.3 && < 2.4 + , Cabal >= 2.4 && < 2.5 , containers == 0.5.* , directory >= 1.2 && < 1.4 , extra >= 1.4.7 From git at git.haskell.org Sun Aug 5 14:49:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Aug 2018 14:49:55 +0000 (UTC) Subject: [commit: ghc] master: Bump hadrian submodule (47e54a0) Message-ID: <20180805144955.223B83A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/47e54a0902eb9b3bbb234ed8a37266b55d86e866/ghc >--------------------------------------------------------------- commit 47e54a0902eb9b3bbb234ed8a37266b55d86e866 Author: Ben Gamari Date: Sun Aug 5 10:27:40 2018 -0400 Bump hadrian submodule >--------------------------------------------------------------- 47e54a0902eb9b3bbb234ed8a37266b55d86e866 hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index a63ad32..4265e3a 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit a63ad3294b5d51eec50d454810a314c0b2a696c7 +Subproject commit 4265e3aab7df92722b81148cf8bf3954ebfc2d21 From git at git.haskell.org Sun Aug 5 14:49:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Aug 2018 14:49:57 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: Bump hadrian submodule (b39a2a8) Message-ID: <20180805144957.F0C763A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/b39a2a8685bb360eec0c85c9edb80fe70daf4a06/ghc >--------------------------------------------------------------- commit b39a2a8685bb360eec0c85c9edb80fe70daf4a06 Author: Ben Gamari Date: Sun Aug 5 10:24:30 2018 -0400 Bump hadrian submodule >--------------------------------------------------------------- b39a2a8685bb360eec0c85c9edb80fe70daf4a06 hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index a63ad32..4265e3a 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit a63ad3294b5d51eec50d454810a314c0b2a696c7 +Subproject commit 4265e3aab7df92722b81148cf8bf3954ebfc2d21 From git at git.haskell.org Sun Aug 5 14:50:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Aug 2018 14:50:01 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Install sphinx and TexLive (fb70a63) Message-ID: <20180805145001.48CB73A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/fb70a6360d58408d3a447d27c4e2760c0fc80308/ghc >--------------------------------------------------------------- commit fb70a6360d58408d3a447d27c4e2760c0fc80308 Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx and TexLive >--------------------------------------------------------------- fb70a6360d58408d3a447d27c4e2760c0fc80308 .circleci/config.yml | 12 +++++----- .circleci/images/update.sh | 29 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 12 +++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 ++++++++- .circleci/prepare-system.sh | 11 +++++++--- 5 files changed, 64 insertions(+), 10 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index e52d38d..f79e8c6 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -93,7 +93,7 @@ jobs: "validate-x86_64-linux": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv GHC_COLLECTOR_FLAVOR: x86_64-linux @@ -133,6 +133,8 @@ jobs: macos: xcode: "9.0" environment: + # Disable sphinx PDF output as MacTeX apparently doesn't provide xelatex + BUILD_SPHINX_PDF: "NO" MACOSX_DEPLOYMENT_TARGET: "10.7" # Only Sierra and onwards supports clock_gettime. See #12858 ac_cv_func_clock_gettime: "no" @@ -154,7 +156,7 @@ jobs: "validate-hadrian-x86_64-linux": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv steps: @@ -184,7 +186,7 @@ jobs: "validate-x86_64-linux-llvm": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv BUILD_FLAVOUR: perf-llvm @@ -209,7 +211,7 @@ jobs: "validate-x86_64-linux-debug": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: BUILD_FLAVOUR: devel2 <<: *buildenv @@ -226,7 +228,7 @@ jobs: "validate-i386-linux": resource_class: xlarge docker: - - image: ghcci/i386-linux:0.0.2 + - image: ghcci/i386-linux:0.0.3 environment: <<: *buildenv GHC_COLLECTOR_FLAVOR: i386-linux diff --git a/.circleci/images/update.sh b/.circleci/images/update.sh new file mode 100644 index 0000000..4d99092 --- /dev/null +++ b/.circleci/images/update.sh @@ -0,0 +1,29 @@ +#!/usr/bin/env bash + +set -e + +repo=ghcci + +if [[ $# != 2 ]]; then + echo "Usage: $0 DIR VERSION" + echo + echo "Update Docker image in DIR, pushing it to the $repo repository as" + echo "version VERSION" + echo + echo "Example: $0 x86_64-linux-fedora 0.0.3" + exit 1 +fi + +name=$1 +version=$2 + +if curl -s https://registry.hub.docker.com/v1/repositories/$repo/$name/tags | jq -r .[].name | grep $version > /dev/null; then + echo "Version $version of $name already exists" + exit 1 +fi + +docker build $name -t $repo/$name:$version +docker push $repo/$name:$version + +sed -i -e "s%$repo/$name:[0-9]+(\.[0-9]+)*%$repo/$name:$version%" ../config.yml +echo "Built, pushed, and bumped $name:$version" diff --git a/.circleci/images/x86_64-linux-fedora/Dockerfile b/.circleci/images/x86_64-linux-fedora/Dockerfile index d976950..70253a0 100644 --- a/.circleci/images/x86_64-linux-fedora/Dockerfile +++ b/.circleci/images/x86_64-linux-fedora/Dockerfile @@ -2,7 +2,17 @@ FROM fedora:27 ENV LANG C.UTF-8 -RUN dnf -y install coreutils binutils which git make automake autoconf gcc perl python3 texinfo xz lbzip2 patch openssh-clients sudo curl zlib-devel sqlite ncurses-compat-libs gmp-devel ncurses-devel gcc-c++ findutils +# Core build utilities +RUN dnf -y install coreutils binutils which git make \ + automake autoconf gcc perl python3 texinfo xz lbzip2 \ + patch openssh-clients sudo curl zlib-devel sqlite \ + ncurses-compat-libs gmp-devel ncurses-devel gcc-c++ findutils + +# Documentation tools +RUN dnf -y install sphinx \ + texlive texlive-latex texlive-xetex \ + texlive-collection-latex texlive-collection-latexrecommended \ + texlive-xetex-def texlive-collection-xetex # systemd isn't running so remove it from nsswitch.conf # Failing to do this will result in testsuite failures due to diff --git a/.circleci/images/x86_64-linux/Dockerfile b/.circleci/images/x86_64-linux/Dockerfile index 512338b..4303e4d 100644 --- a/.circleci/images/x86_64-linux/Dockerfile +++ b/.circleci/images/x86_64-linux/Dockerfile @@ -5,7 +5,15 @@ ENV LANG C.UTF-8 RUN echo 'deb http://ppa.launchpad.net/hvr/ghc/ubuntu trusty main' > /etc/apt/sources.list.d/ghc.list RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys F6F88286 RUN apt-get update -qq -RUN apt-get install -qy cabal-install-2.2 ghc-8.4.2 happy alex zlib1g-dev libtinfo-dev libsqlite3-0 libsqlite3-dev ca-certificates g++ git curl git make automake autoconf gcc perl python3 texinfo xz-utils lbzip2 patch openssh-client sudo + +# Core build utilities +RUN apt-get install -qy cabal-install-2.2 ghc-8.4.2 happy alex zlib1g-dev \ + libtinfo-dev libsqlite3-0 libsqlite3-dev ca-certificates g++ git curl \ + git make automake autoconf gcc perl python3 texinfo xz-utils lbzip2 \ + patch openssh-client sudo + +# Documentation tools +RUN apt-get install -qy python3-sphinx texlive-xetex # Stack intallation RUN curl -fSL https://github.com/commercialhaskell/stack/releases/download/v1.6.5/stack-1.6.5-linux-x86_64-static.tar.gz -o stack.tar.gz diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..08769f2 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -9,14 +9,16 @@ fail() { hackage_index_state="@1522046735" +if [[ -z "$BUILD_SPHINX_HTML" ]]; then BUILD_SPHINX_HTML=YES; fi +if [[ -z "$BUILD_SPHINX_PDF" ]]; then BUILD_SPHINX_PDF=YES; fi + cat > mk/build.mk < Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/73683f143d352343b00b1ab4f3abeb38b81794be/ghc >--------------------------------------------------------------- commit 73683f143d352343b00b1ab4f3abeb38b81794be Author: vrom911 Date: Sun Aug 5 15:28:25 2018 +0200 Refactor printMinimalImports (#15439) Summary: Split into getMinimalImports and printMinimalImports. Export both functions from RnNames module. Reviewers: bgamari, mpickering Reviewed By: mpickering Subscribers: mpickering, rwbarton, carter GHC Trac Issues: #15439 Differential Revision: https://phabricator.haskell.org/D5045 >--------------------------------------------------------------- 73683f143d352343b00b1ab4f3abeb38b81794be compiler/rename/RnNames.hs | 48 ++++++++++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 21 deletions(-) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 6b24d80..8d3f183 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -22,6 +22,8 @@ module RnNames ( dodgyMsg, dodgyMsgInsert, findImportUsage, + getMinimalImports, + printMinimalImports, ImportDeclUsage ) where @@ -1466,28 +1468,9 @@ decls, and simply trim their import lists. NB that from it. Instead we just trim to an empty import list -} -printMinimalImports :: [ImportDeclUsage] -> RnM () --- See Note [Printing minimal imports] -printMinimalImports imports_w_usage - = do { imports' <- mapM mk_minimal imports_w_usage - ; this_mod <- getModule - ; dflags <- getDynFlags - ; liftIO $ - do { h <- openFile (mkFilename dflags this_mod) WriteMode - ; printForUser dflags h neverQualify (vcat (map ppr imports')) } - -- The neverQualify is important. We are printing Names - -- but they are in the context of an 'import' decl, and - -- we never qualify things inside there - -- E.g. import Blag( f, b ) - -- not import Blag( Blag.f, Blag.g )! - } +getMinimalImports :: [ImportDeclUsage] -> RnM [LImportDecl GhcRn] +getMinimalImports = mapM mk_minimal where - mkFilename dflags this_mod - | Just d <- dumpDir dflags = d basefn - | otherwise = basefn - where - basefn = moduleNameString (moduleName this_mod) ++ ".imports" - mk_minimal (L l decl, used, unused) | null unused , Just (False, _) <- ideclHiding decl @@ -1538,6 +1521,29 @@ printMinimalImports imports_w_usage all_non_overloaded = all (not . flIsOverloaded) +printMinimalImports :: [ImportDeclUsage] -> RnM () +-- See Note [Printing minimal imports] +printMinimalImports imports_w_usage + = do { imports' <- getMinimalImports imports_w_usage + ; this_mod <- getModule + ; dflags <- getDynFlags + ; liftIO $ + do { h <- openFile (mkFilename dflags this_mod) WriteMode + ; printForUser dflags h neverQualify (vcat (map ppr imports')) } + -- The neverQualify is important. We are printing Names + -- but they are in the context of an 'import' decl, and + -- we never qualify things inside there + -- E.g. import Blag( f, b ) + -- not import Blag( Blag.f, Blag.g )! + } + where + mkFilename dflags this_mod + | Just d <- dumpDir dflags = d basefn + | otherwise = basefn + where + basefn = moduleNameString (moduleName this_mod) ++ ".imports" + + to_ie_post_rn_var :: (HasOccName name) => Located name -> LIEWrappedName name to_ie_post_rn_var (L l n) | isDataOcc $ occName n = L l (IEPattern (L l n)) From git at git.haskell.org Sun Aug 5 20:14:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Aug 2018 20:14:16 +0000 (UTC) Subject: [commit: ghc] master: Fix typos (0095cde) Message-ID: <20180805201416.D270D3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0095cde3474cf487296b6e52bf75130b10827607/ghc >--------------------------------------------------------------- commit 0095cde3474cf487296b6e52bf75130b10827607 Author: Krzysztof Gogolewski Date: Sun Aug 5 22:13:34 2018 +0200 Fix typos >--------------------------------------------------------------- 0095cde3474cf487296b6e52bf75130b10827607 compiler/iface/IfaceType.hs | 2 +- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 4 ++-- compiler/typecheck/TcPatSyn.hs | 4 ++-- compiler/utils/GraphColor.hs | 2 +- testsuite/driver/runtests.py | 2 +- testsuite/tests/patsyn/should_fail/T14552.stderr | 2 +- 6 files changed, 8 insertions(+), 8 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index bd50b39..2fe3fe0 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -728,7 +728,7 @@ pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc pprPrecIfaceType prec ty = eliminateRuntimeRep (ppr_ty prec) ty ppr_ty :: PprPrec -> IfaceType -> SDoc -ppr_ty _ (IfaceFreeTyVar tyvar) = ppr tyvar -- This is the main reson for IfaceFreeTyVar! +ppr_ty _ (IfaceFreeTyVar tyvar) = ppr tyvar -- This is the main reason for IfaceFreeTyVar! ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar -- See Note [TcTyVars in IfaceType] ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys ppr_ty ctxt_prec (IfaceTupleTy i p tys) = pprTuple ctxt_prec i p tys diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index f25cb79..dba1275 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -1534,8 +1534,8 @@ genMachOp_slow opt op [x, y] = case op of panicOp = panic $ "LLVM.CodeGen.genMachOp_slow: unary op encountered" ++ "with two arguments! (" ++ show op ++ ")" --- More then two expression, invalid! -genMachOp_slow _ _ _ = panic "genMachOp: More then 2 expressions in MachOp!" +-- More than two expression, invalid! +genMachOp_slow _ _ _ = panic "genMachOp: More than 2 expressions in MachOp!" -- | Handle CmmLoad expression. diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 71050b8..ed7a445 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -188,7 +188,7 @@ badUnivTvErr ex_tvs bad_tv , nest 2 (ppr_with_kind bad_tv) , hang (text "Existentially-bound variables:") 2 (vcat (map ppr_with_kind ex_tvs)) - , text "Probable fix: give the pattern synoym a type signature" + , text "Probable fix: give the pattern synonym a type signature" ] where ppr_with_kind tv = ppr tv <+> dcolon <+> ppr (tyVarKind tv) @@ -1016,7 +1016,7 @@ tcPatToExpr name args pat = go pat ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For a bidirectional pattern synonym we need to produce an /expression/ that matches the supplied /pattern/, given values for the arguments -of the pattern synoymy. For example +of the pattern synonym. For example pattern F x y = (Just x, [y]) The 'builder' for F looks like $builderF x y = (Just x, [y]) diff --git a/compiler/utils/GraphColor.hs b/compiler/utils/GraphColor.hs index 7affb92..34cbb29 100644 --- a/compiler/utils/GraphColor.hs +++ b/compiler/utils/GraphColor.hs @@ -116,7 +116,7 @@ colorGraph iterative spinCount colors triv spill graph0 -- | Scan through the conflict graph separating out trivially colorable and -- potentially uncolorable (problem) nodes. -- --- Checking whether a node is trivially colorable or not is a resonably expensive operation, +-- Checking whether a node is trivially colorable or not is a reasonably expensive operation, -- so after a triv node is found and removed from the graph it's no good to return to the 'start' -- of the graph and recheck a bunch of nodes that will probably still be non-trivially colorable. -- diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index e9cce94..c6470c5 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -285,7 +285,7 @@ for name in config.only: framework_fail(name, '', 'test not found') else: # Let user fix .T file errors before reporting on unfound tests. - # The reson the test can not be found is likely because of those + # The reason the test can not be found is likely because of those # .T file errors. pass diff --git a/testsuite/tests/patsyn/should_fail/T14552.stderr b/testsuite/tests/patsyn/should_fail/T14552.stderr index 1ead644..1723b32 100644 --- a/testsuite/tests/patsyn/should_fail/T14552.stderr +++ b/testsuite/tests/patsyn/should_fail/T14552.stderr @@ -5,5 +5,5 @@ T14552.hs:22:9: error: Existentially-bound variables: k :: * w :: k --> * - Probable fix: give the pattern synoym a type signature + Probable fix: give the pattern synonym a type signature • In the declaration for pattern synonym ‘FOO’ From git at git.haskell.org Sun Aug 5 20:28:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Aug 2018 20:28:13 +0000 (UTC) Subject: [commit: ghc] master: circleci: Don't build validate-x86_64-linux-debug unregisterised (f355b72) Message-ID: <20180805202813.503C23A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f355b72113e646cb3785937f5506ee4c084c127f/ghc >--------------------------------------------------------------- commit f355b72113e646cb3785937f5506ee4c084c127f Author: Ben Gamari Date: Sun Aug 5 22:27:21 2018 +0200 circleci: Don't build validate-x86_64-linux-debug unregisterised Summary: This was a cut-and-paste error. Reviewers: alpmestan Reviewed By: alpmestan Subscribers: alpmestan, rwbarton, thomie, carter GHC Trac Issues: #15466 Differential Revision: https://phabricator.haskell.org/D5037 >--------------------------------------------------------------- f355b72113e646cb3785937f5506ee4c084c127f .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 298162e..a046b3d 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -220,7 +220,7 @@ jobs: - *prepare - *submodules - *boot - - *configure_unreg + - *configure_unix - *make - *test - *store_test_results From git at git.haskell.org Sun Aug 5 23:26:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Aug 2018 23:26:05 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: fixup! circleci: Install sphinx and TexLive (8b6f933) Message-ID: <20180805232605.74CA23A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/8b6f93317f4219fcc9bdb815b9da85821432c237/ghc >--------------------------------------------------------------- commit 8b6f93317f4219fcc9bdb815b9da85821432c237 Author: Ben Gamari Date: Sun Aug 5 19:25:48 2018 -0400 fixup! circleci: Install sphinx and TexLive >--------------------------------------------------------------- 8b6f93317f4219fcc9bdb815b9da85821432c237 .circleci/prepare-system.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index 08769f2..462d445 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -9,8 +9,8 @@ fail() { hackage_index_state="@1522046735" -if [[ -z "$BUILD_SPHINX_HTML" ]]; then BUILD_SPHINX_HTML=YES; fi -if [[ -z "$BUILD_SPHINX_PDF" ]]; then BUILD_SPHINX_PDF=YES; fi +if [[ -z "${BUILD_SPHINX_HTML:-}" ]]; then BUILD_SPHINX_HTML=YES; fi +if [[ -z "${BUILD_SPHINX_PDF:-}" ]]; then BUILD_SPHINX_PDF=YES; fi cat > mk/build.mk < Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4d91cabcd5e3c603997d9876f6d30204a9b029c6/ghc >--------------------------------------------------------------- commit 4d91cabcd5e3c603997d9876f6d30204a9b029c6 Author: Joachim Breitner Date: Sun Aug 5 20:56:21 2018 -0400 Allow scoped type variables refer to types This patch implements GHC proposal 29: (sorry, URL is too long for the commit message linter) and fixess #15050. The change is simple: Just use a different meta variable form. Test suite and documentation updated. Differential Revision: https://phabricator.haskell.org/D4980 >--------------------------------------------------------------- 4d91cabcd5e3c603997d9876f6d30204a9b029c6 compiler/typecheck/TcHsType.hs | 53 +++++++++------------- compiler/typecheck/TcMType.hs | 40 ++++++++++++---- docs/users_guide/glasgow_exts.rst | 5 -- .../{should_fail => should_compile}/T7786.hs | 0 testsuite/tests/indexed-types/should_compile/all.T | 2 +- .../tests/indexed-types/should_fail/T7786.stderr | 48 -------------------- testsuite/tests/indexed-types/should_fail/all.T | 1 - testsuite/tests/typecheck/should_compile/all.T | 2 +- .../tests/typecheck/should_compile/tc141.stderr | 16 +++---- testsuite/tests/typecheck/should_fail/T5689.stderr | 14 ++---- testsuite/tests/typecheck/should_fail/T5691.stderr | 9 ---- 11 files changed, 68 insertions(+), 122 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4d91cabcd5e3c603997d9876f6d30204a9b029c6 From git at git.haskell.org Mon Aug 6 01:05:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 01:05:42 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T15050' deleted Message-ID: <20180806010542.CA6123A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T15050 From git at git.haskell.org Mon Aug 6 02:49:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 02:49:29 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Install sphinx and TexLive (dfff909) Message-ID: <20180806024929.2B7023A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/dfff9098ddd617f3364c5b46d85b9b7936975904/ghc >--------------------------------------------------------------- commit dfff9098ddd617f3364c5b46d85b9b7936975904 Author: Ben Gamari Date: Sat Aug 4 00:21:58 2018 -0400 circleci: Install sphinx and TexLive >--------------------------------------------------------------- dfff9098ddd617f3364c5b46d85b9b7936975904 .circleci/config.yml | 12 +++++----- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update.sh | 29 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 12 +++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 ++++++++- .circleci/prepare-system.sh | 11 +++++++--- 6 files changed, 70 insertions(+), 10 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index e52d38d..f79e8c6 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -93,7 +93,7 @@ jobs: "validate-x86_64-linux": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv GHC_COLLECTOR_FLAVOR: x86_64-linux @@ -133,6 +133,8 @@ jobs: macos: xcode: "9.0" environment: + # Disable sphinx PDF output as MacTeX apparently doesn't provide xelatex + BUILD_SPHINX_PDF: "NO" MACOSX_DEPLOYMENT_TARGET: "10.7" # Only Sierra and onwards supports clock_gettime. See #12858 ac_cv_func_clock_gettime: "no" @@ -154,7 +156,7 @@ jobs: "validate-hadrian-x86_64-linux": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv steps: @@ -184,7 +186,7 @@ jobs: "validate-x86_64-linux-llvm": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv BUILD_FLAVOUR: perf-llvm @@ -209,7 +211,7 @@ jobs: "validate-x86_64-linux-debug": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: BUILD_FLAVOUR: devel2 <<: *buildenv @@ -226,7 +228,7 @@ jobs: "validate-i386-linux": resource_class: xlarge docker: - - image: ghcci/i386-linux:0.0.2 + - image: ghcci/i386-linux:0.0.3 environment: <<: *buildenv GHC_COLLECTOR_FLAVOR: i386-linux diff --git a/.circleci/images/i386-linux/Dockerfile b/.circleci/images/i386-linux/Dockerfile index 33fe0e1..b576f99 100644 --- a/.circleci/images/i386-linux/Dockerfile +++ b/.circleci/images/i386-linux/Dockerfile @@ -5,7 +5,13 @@ ENV LANG C.UTF-8 RUN echo 'deb http://ppa.launchpad.net/hvr/ghc/ubuntu trusty main' > /etc/apt/sources.list.d/ghc.list RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys F6F88286 RUN apt-get update -qq + +# Core build utilities RUN apt-get install -qy git make automake autoconf gcc perl python3 texinfo xz-utils lbzip2 bzip2 patch openssh-client sudo curl zlib1g-dev libtinfo-dev libsqlite3-0 libsqlite3-dev ca-certificates g++ cabal-install-2.2 ghc-8.4.2 happy alex + +# Documentation tools +RUN apt-get install -qy python3-sphinx texlive-xetex + ENV PATH /home/ghc/.cabal/bin:/home/ghc/.local/bin:/opt/cabal/2.2/bin:/opt/ghc/8.4.2/bin:$PATH # Get i386 GHC bindist for 32 bit CI builds. diff --git a/.circleci/images/update.sh b/.circleci/images/update.sh new file mode 100644 index 0000000..4d99092 --- /dev/null +++ b/.circleci/images/update.sh @@ -0,0 +1,29 @@ +#!/usr/bin/env bash + +set -e + +repo=ghcci + +if [[ $# != 2 ]]; then + echo "Usage: $0 DIR VERSION" + echo + echo "Update Docker image in DIR, pushing it to the $repo repository as" + echo "version VERSION" + echo + echo "Example: $0 x86_64-linux-fedora 0.0.3" + exit 1 +fi + +name=$1 +version=$2 + +if curl -s https://registry.hub.docker.com/v1/repositories/$repo/$name/tags | jq -r .[].name | grep $version > /dev/null; then + echo "Version $version of $name already exists" + exit 1 +fi + +docker build $name -t $repo/$name:$version +docker push $repo/$name:$version + +sed -i -e "s%$repo/$name:[0-9]+(\.[0-9]+)*%$repo/$name:$version%" ../config.yml +echo "Built, pushed, and bumped $name:$version" diff --git a/.circleci/images/x86_64-linux-fedora/Dockerfile b/.circleci/images/x86_64-linux-fedora/Dockerfile index d976950..70253a0 100644 --- a/.circleci/images/x86_64-linux-fedora/Dockerfile +++ b/.circleci/images/x86_64-linux-fedora/Dockerfile @@ -2,7 +2,17 @@ FROM fedora:27 ENV LANG C.UTF-8 -RUN dnf -y install coreutils binutils which git make automake autoconf gcc perl python3 texinfo xz lbzip2 patch openssh-clients sudo curl zlib-devel sqlite ncurses-compat-libs gmp-devel ncurses-devel gcc-c++ findutils +# Core build utilities +RUN dnf -y install coreutils binutils which git make \ + automake autoconf gcc perl python3 texinfo xz lbzip2 \ + patch openssh-clients sudo curl zlib-devel sqlite \ + ncurses-compat-libs gmp-devel ncurses-devel gcc-c++ findutils + +# Documentation tools +RUN dnf -y install sphinx \ + texlive texlive-latex texlive-xetex \ + texlive-collection-latex texlive-collection-latexrecommended \ + texlive-xetex-def texlive-collection-xetex # systemd isn't running so remove it from nsswitch.conf # Failing to do this will result in testsuite failures due to diff --git a/.circleci/images/x86_64-linux/Dockerfile b/.circleci/images/x86_64-linux/Dockerfile index 512338b..4303e4d 100644 --- a/.circleci/images/x86_64-linux/Dockerfile +++ b/.circleci/images/x86_64-linux/Dockerfile @@ -5,7 +5,15 @@ ENV LANG C.UTF-8 RUN echo 'deb http://ppa.launchpad.net/hvr/ghc/ubuntu trusty main' > /etc/apt/sources.list.d/ghc.list RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys F6F88286 RUN apt-get update -qq -RUN apt-get install -qy cabal-install-2.2 ghc-8.4.2 happy alex zlib1g-dev libtinfo-dev libsqlite3-0 libsqlite3-dev ca-certificates g++ git curl git make automake autoconf gcc perl python3 texinfo xz-utils lbzip2 patch openssh-client sudo + +# Core build utilities +RUN apt-get install -qy cabal-install-2.2 ghc-8.4.2 happy alex zlib1g-dev \ + libtinfo-dev libsqlite3-0 libsqlite3-dev ca-certificates g++ git curl \ + git make automake autoconf gcc perl python3 texinfo xz-utils lbzip2 \ + patch openssh-client sudo + +# Documentation tools +RUN apt-get install -qy python3-sphinx texlive-xetex # Stack intallation RUN curl -fSL https://github.com/commercialhaskell/stack/releases/download/v1.6.5/stack-1.6.5-linux-x86_64-static.tar.gz -o stack.tar.gz diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index c9320ed..462d445 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -9,14 +9,16 @@ fail() { hackage_index_state="@1522046735" +if [[ -z "${BUILD_SPHINX_HTML:-}" ]]; then BUILD_SPHINX_HTML=YES; fi +if [[ -z "${BUILD_SPHINX_PDF:-}" ]]; then BUILD_SPHINX_PDF=YES; fi + cat > mk/build.mk < Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/32058ab33810675e52c0fc92eb9a64b6dfdd1f95/ghc >--------------------------------------------------------------- commit 32058ab33810675e52c0fc92eb9a64b6dfdd1f95 Author: Ben Gamari Date: Sun Aug 5 10:24:30 2018 -0400 Bump hadrian submodule >--------------------------------------------------------------- 32058ab33810675e52c0fc92eb9a64b6dfdd1f95 hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index a63ad32..4265e3a 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit a63ad3294b5d51eec50d454810a314c0b2a696c7 +Subproject commit 4265e3aab7df92722b81148cf8bf3954ebfc2d21 From git at git.haskell.org Mon Aug 6 11:52:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 11:52:31 +0000 (UTC) Subject: [commit: ghc] master: Create 8.8.1 release notes (d7bc05e) Message-ID: <20180806115231.DFE993A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d7bc05ec483fb0d14231cf94fca647ed8296a382/ghc >--------------------------------------------------------------- commit d7bc05ec483fb0d14231cf94fca647ed8296a382 Author: Ryan Scott Date: Mon Aug 6 07:49:37 2018 -0400 Create 8.8.1 release notes Summary: I have some pending commits which will debut in GHC 8.8.1, but we don't yet have release notes for this. This adds them, and deletes the stale 8.4.1 and 8.4.2 release notes. Test Plan: Read it Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5025 >--------------------------------------------------------------- d7bc05ec483fb0d14231cf94fca647ed8296a382 .../users_guide/8.4.2-notes.rst => 8.8.1-notes.rst | 43 +- docs/users_guide/8.4.1-notes.rst | 441 --------------------- docs/users_guide/index.rst | 2 +- 3 files changed, 20 insertions(+), 466 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 d7bc05ec483fb0d14231cf94fca647ed8296a382 From git at git.haskell.org Mon Aug 6 12:04:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 12:04:50 +0000 (UTC) Subject: [commit: ghc] master: Move 8.8.1-notes.rst to the right directory (b14040d) Message-ID: <20180806120450.6095E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b14040db2a86bcc477d172d8b4cc22f0479700db/ghc >--------------------------------------------------------------- commit b14040db2a86bcc477d172d8b4cc22f0479700db Author: Ryan Scott Date: Mon Aug 6 08:03:18 2018 -0400 Move 8.8.1-notes.rst to the right directory Somehow, this escaped my notice before. >--------------------------------------------------------------- b14040db2a86bcc477d172d8b4cc22f0479700db 8.8.1-notes.rst => docs/users_guide/8.8.1-notes.rst | 0 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/8.8.1-notes.rst b/docs/users_guide/8.8.1-notes.rst similarity index 100% rename from 8.8.1-notes.rst rename to docs/users_guide/8.8.1-notes.rst From git at git.haskell.org Mon Aug 6 14:11:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 14:11:51 +0000 (UTC) Subject: [commit: ghc] master: Mention #15050 in the release notes for 8.8.1 (f811685) Message-ID: <20180806141151.0825A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f811685c3c1579333743da135c8cb80924aea4ce/ghc >--------------------------------------------------------------- commit f811685c3c1579333743da135c8cb80924aea4ce Author: Joachim Breitner Date: Mon Aug 6 09:58:27 2018 -0400 Mention #15050 in the release notes for 8.8.1 >--------------------------------------------------------------- f811685c3c1579333743da135c8cb80924aea4ce docs/users_guide/8.8.1-notes.rst | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/docs/users_guide/8.8.1-notes.rst b/docs/users_guide/8.8.1-notes.rst index f77c50e..de5f978 100644 --- a/docs/users_guide/8.8.1-notes.rst +++ b/docs/users_guide/8.8.1-notes.rst @@ -22,6 +22,10 @@ Full details Language ~~~~~~~ +- :extension:`ScopedTypeVariables`: The type variable that a type signature on + a pattern can bring into scope can now stand for arbitrary types. Previously, + they could only stand in for other type variables, but this restriction was deemed + unnecessary in `GHC proposal #29 `__. Also see :ghc-ticket:`15050`. Compiler ~~~~~~~ From git at git.haskell.org Mon Aug 6 15:11:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 15:11:44 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: Bump hadrian submodule (8a3adbc) Message-ID: <20180806151144.651963A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/8a3adbcbaefafa35ca1b2c724c5fb3e614bada8b/ghc >--------------------------------------------------------------- commit 8a3adbcbaefafa35ca1b2c724c5fb3e614bada8b Author: Ben Gamari Date: Sun Aug 5 10:24:30 2018 -0400 Bump hadrian submodule >--------------------------------------------------------------- 8a3adbcbaefafa35ca1b2c724c5fb3e614bada8b hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index a63ad32..4265e3a 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit a63ad3294b5d51eec50d454810a314c0b2a696c7 +Subproject commit 4265e3aab7df92722b81148cf8bf3954ebfc2d21 From git at git.haskell.org Mon Aug 6 15:11:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 15:11:47 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Fix documentation building (f895d30) Message-ID: <20180806151147.9EA9E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/f895d3022a2e3df8ed8d3f8d69413d996784b70b/ghc >--------------------------------------------------------------- commit f895d3022a2e3df8ed8d3f8d69413d996784b70b Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- f895d3022a2e3df8ed8d3f8d69413d996784b70b .circleci/config.yml | 12 +++++----- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update.sh | 30 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 12 +++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 ++++++++- .circleci/prepare-system.sh | 11 ++++++--- 6 files changed, 71 insertions(+), 10 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index e52d38d..bc99e4a 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -93,7 +93,7 @@ jobs: "validate-x86_64-linux": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv GHC_COLLECTOR_FLAVOR: x86_64-linux @@ -133,6 +133,8 @@ jobs: macos: xcode: "9.0" environment: + # Disable sphinx PDF output as MacTeX apparently doesn't provide xelatex + BUILD_SPHINX_PDF: "NO" MACOSX_DEPLOYMENT_TARGET: "10.7" # Only Sierra and onwards supports clock_gettime. See #12858 ac_cv_func_clock_gettime: "no" @@ -154,7 +156,7 @@ jobs: "validate-hadrian-x86_64-linux": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv steps: @@ -184,7 +186,7 @@ jobs: "validate-x86_64-linux-llvm": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv BUILD_FLAVOUR: perf-llvm @@ -209,7 +211,7 @@ jobs: "validate-x86_64-linux-debug": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: BUILD_FLAVOUR: devel2 <<: *buildenv @@ -226,7 +228,7 @@ jobs: "validate-i386-linux": resource_class: xlarge docker: - - image: ghcci/i386-linux:0.0.2 + - image: ghcci/i386-linux:0.0.4 environment: <<: *buildenv GHC_COLLECTOR_FLAVOR: i386-linux diff --git a/.circleci/images/i386-linux/Dockerfile b/.circleci/images/i386-linux/Dockerfile index 33fe0e1..b576f99 100644 --- a/.circleci/images/i386-linux/Dockerfile +++ b/.circleci/images/i386-linux/Dockerfile @@ -5,7 +5,13 @@ ENV LANG C.UTF-8 RUN echo 'deb http://ppa.launchpad.net/hvr/ghc/ubuntu trusty main' > /etc/apt/sources.list.d/ghc.list RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys F6F88286 RUN apt-get update -qq + +# Core build utilities RUN apt-get install -qy git make automake autoconf gcc perl python3 texinfo xz-utils lbzip2 bzip2 patch openssh-client sudo curl zlib1g-dev libtinfo-dev libsqlite3-0 libsqlite3-dev ca-certificates g++ cabal-install-2.2 ghc-8.4.2 happy alex + +# Documentation tools +RUN apt-get install -qy python3-sphinx texlive-xetex + ENV PATH /home/ghc/.cabal/bin:/home/ghc/.local/bin:/opt/cabal/2.2/bin:/opt/ghc/8.4.2/bin:$PATH # Get i386 GHC bindist for 32 bit CI builds. diff --git a/.circleci/images/update.sh b/.circleci/images/update.sh new file mode 100644 index 0000000..96f97a2 --- /dev/null +++ b/.circleci/images/update.sh @@ -0,0 +1,30 @@ +#!/usr/bin/env bash + +set -e + +repo=ghcci + +if [[ $# != 2 ]]; then + echo "Usage: $0 DIR VERSION" + echo + echo "Update Docker image in DIR, pushing it to the $repo repository as" + echo "version VERSION" + echo + echo "Example: $0 x86_64-linux-fedora 0.0.3" + exit 1 +fi + +name=$1 +version=$2 + +if curl -s https://registry.hub.docker.com/v1/repositories/$repo/$name/tags | jq -r .[].name | grep $version > /dev/null; then + echo "Version $version of $name already exists" + exit 1 +fi + +docker build $name -t $repo/$name:$version +docker push $repo/$name:$version + +repo_name="$repo/$name" +sed -i -E -e "s%$repo_name"':[0-9]+(\.[0-9]+)*%'"$repo_name:$version%" ../config.yml +echo "Built, pushed, and bumped $name:$version" diff --git a/.circleci/images/x86_64-linux-fedora/Dockerfile b/.circleci/images/x86_64-linux-fedora/Dockerfile index d976950..2661521 100644 --- a/.circleci/images/x86_64-linux-fedora/Dockerfile +++ b/.circleci/images/x86_64-linux-fedora/Dockerfile @@ -2,7 +2,17 @@ FROM fedora:27 ENV LANG C.UTF-8 -RUN dnf -y install coreutils binutils which git make automake autoconf gcc perl python3 texinfo xz lbzip2 patch openssh-clients sudo curl zlib-devel sqlite ncurses-compat-libs gmp-devel ncurses-devel gcc-c++ findutils +# Core build utilities +RUN dnf -y install coreutils binutils which git make \ + automake autoconf gcc perl python3 texinfo xz lbzip2 \ + patch openssh-clients sudo curl zlib-devel sqlite \ + ncurses-compat-libs gmp-devel ncurses-devel gcc-c++ findutils + +# Documentation tools +RUN dnf -y install python3-sphinx \ + texlive texlive-latex texlive-xetex \ + texlive-collection-latex texlive-collection-latexrecommended \ + texlive-xetex-def texlive-collection-xetex # systemd isn't running so remove it from nsswitch.conf # Failing to do this will result in testsuite failures due to diff --git a/.circleci/images/x86_64-linux/Dockerfile b/.circleci/images/x86_64-linux/Dockerfile index 512338b..4303e4d 100644 --- a/.circleci/images/x86_64-linux/Dockerfile +++ b/.circleci/images/x86_64-linux/Dockerfile @@ -5,7 +5,15 @@ ENV LANG C.UTF-8 RUN echo 'deb http://ppa.launchpad.net/hvr/ghc/ubuntu trusty main' > /etc/apt/sources.list.d/ghc.list RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys F6F88286 RUN apt-get update -qq -RUN apt-get install -qy cabal-install-2.2 ghc-8.4.2 happy alex zlib1g-dev libtinfo-dev libsqlite3-0 libsqlite3-dev ca-certificates g++ git curl git make automake autoconf gcc perl python3 texinfo xz-utils lbzip2 patch openssh-client sudo + +# Core build utilities +RUN apt-get install -qy cabal-install-2.2 ghc-8.4.2 happy alex zlib1g-dev \ + libtinfo-dev libsqlite3-0 libsqlite3-dev ca-certificates g++ git curl \ + git make automake autoconf gcc perl python3 texinfo xz-utils lbzip2 \ + patch openssh-client sudo + +# Documentation tools +RUN apt-get install -qy python3-sphinx texlive-xetex # Stack intallation RUN curl -fSL https://github.com/commercialhaskell/stack/releases/download/v1.6.5/stack-1.6.5-linux-x86_64-static.tar.gz -o stack.tar.gz diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index df0da01..462d445 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -7,16 +7,18 @@ fail() { exit 1 } -echo 'BUILD_SPHINX_HTML = NO' > mk/validate.mk -echo 'BUILD_SPHINX_PDF = NO' >> mk/validate.mk hackage_index_state="@1522046735" +if [[ -z "${BUILD_SPHINX_HTML:-}" ]]; then BUILD_SPHINX_HTML=YES; fi +if [[ -z "${BUILD_SPHINX_PDF:-}" ]]; then BUILD_SPHINX_PDF=YES; fi + cat > mk/build.mk < Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/b3ce76f8a4ee27559a072a7cdf50f34271924e65/ghc >--------------------------------------------------------------- commit b3ce76f8a4ee27559a072a7cdf50f34271924e65 Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- b3ce76f8a4ee27559a072a7cdf50f34271924e65 .circleci/config.yml | 14 +++++++----- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update.sh | 30 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 12 +++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 ++++++++- .circleci/prepare-system.sh | 11 ++++++--- 6 files changed, 72 insertions(+), 11 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index e52d38d..096e264 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -93,7 +93,7 @@ jobs: "validate-x86_64-linux": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv GHC_COLLECTOR_FLAVOR: x86_64-linux @@ -133,6 +133,8 @@ jobs: macos: xcode: "9.0" environment: + # Disable sphinx PDF output as MacTeX apparently doesn't provide xelatex + BUILD_SPHINX_PDF: "NO" MACOSX_DEPLOYMENT_TARGET: "10.7" # Only Sierra and onwards supports clock_gettime. See #12858 ac_cv_func_clock_gettime: "no" @@ -154,7 +156,7 @@ jobs: "validate-hadrian-x86_64-linux": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv steps: @@ -184,7 +186,7 @@ jobs: "validate-x86_64-linux-llvm": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: <<: *buildenv BUILD_FLAVOUR: perf-llvm @@ -209,7 +211,7 @@ jobs: "validate-x86_64-linux-debug": resource_class: xlarge docker: - - image: ghcci/x86_64-linux:0.0.2 + - image: ghcci/x86_64-linux:0.0.3 environment: BUILD_FLAVOUR: devel2 <<: *buildenv @@ -226,7 +228,7 @@ jobs: "validate-i386-linux": resource_class: xlarge docker: - - image: ghcci/i386-linux:0.0.2 + - image: ghcci/i386-linux:0.0.4 environment: <<: *buildenv GHC_COLLECTOR_FLAVOR: i386-linux @@ -245,7 +247,7 @@ jobs: "validate-x86_64-fedora": resource_class: xlarge docker: - - image: ghcci/x86_64-linux-fedora:0.0.4 + - image: ghcci/x86_64-linux-fedora:0.0.6 environment: <<: *buildenv GHC_COLLECTOR_FLAVOR: x86_64-fedora diff --git a/.circleci/images/i386-linux/Dockerfile b/.circleci/images/i386-linux/Dockerfile index 33fe0e1..b576f99 100644 --- a/.circleci/images/i386-linux/Dockerfile +++ b/.circleci/images/i386-linux/Dockerfile @@ -5,7 +5,13 @@ ENV LANG C.UTF-8 RUN echo 'deb http://ppa.launchpad.net/hvr/ghc/ubuntu trusty main' > /etc/apt/sources.list.d/ghc.list RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys F6F88286 RUN apt-get update -qq + +# Core build utilities RUN apt-get install -qy git make automake autoconf gcc perl python3 texinfo xz-utils lbzip2 bzip2 patch openssh-client sudo curl zlib1g-dev libtinfo-dev libsqlite3-0 libsqlite3-dev ca-certificates g++ cabal-install-2.2 ghc-8.4.2 happy alex + +# Documentation tools +RUN apt-get install -qy python3-sphinx texlive-xetex + ENV PATH /home/ghc/.cabal/bin:/home/ghc/.local/bin:/opt/cabal/2.2/bin:/opt/ghc/8.4.2/bin:$PATH # Get i386 GHC bindist for 32 bit CI builds. diff --git a/.circleci/images/update.sh b/.circleci/images/update.sh new file mode 100644 index 0000000..96f97a2 --- /dev/null +++ b/.circleci/images/update.sh @@ -0,0 +1,30 @@ +#!/usr/bin/env bash + +set -e + +repo=ghcci + +if [[ $# != 2 ]]; then + echo "Usage: $0 DIR VERSION" + echo + echo "Update Docker image in DIR, pushing it to the $repo repository as" + echo "version VERSION" + echo + echo "Example: $0 x86_64-linux-fedora 0.0.3" + exit 1 +fi + +name=$1 +version=$2 + +if curl -s https://registry.hub.docker.com/v1/repositories/$repo/$name/tags | jq -r .[].name | grep $version > /dev/null; then + echo "Version $version of $name already exists" + exit 1 +fi + +docker build $name -t $repo/$name:$version +docker push $repo/$name:$version + +repo_name="$repo/$name" +sed -i -E -e "s%$repo_name"':[0-9]+(\.[0-9]+)*%'"$repo_name:$version%" ../config.yml +echo "Built, pushed, and bumped $name:$version" diff --git a/.circleci/images/x86_64-linux-fedora/Dockerfile b/.circleci/images/x86_64-linux-fedora/Dockerfile index d976950..2661521 100644 --- a/.circleci/images/x86_64-linux-fedora/Dockerfile +++ b/.circleci/images/x86_64-linux-fedora/Dockerfile @@ -2,7 +2,17 @@ FROM fedora:27 ENV LANG C.UTF-8 -RUN dnf -y install coreutils binutils which git make automake autoconf gcc perl python3 texinfo xz lbzip2 patch openssh-clients sudo curl zlib-devel sqlite ncurses-compat-libs gmp-devel ncurses-devel gcc-c++ findutils +# Core build utilities +RUN dnf -y install coreutils binutils which git make \ + automake autoconf gcc perl python3 texinfo xz lbzip2 \ + patch openssh-clients sudo curl zlib-devel sqlite \ + ncurses-compat-libs gmp-devel ncurses-devel gcc-c++ findutils + +# Documentation tools +RUN dnf -y install python3-sphinx \ + texlive texlive-latex texlive-xetex \ + texlive-collection-latex texlive-collection-latexrecommended \ + texlive-xetex-def texlive-collection-xetex # systemd isn't running so remove it from nsswitch.conf # Failing to do this will result in testsuite failures due to diff --git a/.circleci/images/x86_64-linux/Dockerfile b/.circleci/images/x86_64-linux/Dockerfile index 512338b..4303e4d 100644 --- a/.circleci/images/x86_64-linux/Dockerfile +++ b/.circleci/images/x86_64-linux/Dockerfile @@ -5,7 +5,15 @@ ENV LANG C.UTF-8 RUN echo 'deb http://ppa.launchpad.net/hvr/ghc/ubuntu trusty main' > /etc/apt/sources.list.d/ghc.list RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys F6F88286 RUN apt-get update -qq -RUN apt-get install -qy cabal-install-2.2 ghc-8.4.2 happy alex zlib1g-dev libtinfo-dev libsqlite3-0 libsqlite3-dev ca-certificates g++ git curl git make automake autoconf gcc perl python3 texinfo xz-utils lbzip2 patch openssh-client sudo + +# Core build utilities +RUN apt-get install -qy cabal-install-2.2 ghc-8.4.2 happy alex zlib1g-dev \ + libtinfo-dev libsqlite3-0 libsqlite3-dev ca-certificates g++ git curl \ + git make automake autoconf gcc perl python3 texinfo xz-utils lbzip2 \ + patch openssh-client sudo + +# Documentation tools +RUN apt-get install -qy python3-sphinx texlive-xetex # Stack intallation RUN curl -fSL https://github.com/commercialhaskell/stack/releases/download/v1.6.5/stack-1.6.5-linux-x86_64-static.tar.gz -o stack.tar.gz diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index df0da01..462d445 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -7,16 +7,18 @@ fail() { exit 1 } -echo 'BUILD_SPHINX_HTML = NO' > mk/validate.mk -echo 'BUILD_SPHINX_PDF = NO' >> mk/validate.mk hackage_index_state="@1522046735" +if [[ -z "${BUILD_SPHINX_HTML:-}" ]]; then BUILD_SPHINX_HTML=YES; fi +if [[ -z "${BUILD_SPHINX_PDF:-}" ]]; then BUILD_SPHINX_PDF=YES; fi + cat > mk/build.mk < Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e94cc29ef65d27536a9430c4c84665b6f6b7d65b/ghc >--------------------------------------------------------------- commit e94cc29ef65d27536a9430c4c84665b6f6b7d65b Author: Michael Sloan Date: Mon Aug 6 19:19:47 2018 +0200 Use -fobject-code in the GHCi script for loading GHC Summary: My very last commit to D4904 removed -fobject-code. I should have tested this more thoroughly, because it is required to do a fresh ghci load, as some code uses unboxed tuples. One of my motivations for doing this was that if you run the script without passing -odir / -hidir, it would pollute the source tree with .hi and .o files. This also appeared to break subsequent builds. I've made it much less likely that this will happen by instead specifying -odir and -hidir within the ghci script rather than on the commandline. I plan to open a separate diff which adds a test that these scripts work. Until this patch is merged, the workaround is to do `./utils/ghc-in-ghci/run.sh -fobject-code` Reviewers: bgamari, alpmestan, monoidal Reviewed By: alpmestan, monoidal Subscribers: alpmestan, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5015 >--------------------------------------------------------------- e94cc29ef65d27536a9430c4c84665b6f6b7d65b .gitignore | 5 +++++ utils/ghc-in-ghci/run.sh | 2 -- utils/ghc-in-ghci/settings.ghci | 6 ++++++ 3 files changed, 11 insertions(+), 2 deletions(-) diff --git a/.gitignore b/.gitignore index 7e2425c..c72d044 100644 --- a/.gitignore +++ b/.gitignore @@ -204,3 +204,8 @@ GIT_COMMIT_ID # Should be equal to testdir_suffix from testsuite/driver/testlib.py. *.run + +# ----------------------------------------------------------------------------- +# Output of ghc-in-ghci + +/.ghci-objects/ \ No newline at end of file diff --git a/utils/ghc-in-ghci/run.sh b/utils/ghc-in-ghci/run.sh index 2dda647..521458f 100755 --- a/utils/ghc-in-ghci/run.sh +++ b/utils/ghc-in-ghci/run.sh @@ -30,7 +30,5 @@ exec ./inplace/bin/ghc-stage2 \ --interactive \ -ghci-script ./utils/ghc-in-ghci/settings.ghci \ -ghci-script ./utils/ghc-in-ghci/load-main.ghci \ - -odir ./ghci-tmp \ - -hidir ./ghci-tmp \ +RTS -A128m -RTS \ "$@" diff --git a/utils/ghc-in-ghci/settings.ghci b/utils/ghc-in-ghci/settings.ghci index 1348274..8f5ba6e 100644 --- a/utils/ghc-in-ghci/settings.ghci +++ b/utils/ghc-in-ghci/settings.ghci @@ -36,6 +36,12 @@ :set -DGHC_LOADED_INTO_GHCI :set -XNoImplicitPrelude +-- -fobject-code is required because bytecode doesn't support unboxed tuples +-- https://ghc.haskell.org/trac/ghc/ticket/1257 +:set -odir ./.ghci-objects +:set -hidir ./.ghci-objects +:set -fobject-code + -- Setup args so that running "main" will run ghci and set the prompt to -- indicate that it is an inner ghci. :set args --interactive -ghci-script utils/ghc-in-ghci/inner.ghci From git at git.haskell.org Mon Aug 6 17:22:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 17:22:07 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Fix documentation building (115658d) Message-ID: <20180806172207.B5BE53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/115658d132a8841d1a4f26d90d2d4d04021efca2/ghc >--------------------------------------------------------------- commit 115658d132a8841d1a4f26d90d2d4d04021efca2 Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- 115658d132a8841d1a4f26d90d2d4d04021efca2 .circleci/config.yml | 14 +++++++----- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 30 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 18 ++++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 ++++++++- .circleci/prepare-system.sh | 11 ++++++--- 6 files changed, 78 insertions(+), 11 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 115658d132a8841d1a4f26d90d2d4d04021efca2 From git at git.haskell.org Mon Aug 6 19:29:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 19:29:54 +0000 (UTC) Subject: [commit: ghc] master: Strip ../ from testdir (fixes #15469) (29dfb63) Message-ID: <20180806192954.30ACE3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/29dfb63624442a27119c1a218fc3dae71afb16de/ghc >--------------------------------------------------------------- commit 29dfb63624442a27119c1a218fc3dae71afb16de Author: Thomas Miedema Date: Mon Aug 6 19:48:39 2018 +0200 Strip ../ from testdir (fixes #15469) Test Plan: Harbormaster Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, carter GHC Trac Issues: #15469 Differential Revision: https://phabricator.haskell.org/D5039 >--------------------------------------------------------------- 29dfb63624442a27119c1a218fc3dae71afb16de testsuite/driver/testlib.py | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index f99c6ed..ef2b8dd 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -14,6 +14,7 @@ import copy import glob import sys from math import ceil, trunc +from pathlib import PurePath import collections import subprocess @@ -618,8 +619,9 @@ def newTestDir(tempdir, dir): testdir_suffix = '.run' def _newTestDir(name, opts, tempdir, dir): + testdir = os.path.join('', *(p for p in PurePath(dir).parts if p != '..')) opts.srcdir = os.path.join(os.getcwd(), dir) - opts.testdir = os.path.join(tempdir, dir, name + testdir_suffix) + opts.testdir = os.path.join(tempdir, testdir, name + testdir_suffix) opts.compiler_always_flags = config.compiler_always_flags # ----------------------------------------------------------------------------- From git at git.haskell.org Mon Aug 6 19:39:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 19:39:10 +0000 (UTC) Subject: [commit: ghc] master: Testsuite driver: fix encoding issue when calling ghc-pkg (36a4c19) Message-ID: <20180806193910.B8EB43A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/36a4c19494e2cb7e968f1d0e0c09926a660e1a56/ghc >--------------------------------------------------------------- commit 36a4c19494e2cb7e968f1d0e0c09926a660e1a56 Author: Krzysztof Gogolewski Date: Mon Aug 6 21:38:52 2018 +0200 Testsuite driver: fix encoding issue when calling ghc-pkg Summary: In Python 3, subprocess.communicate() returns a pair of bytes, which need to be decoded. In runtests.py, we were just calling str() instead, which converts b'x' to "b'x'". As a result, the loop that was checking pkginfo for lines starting with 'library-dirs' couldn't work. Reviewers: bgamari, thomie, Phyx Reviewed By: thomie Subscribers: Phyx, rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5046 >--------------------------------------------------------------- 36a4c19494e2cb7e968f1d0e0c09926a660e1a56 testsuite/config/ghc | 4 ++-- testsuite/driver/runtests.py | 2 +- testsuite/driver/testutil.py | 5 ++--- 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/testsuite/config/ghc b/testsuite/config/ghc index a850be9..6777a59 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -158,10 +158,10 @@ llvm_ways = [x[0] for x in config.way_flags.items() if '-fflvm' in x[1]] def get_compiler_info(): - s = getStdout([config.compiler, '--info']).decode('utf8') + s = getStdout([config.compiler, '--info']) s = re.sub('[\r\n]', '', s) compilerInfoDict = dict(eval(s)) - s = getStdout([config.compiler, '+RTS', '--info']).decode('utf8') + s = getStdout([config.compiler, '+RTS', '--info']) s = re.sub('[\r\n]', '', s) rtsInfoDict = dict(eval(s)) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index c6470c5..e01f67c 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -189,7 +189,7 @@ def format_path(path): # On Windows we need to set $PATH to include the paths to all the DLLs # in order for the dynamic library tests to work. if windows or darwin: - pkginfo = str(getStdout([config.ghc_pkg, 'dump'])) + pkginfo = getStdout([config.ghc_pkg, 'dump']) topdir = config.libdir if windows: mingw = os.path.abspath(os.path.join(topdir, '../mingw/bin')) diff --git a/testsuite/driver/testutil.py b/testsuite/driver/testutil.py index 104bbff..15587e6 100644 --- a/testsuite/driver/testutil.py +++ b/testsuite/driver/testutil.py @@ -10,8 +10,7 @@ def strip_quotes(s): return s.strip('\'"') def getStdout(cmd_and_args): - # Can't use subprocess.check_output as it's not available in Python 2.6; - # It's also not quite the same as check_output, since we also verify that + # Can't use subprocess.check_output, since we also verify that # no stderr was produced p = subprocess.Popen([strip_quotes(cmd_and_args[0])] + cmd_and_args[1:], stdout=subprocess.PIPE, @@ -22,7 +21,7 @@ def getStdout(cmd_and_args): raise Exception("Command failed: " + str(cmd_and_args)) if stderr: raise Exception("stderr from command: %s\nOutput:\n%s\n" % (cmd_and_args, stderr)) - return stdout + return stdout.decode('utf-8') def lndir(srcdir, dstdir): # Create symlinks for all files in src directory. From git at git.haskell.org Mon Aug 6 19:39:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 19:39:24 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Fix documentation building (2f57019) Message-ID: <20180806193924.606A43A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/2f57019eb3e48b9239532c712ebd3c2df4cb2e5b/ghc >--------------------------------------------------------------- commit 2f57019eb3e48b9239532c712ebd3c2df4cb2e5b Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- 2f57019eb3e48b9239532c712ebd3c2df4cb2e5b .circleci/config.yml | 14 +++++++----- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 30 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 19 +++++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 ++++++++- .circleci/prepare-system.sh | 14 +++++++++--- 6 files changed, 82 insertions(+), 11 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2f57019eb3e48b9239532c712ebd3c2df4cb2e5b From git at git.haskell.org Mon Aug 6 20:49:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 20:49:24 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Fix documentation building (14204c5) Message-ID: <20180806204924.88BBB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/14204c59dc3130e947db5c9b156db3badc6d3781/ghc >--------------------------------------------------------------- commit 14204c59dc3130e947db5c9b156db3badc6d3781 Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- 14204c59dc3130e947db5c9b156db3badc6d3781 .circleci/config.yml | 18 ++++++++------- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 30 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 19 +++++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 ++++++++- .circleci/prepare-system.sh | 20 ++++++++++++++--- 6 files changed, 90 insertions(+), 13 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 14204c59dc3130e947db5c9b156db3badc6d3781 From git at git.haskell.org Mon Aug 6 21:07:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 21:07:01 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: llvm-targets: Add versioned ARM targets (f0f162b) Message-ID: <20180806210701.E677E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/f0f162b1cca33aeef8ff96caab3672b1059f537b/ghc >--------------------------------------------------------------- commit f0f162b1cca33aeef8ff96caab3672b1059f537b Author: Guillaume GARDET Date: Fri May 18 08:56:28 2018 +0200 llvm-targets: Add versioned ARM targets Namely armv6l-unknown-linux-gnueabihf and armv7l-unknown-linux-gnueabihf. (cherry picked from commit e4003b6dc6a84d870116de9f47057c15b1576f36) >--------------------------------------------------------------- f0f162b1cca33aeef8ff96caab3672b1059f537b llvm-targets | 4 +++- utils/llvm-targets/gen-data-layout.sh | 35 +++++++++++++++++++++++------------ 2 files changed, 26 insertions(+), 13 deletions(-) diff --git a/llvm-targets b/llvm-targets index 3c9da1e..b67ee6c 100644 --- a/llvm-targets +++ b/llvm-targets @@ -3,10 +3,12 @@ ,("x86_64-unknown-windows", ("e-m:w-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) ,("arm-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align")) ,("armv6-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm1136jf-s", "+strict-align")) +,("armv6l-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align")) ,("armv7-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) +,("armv7a-unknown-linux-gnueabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) +,("armv7l-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("aarch64-unknown-linux-gnu", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("aarch64-unknown-linux", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) -,("armv7a-unknown-linux-gnueabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("i386-unknown-linux-gnu", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) ,("i386-unknown-linux", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) ,("x86_64-unknown-linux-gnu", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) diff --git a/utils/llvm-targets/gen-data-layout.sh b/utils/llvm-targets/gen-data-layout.sh index 6f2aafc..3d9ded1 100755 --- a/utils/llvm-targets/gen-data-layout.sh +++ b/utils/llvm-targets/gen-data-layout.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/usr/bin/env bash # # llvm-target generator # @@ -16,17 +16,28 @@ # Add missing targets to the list below to have them included in # llvm-targets file. -# Target sets -WINDOWS_x86="i386-unknown-windows i686-unknown-windows x86_64-unknown-windows" -LINUX_ARM="arm-unknown-linux-gnueabihf armv6-unknown-linux-gnueabihf armv7-unknown-linux-gnueabihf aarch64-unknown-linux-gnu aarch64-unknown-linux armv7a-unknown-linux-gnueabi" -LINUX_x86="i386-unknown-linux-gnu i386-unknown-linux x86_64-unknown-linux-gnu x86_64-unknown-linux" -ANDROID="armv7-unknown-linux-androideabi aarch64-unknown-linux-android" -QNX="arm-unknown-nto-qnx-eabi" -MACOS="i386-apple-darwin x86_64-apple-darwin" -IOS="armv7-apple-ios arm64-apple-ios i386-apple-ios x86_64-apple-ios" +# Target sets for which to generate the llvm-targets file +TARGETS=( + # Windows x86 + "i386-unknown-windows" "i686-unknown-windows" "x86_64-unknown-windows" -# targets for which to generate the llvm-targets file -TARGETS="${WINDOWS_x86} ${LINUX_ARM} ${LINUX_x86} ${ANDROID} ${QNX} ${MACOS} ${IOS}" + # Linux ARM + "arm-unknown-linux-gnueabihf" "armv6-unknown-linux-gnueabihf" "armv6l-unknown-linux-gnueabihf" + "armv7-unknown-linux-gnueabihf" "armv7a-unknown-linux-gnueabi" "armv7l-unknown-linux-gnueabihf" + "aarch64-unknown-linux-gnu" "aarch64-unknown-linux" + # Linux x86 + "i386-unknown-linux-gnu" "i386-unknown-linux" "x86_64-unknown-linux-gnu" "x86_64-unknown-linux" + # Linux Android + "armv7-unknown-linux-androideabi" "aarch64-unknown-linux-android" + + # QNX + "arm-unknown-nto-qnx-eabi" + + # macOS + "i386-apple-darwin" "x86_64-apple-darwin" + # iOS + "armv7-apple-ios arm64-apple-ios" "i386-apple-ios x86_64-apple-ios" +) # given the call to clang -c11 that clang --target -v generates, # parse the -target-cpu and -target-feature from @@ -61,7 +72,7 @@ FST=1 FILE=_____dummy.c touch $FILE -for target in $TARGETS; do +for target in "${TARGETS[@]}"; do # find the cpu and attributes emitte by clang for the given $target CPU="" ATTR=() From git at git.haskell.org Mon Aug 6 21:56:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 21:56:48 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T14880-nondet-fv' created Message-ID: <20180806215648.B6CA73A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T14880-nondet-fv Referencing: e74ba209f0606724085534b0e988c8545915c442 From git at git.haskell.org Mon Aug 6 21:56:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 21:56:52 +0000 (UTC) Subject: [commit: ghc] wip/T14880-nondet-fv: Rewrite tyCoVarsOf... in terms of new nondet FV (NDFV) (e74ba20) Message-ID: <20180806215652.5B86B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14880-nondet-fv Link : http://ghc.haskell.org/trac/ghc/changeset/e74ba209f0606724085534b0e988c8545915c442/ghc >--------------------------------------------------------------- commit e74ba209f0606724085534b0e988c8545915c442 Author: Tobias Dammers Date: Mon Aug 6 23:39:36 2018 +0200 Rewrite tyCoVarsOf... in terms of new nondet FV (NDFV) NDFV is a non-deterministic variation on FV - essentially, FV without the list part, but with all the other characteristics. This is to figure out whether the list part is the cause of performance issues in Trac #14880. >--------------------------------------------------------------- e74ba209f0606724085534b0e988c8545915c442 compiler/ghc.cabal.in | 1 + compiler/types/TyCoRep.hs | 77 ++++++++++++++++- compiler/utils/{FV.hs => NDFV.hs} | 168 +++++++++++++++++++------------------- 3 files changed, 161 insertions(+), 85 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e74ba209f0606724085534b0e988c8545915c442 From git at git.haskell.org Mon Aug 6 22:24:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:24:54 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump filepath submodule (751febe) Message-ID: <20180806222454.222423A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/751febe4fb3ab8b5fa328795929854acebe07922/ghc >--------------------------------------------------------------- commit 751febe4fb3ab8b5fa328795929854acebe07922 Author: Ben Gamari Date: Thu Aug 2 17:56:30 2018 -0400 Bump filepath submodule (cherry picked from commit 9472db132d2e455c106778c7daa30af71fbf6fee) >--------------------------------------------------------------- 751febe4fb3ab8b5fa328795929854acebe07922 libraries/filepath | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/filepath b/libraries/filepath index 1be834e..b10724b 160000 --- a/libraries/filepath +++ b/libraries/filepath @@ -1 +1 @@ -Subproject commit 1be834e1b3a3f8c5a14a58d73ce30133b4c69679 +Subproject commit b10724be8a907e191d153ad6674415be0c1325fd From git at git.haskell.org Mon Aug 6 22:24:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:24:56 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix the TcLevel not being set correctly when finding valid hole fits (f4e5433) Message-ID: <20180806222456.E628D3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/f4e54330d14c1601128d6ab3750a10709c05a427/ghc >--------------------------------------------------------------- commit f4e54330d14c1601128d6ab3750a10709c05a427 Author: Matthías Páll Gissurarson Date: Sat Jul 21 15:48:53 2018 +0200 Fix the TcLevel not being set correctly when finding valid hole fits Summary: This fixes the problem revealed by a new assert as it relates to valid hole fits. However, tests `T10384`, `T14040a` and `TcStaticPointersFail02` still fail the assert, but they are unrelated to valid hole fits. Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15384 Differential Revision: https://phabricator.haskell.org/D4994 (cherry picked from commit b202e7a48401bd8e805a92dcfe5ea059cbd8e41c) >--------------------------------------------------------------- f4e54330d14c1601128d6ab3750a10709c05a427 compiler/typecheck/TcHoleErrors.hs | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/compiler/typecheck/TcHoleErrors.hs b/compiler/typecheck/TcHoleErrors.hs index 74f199a..5718fef 100644 --- a/compiler/typecheck/TcHoleErrors.hs +++ b/compiler/typecheck/TcHoleErrors.hs @@ -29,7 +29,7 @@ import FV ( fvVarList, fvVarSet, unionFV, mkFVs, FV ) import Control.Arrow ( (&&&) ) import Control.Monad ( filterM, replicateM ) -import Data.List ( partition, sort, sortOn, nubBy, foldl' ) +import Data.List ( partition, sort, sortOn, nubBy ) import Data.Graph ( graphFromEdges, topSort ) import Data.Function ( on ) @@ -661,19 +661,17 @@ findValidHoleFits tidy_env implics simples ct | isExprHoleCt ct = isFlexiTyVar tv | isMetaTyVar tv = isFlexi <$> readMetaTyVar tv isFlexiTyVar _ = return False - -- Takes a list of free variables and makes sure that the given action - -- is run with the right TcLevel and restores any Flexi type - -- variables after the action is run. + -- Takes a list of free variables and restores any Flexi type variables + -- in free_vars after the action is run. withoutUnification :: FV -> TcM a -> TcM a withoutUnification free_vars action = do { flexis <- filterM isFlexiTyVar fuvs - ; result <- setTcLevel deepestFreeTyVarLvl action + ; result <- action -- Reset any mutated free variables ; mapM_ restore flexis ; return result } where restore = flip writeTcRef Flexi . metaTyVarRef fuvs = fvVarList free_vars - deepestFreeTyVarLvl = foldl' max topTcLevel $ map tcTyVarLevel fuvs -- The real work happens here, where we invoke the type checker using -- tcCheckHoleFit to see whether the given type fits the hole. @@ -891,13 +889,25 @@ tcSubsumes ty_a ty_b = fst <$> tcCheckHoleFit emptyBag [] ty_a ty_b -- free type variables to avoid side-effects. tcCheckHoleFit :: Cts -- Any relevant Cts to the hole. -> [Implication] -- The nested implications of the hole + -- with the innermost implication first -> TcSigmaType -- The type of the hole. -> TcSigmaType -- The type to check whether fits. -> TcM (Bool, HsWrapper) tcCheckHoleFit _ _ hole_ty ty | hole_ty `eqType` ty = return (True, idHsWrapper) tcCheckHoleFit relevantCts implics hole_ty ty = discardErrs $ - do { (wrp, wanted) <- captureConstraints $ tcSubType_NC ExprSigCtxt ty hole_ty + do { -- We wrap the subtype constraint in the implications to pass along the + -- givens, and so we must ensure that any nested implications and skolems + -- end up with the correct level. The implications are ordered so that + -- the innermost (the one with the highest level) is first, so it + -- suffices to get the level of the first one (or the current level, if + -- there are no implications involved). + innermost_lvl <- case implics of + [] -> getTcLevel + -- imp is the innermost implication + (imp:_) -> return (ic_tclvl imp) + ; (wrp, wanted) <- setTcLevel innermost_lvl $ captureConstraints $ + tcSubType_NC ExprSigCtxt ty hole_ty ; traceTc "Checking hole fit {" empty ; traceTc "wanteds are: " $ ppr wanted ; if isEmptyWC wanted && isEmptyBag relevantCts From git at git.haskell.org Mon Aug 6 22:24:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:24:59 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump Cabal submodule (d53e51f) Message-ID: <20180806222459.C233C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/d53e51ffb7944881878e9e85c8c902b7c72211ba/ghc >--------------------------------------------------------------- commit d53e51ffb7944881878e9e85c8c902b7c72211ba Author: Ben Gamari Date: Fri Aug 3 16:33:13 2018 -0400 Bump Cabal submodule >--------------------------------------------------------------- d53e51ffb7944881878e9e85c8c902b7c72211ba libraries/Cabal | 2 +- testsuite/tests/cabal/cabal05/cabal05.stderr | 4 ---- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 8828258..6671506 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 8828258813f726150cd748433a8ad0df3310c6bc +Subproject commit 6671506b488a0fe2079f9059a23510b35514c031 diff --git a/testsuite/tests/cabal/cabal05/cabal05.stderr b/testsuite/tests/cabal/cabal05/cabal05.stderr index 12a7334..eb51115 100644 --- a/testsuite/tests/cabal/cabal05/cabal05.stderr +++ b/testsuite/tests/cabal/cabal05/cabal05.stderr @@ -1,7 +1,3 @@ -the following packages have broken abi-depends fields: - p - q - r T.hs:3:1: error: Ambiguous module name ‘Conflict’: From git at git.haskell.org Mon Aug 6 22:25:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:25:02 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Refactor printMinimalImports (#15439) (f6e889f) Message-ID: <20180806222502.92CC23A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/f6e889fd1b9aa4e6f3ddaf69bc9446a7ca86fc8f/ghc >--------------------------------------------------------------- commit f6e889fd1b9aa4e6f3ddaf69bc9446a7ca86fc8f Author: vrom911 Date: Sun Aug 5 15:28:25 2018 +0200 Refactor printMinimalImports (#15439) Summary: Split into getMinimalImports and printMinimalImports. Export both functions from RnNames module. Reviewers: bgamari, mpickering Reviewed By: mpickering Subscribers: mpickering, rwbarton, carter GHC Trac Issues: #15439 Differential Revision: https://phabricator.haskell.org/D5045 (cherry picked from commit 73683f143d352343b00b1ab4f3abeb38b81794be) >--------------------------------------------------------------- f6e889fd1b9aa4e6f3ddaf69bc9446a7ca86fc8f compiler/rename/RnNames.hs | 48 ++++++++++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 21 deletions(-) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 10a97a7..9326fe4 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -22,6 +22,8 @@ module RnNames ( dodgyMsg, dodgyMsgInsert, findImportUsage, + getMinimalImports, + printMinimalImports, ImportDeclUsage ) where @@ -1452,28 +1454,9 @@ decls, and simply trim their import lists. NB that from it. Instead we just trim to an empty import list -} -printMinimalImports :: [ImportDeclUsage] -> RnM () --- See Note [Printing minimal imports] -printMinimalImports imports_w_usage - = do { imports' <- mapM mk_minimal imports_w_usage - ; this_mod <- getModule - ; dflags <- getDynFlags - ; liftIO $ - do { h <- openFile (mkFilename dflags this_mod) WriteMode - ; printForUser dflags h neverQualify (vcat (map ppr imports')) } - -- The neverQualify is important. We are printing Names - -- but they are in the context of an 'import' decl, and - -- we never qualify things inside there - -- E.g. import Blag( f, b ) - -- not import Blag( Blag.f, Blag.g )! - } +getMinimalImports :: [ImportDeclUsage] -> RnM [LImportDecl GhcRn] +getMinimalImports = mapM mk_minimal where - mkFilename dflags this_mod - | Just d <- dumpDir dflags = d basefn - | otherwise = basefn - where - basefn = moduleNameString (moduleName this_mod) ++ ".imports" - mk_minimal (L l decl, used, unused) | null unused , Just (False, _) <- ideclHiding decl @@ -1524,6 +1507,29 @@ printMinimalImports imports_w_usage all_non_overloaded = all (not . flIsOverloaded) +printMinimalImports :: [ImportDeclUsage] -> RnM () +-- See Note [Printing minimal imports] +printMinimalImports imports_w_usage + = do { imports' <- getMinimalImports imports_w_usage + ; this_mod <- getModule + ; dflags <- getDynFlags + ; liftIO $ + do { h <- openFile (mkFilename dflags this_mod) WriteMode + ; printForUser dflags h neverQualify (vcat (map ppr imports')) } + -- The neverQualify is important. We are printing Names + -- but they are in the context of an 'import' decl, and + -- we never qualify things inside there + -- E.g. import Blag( f, b ) + -- not import Blag( Blag.f, Blag.g )! + } + where + mkFilename dflags this_mod + | Just d <- dumpDir dflags = d basefn + | otherwise = basefn + where + basefn = moduleNameString (moduleName this_mod) ++ ".imports" + + to_ie_post_rn_var :: (HasOccName name) => Located name -> LIEWrappedName name to_ie_post_rn_var (L l n) | isDataOcc $ occName n = L l (IEPattern (L l n)) From git at git.haskell.org Mon Aug 6 22:25:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:25:05 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump binary submodule (e384b96) Message-ID: <20180806222505.6413A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/e384b96dfe61e9b721ffb2da3247eb28d88df619/ghc >--------------------------------------------------------------- commit e384b96dfe61e9b721ffb2da3247eb28d88df619 Author: Ben Gamari Date: Thu Aug 2 08:29:52 2018 -0400 Bump binary submodule (cherry picked from commit 3110428dd63a2014fe131cb2abff192570cc89e9) >--------------------------------------------------------------- e384b96dfe61e9b721ffb2da3247eb28d88df619 compiler/ghc.cabal.in | 2 +- libraries/binary | 2 +- libraries/ghc-boot/ghc-boot.cabal.in | 2 +- libraries/ghci/ghci.cabal.in | 2 +- libraries/libiserv/libiserv.cabal | 2 +- utils/iserv/iserv.cabal | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 01628dc..bf2d190 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -54,7 +54,7 @@ Library directory >= 1 && < 1.4, process >= 1 && < 1.7, bytestring >= 0.9 && < 0.11, - binary == 0.8.*, + binary == 0.10.*, time >= 1.4 && < 1.9, containers >= 0.5 && < 0.7, array >= 0.1 && < 0.6, diff --git a/libraries/binary b/libraries/binary index ecf48c4..b5a2454 160000 --- a/libraries/binary +++ b/libraries/binary @@ -1 +1 @@ -Subproject commit ecf48c4589b927de3ae3fff8455c1c25140df7e9 +Subproject commit b5a2454e331ba516a14bed77e30f7ef8251eea48 diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in index 0ca9c1e..ca1c19f 100644 --- a/libraries/ghc-boot/ghc-boot.cabal.in +++ b/libraries/ghc-boot/ghc-boot.cabal.in @@ -43,7 +43,7 @@ Library GHC.HandleEncoding build-depends: base >= 4.7 && < 4.13, - binary == 0.8.*, + binary == 0.10.*, bytestring == 0.10.*, directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, diff --git a/libraries/ghci/ghci.cabal.in b/libraries/ghci/ghci.cabal.in index 32ce79c..d7f112e 100644 --- a/libraries/ghci/ghci.cabal.in +++ b/libraries/ghci/ghci.cabal.in @@ -70,7 +70,7 @@ library Build-Depends: array == 0.5.*, base >= 4.8 && < 4.13, - binary == 0.8.*, + binary == 0.10.*, bytestring == 0.10.*, containers >= 0.5 && < 0.7, deepseq == 1.4.*, diff --git a/libraries/libiserv/libiserv.cabal b/libraries/libiserv/libiserv.cabal index 183e777..fc0a022 100644 --- a/libraries/libiserv/libiserv.cabal +++ b/libraries/libiserv/libiserv.cabal @@ -21,7 +21,7 @@ Library Exposed-Modules: Lib , GHCi.Utils Build-Depends: base >= 4 && < 5, - binary >= 0.7 && < 0.9, + binary >= 0.7 && < 0.11, bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.7, deepseq >= 1.4 && < 1.5, diff --git a/utils/iserv/iserv.cabal b/utils/iserv/iserv.cabal index 684da94..6e78317 100644 --- a/utils/iserv/iserv.cabal +++ b/utils/iserv/iserv.cabal @@ -31,7 +31,7 @@ Executable iserv include-dirs: . Build-Depends: array >= 0.5 && < 0.6, base >= 4 && < 5, - binary >= 0.7 && < 0.9, + binary >= 0.7 && < 0.11, bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.7, deepseq >= 1.4 && < 1.5, From git at git.haskell.org Mon Aug 6 22:25:08 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:25:08 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Turn on MonadFail desugaring by default (26b6ffb) Message-ID: <20180806222508.633783A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/26b6ffb3d5a66dc821635cdca8d9ce8dc2960c35/ghc >--------------------------------------------------------------- commit 26b6ffb3d5a66dc821635cdca8d9ce8dc2960c35 Author: Herbert Valerio Riedel Date: Mon Aug 6 12:59:40 2018 -0400 Turn on MonadFail desugaring by default This contains two commits: ---- Make GHC's code-base compatible w/ `MonadFail` There were a couple of use-sites which implicitly used pattern-matches in `do`-notation even though the underlying `Monad` didn't explicitly support `fail` This refactoring turns those use-sites into explicit case discrimations and adds an `MonadFail` instance for `UniqSM` (`UniqSM` was the worst offender so this has been postponed for a follow-up refactoring) --- Turn on MonadFail desugaring by default This finally implements the phase scheduled for GHC 8.6 according to https://prime.haskell.org/wiki/Libraries/Proposals/MonadFail#Transitiona lstrategy This also preserves some tests that assumed MonadFail desugaring to be active; all ghc boot libs were already made compatible with this `MonadFail` long ago, so no changes were needed there. Test Plan: Locally performed ./validate --fast Reviewers: bgamari, simonmar, jrtc27, RyanGlScott Reviewed By: bgamari Subscribers: bgamari, RyanGlScott, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5028 >--------------------------------------------------------------- 26b6ffb3d5a66dc821635cdca8d9ce8dc2960c35 compiler/basicTypes/UniqSupply.hs | 6 ++++ compiler/codeGen/StgCmmCon.hs | 6 ++-- compiler/codeGen/StgCmmMonad.hs | 11 +++++++- compiler/codeGen/StgCmmPrim.hs | 29 +++++++++----------- compiler/coreSyn/MkCore.hs | 3 +- compiler/deSugar/Coverage.hs | 8 ++++-- compiler/ghci/ByteCodeAsm.hs | 9 ++++-- compiler/ghci/RtClosureInspect.hs | 6 ++-- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 32 ++++++++++++++++------ compiler/main/DynFlags.hs | 2 ++ compiler/main/InteractiveEval.hs | 6 +++- compiler/nativeGen/SPARC/CodeGen.hs | 10 +++++-- compiler/rename/RnNames.hs | 7 +++-- compiler/typecheck/TcGenFunctor.hs | 25 ++++++++++------- docs/users_guide/8.6.1-notes.rst | 5 ++++ docs/users_guide/glasgow_exts.rst | 9 +++--- ghc/GHCi/UI.hs | 9 ++++-- testsuite/tests/annotations/should_run/annrun01.hs | 3 +- testsuite/tests/deSugar/should_run/dsrun010.hs | 2 ++ testsuite/tests/determinism/determ017/A.hs | 2 +- testsuite/tests/monadfail/MonadFailWarnings.hs | 2 +- .../tests/monadfail/MonadFailWarningsDisabled.hs | 5 ++++ testsuite/tests/rebindable/rebindable1.hs | 2 +- testsuite/tests/simplCore/should_run/T3591.hs | 2 +- .../tests/wcompat-warnings/WCompatWarningsNotOn.hs | 2 +- .../tests/wcompat-warnings/WCompatWarningsOff.hs | 2 +- .../tests/wcompat-warnings/WCompatWarningsOn.hs | 2 +- .../tests/wcompat-warnings/WCompatWarningsOnOff.hs | 2 +- 28 files changed, 141 insertions(+), 68 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 26b6ffb3d5a66dc821635cdca8d9ce8dc2960c35 From git at git.haskell.org Mon Aug 6 22:25:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:25:11 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: circleci: Don't build validate-x86_64-linux-debug unregisterised (9f1b1ab) Message-ID: <20180806222511.345BF3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/9f1b1abea146e0bbfe5565310b47f116d96bd503/ghc >--------------------------------------------------------------- commit 9f1b1abea146e0bbfe5565310b47f116d96bd503 Author: Ben Gamari Date: Sun Aug 5 22:27:21 2018 +0200 circleci: Don't build validate-x86_64-linux-debug unregisterised Summary: This was a cut-and-paste error. Reviewers: alpmestan Reviewed By: alpmestan Subscribers: alpmestan, rwbarton, thomie, carter GHC Trac Issues: #15466 Differential Revision: https://phabricator.haskell.org/D5037 (cherry picked from commit f355b72113e646cb3785937f5506ee4c084c127f) >--------------------------------------------------------------- 9f1b1abea146e0bbfe5565310b47f116d96bd503 .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index e52d38d..c27a526 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -218,7 +218,7 @@ jobs: - *prepare - *submodules - *boot - - *configure_unreg + - *configure_unix - *make - *test - *store_test_results From git at git.haskell.org Mon Aug 6 22:29:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:29:55 +0000 (UTC) Subject: [commit: ghc] master: Stop the linker panic (4fc6524) Message-ID: <20180806222955.D48423A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4fc6524a2a4a0003495a96c8b84783286f65c198/ghc >--------------------------------------------------------------- commit 4fc6524a2a4a0003495a96c8b84783286f65c198 Author: Moritz Angermann Date: Mon Aug 6 12:46:26 2018 -0400 Stop the linker panic If we fail to initialize the liker properly, we still set the `initLinkerDone`. In fact we even set that prior to actually initializing the linker. However if the linker initialization fails, we the `Done` state is still true. As such we run into the `Dynamic Linker not initialised` error. Which while technically corret is confusing as it pulls the attation away from the real issue. This change puts the Done state into an MVar, and as such ensureing that all parallel access needs to wait for the linker to be actually initialized, or try to re-initilize if it fails. Reviewers: bgamari, RyanGlScott, simonmar, hvr Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #9868, #10355, #13137, #13607, #13531 Differential Revision: https://phabricator.haskell.org/D5012 >--------------------------------------------------------------- 4fc6524a2a4a0003495a96c8b84783286f65c198 compiler/ghci/Linker.hs | 59 ++++++++++++++++++++++++++++--------------------- compiler/utils/Panic.hs | 13 +++++++++++ 2 files changed, 47 insertions(+), 25 deletions(-) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 286cd0d..9f1307d 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -87,35 +87,45 @@ import Foreign (Ptr) The persistent linker state *must* match the actual state of the C dynamic linker at all times, so we keep it in a private global variable. -The global IORef used for PersistentLinkerState actually contains another MVar. -The reason for this is that we want to allow another loaded copy of the GHC -library to side-effect the PLS and for those changes to be reflected here. +The global IORef used for PersistentLinkerState actually contains another MVar, +which in turn contains a Maybe PersistentLinkerState. The MVar serves to ensure +mutual exclusion between multiple loaded copies of the GHC library. The Maybe +may be Nothing to indicate that the linker has not yet been initialised. The PersistentLinkerState maps Names to actual closures (for interpreted code only), for use during linking. -} #if STAGE < 2 -GLOBAL_VAR_M(v_PersistentLinkerState, newMVar (panic "Dynamic linker not initialised"), MVar PersistentLinkerState) -GLOBAL_VAR(v_InitLinkerDone, False, Bool) -- Set True when dynamic linker is initialised +GLOBAL_VAR_M( v_PersistentLinkerState + , newMVar Nothing + , MVar (Maybe PersistentLinkerState)) #else SHARED_GLOBAL_VAR_M( v_PersistentLinkerState , getOrSetLibHSghcPersistentLinkerState , "getOrSetLibHSghcPersistentLinkerState" - , newMVar (panic "Dynamic linker not initialised") - , MVar PersistentLinkerState) --- Set True when dynamic linker is initialised -SHARED_GLOBAL_VAR( v_InitLinkerDone - , getOrSetLibHSghcInitLinkerDone - , "getOrSetLibHSghcInitLinkerDone" - , False - , Bool) + , newMVar Nothing + , MVar (Maybe PersistentLinkerState)) #endif +uninitialised :: a +uninitialised = panic "Dynamic linker not initialised" + modifyPLS_ :: (PersistentLinkerState -> IO PersistentLinkerState) -> IO () -modifyPLS_ f = readIORef v_PersistentLinkerState >>= flip modifyMVar_ f +modifyPLS_ f = readIORef v_PersistentLinkerState + >>= flip modifyMVar_ (fmap pure . f . fromMaybe uninitialised) modifyPLS :: (PersistentLinkerState -> IO (PersistentLinkerState, a)) -> IO a -modifyPLS f = readIORef v_PersistentLinkerState >>= flip modifyMVar f +modifyPLS f = readIORef v_PersistentLinkerState + >>= flip modifyMVar (fmapFst pure . f . fromMaybe uninitialised) + where fmapFst f = fmap (\(x, y) -> (f x, y)) + +readPLS :: IO PersistentLinkerState +readPLS = readIORef v_PersistentLinkerState + >>= fmap (fromMaybe uninitialised) . readMVar + +modifyMbPLS_ + :: (Maybe PersistentLinkerState -> IO (Maybe PersistentLinkerState)) -> IO () +modifyMbPLS_ f = readIORef v_PersistentLinkerState >>= flip modifyMVar_ f data PersistentLinkerState = PersistentLinkerState { @@ -255,7 +265,7 @@ withExtendedLinkEnv new_env action -- | Display the persistent linker state. showLinkerState :: DynFlags -> IO () showLinkerState dflags - = do pls <- readIORef v_PersistentLinkerState >>= readMVar + = do pls <- readPLS putLogMsg dflags NoReason SevDump noSrcSpan (defaultDumpStyle dflags) (vcat [text "----- Linker state -----", @@ -290,11 +300,10 @@ showLinkerState dflags -- initDynLinker :: HscEnv -> IO () initDynLinker hsc_env = - modifyPLS_ $ \pls0 -> do - done <- readIORef v_InitLinkerDone - if done then return pls0 - else do writeIORef v_InitLinkerDone True - reallyInitDynLinker hsc_env + modifyMbPLS_ $ \pls -> do + case pls of + Just _ -> return pls + Nothing -> Just <$> reallyInitDynLinker hsc_env reallyInitDynLinker :: HscEnv -> IO PersistentLinkerState reallyInitDynLinker hsc_env = do @@ -1338,8 +1347,8 @@ load_dyn hsc_env dll = do r <- loadDLL hsc_env dll case r of Nothing -> return () - Just err -> throwGhcExceptionIO (CmdLineError ("can't load .so/.DLL for: " - ++ dll ++ " (" ++ err ++ ")" )) + Just err -> cmdLineErrorIO ("can't load .so/.DLL for: " + ++ dll ++ " (" ++ err ++ ")") loadFrameworks :: HscEnv -> Platform -> PackageConfig -> IO () loadFrameworks hsc_env platform pkg @@ -1351,8 +1360,8 @@ loadFrameworks hsc_env platform pkg load fw = do r <- loadFramework hsc_env fw_dirs fw case r of Nothing -> return () - Just err -> throwGhcExceptionIO (CmdLineError ("can't load framework: " - ++ fw ++ " (" ++ err ++ ")" )) + Just err -> cmdLineErrorIO ("can't load framework: " + ++ fw ++ " (" ++ err ++ ")" ) -- Try to find an object file for a given library in the given paths. -- If it isn't present, we assume that addDLL in the RTS can find it, diff --git a/compiler/utils/Panic.hs b/compiler/utils/Panic.hs index ebf8303..03f095b 100644 --- a/compiler/utils/Panic.hs +++ b/compiler/utils/Panic.hs @@ -20,6 +20,8 @@ module Panic ( panic, sorry, assertPanic, trace, panicDoc, sorryDoc, pgmErrorDoc, + cmdLineError, cmdLineErrorIO, + Exception.Exception(..), showException, safeShowException, try, tryMost, throwTo, @@ -195,6 +197,17 @@ panicDoc x doc = throwGhcException (PprPanic x doc) sorryDoc x doc = throwGhcException (PprSorry x doc) pgmErrorDoc x doc = throwGhcException (PprProgramError x doc) +cmdLineError :: String -> a +cmdLineError = unsafeDupablePerformIO . cmdLineErrorIO + +cmdLineErrorIO :: String -> IO a +cmdLineErrorIO x = do + stack <- ccsToStrings =<< getCurrentCCS x + if null stack + then throwGhcException (CmdLineError x) + else throwGhcException (CmdLineError (x ++ '\n' : renderStack stack)) + + -- | Throw a failed assertion exception for a given filename and line number. assertPanic :: String -> Int -> a From git at git.haskell.org Mon Aug 6 22:29:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:29:58 +0000 (UTC) Subject: [commit: ghc] master: [docs] Add missed specialisations warnings to list of those not enabled by -Wall (24b76d1) Message-ID: <20180806222958.A31033A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/24b76d1bef7e61791907fbd063f85643eeb1211a/ghc >--------------------------------------------------------------- commit 24b76d1bef7e61791907fbd063f85643eeb1211a Author: Maximilian Tagher Date: Sat Jul 28 14:04:16 2018 -0700 [docs] Add missed specialisations warnings to list of those not enabled by -Wall Enabling `-Weverything` does enable those warnings. (cherry picked from commit b062bd10a88ea407ae91610f822f0c352909bcce) >--------------------------------------------------------------- 24b76d1bef7e61791907fbd063f85643eeb1211a docs/users_guide/using-warnings.rst | 2 ++ 1 file changed, 2 insertions(+) diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index 8d09b44..2d28fdd 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -82,6 +82,8 @@ The following flags are simple ways to select standard "packages" of warnings: * :ghc-flag:`-Widentities` * :ghc-flag:`-Wredundant-constraints` * :ghc-flag:`-Wpartial-fields` + * :ghc-flag:`-Wmissed-specialisations` + * :ghc-flag:`-Wall-missed-specialisations` .. ghc-flag:: -Weverything :shortdesc: enable all warnings supported by GHC From git at git.haskell.org Mon Aug 6 22:30:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:30:01 +0000 (UTC) Subject: [commit: ghc] master: rts: Ensure that the_gc_thread is aligned (c6cc93b) Message-ID: <20180806223001.7AC173A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c6cc93bca69abc258513af8cf2370b14e70fd8fb/ghc >--------------------------------------------------------------- commit c6cc93bca69abc258513af8cf2370b14e70fd8fb Author: Ben Gamari Date: Mon Aug 6 14:52:59 2018 -0400 rts: Ensure that the_gc_thread is aligned Since we cast this to a gc_thread the compiler may assume that it's aligned. Make sure that this is so. Fixes #15482. >--------------------------------------------------------------- c6cc93bca69abc258513af8cf2370b14e70fd8fb rts/sm/GC.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 742ae36..9b31516 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -128,7 +128,11 @@ uint32_t mutlist_MUTVARS, gc_thread **gc_threads = NULL; #if !defined(THREADED_RTS) -StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)]; +/* Use conservative alignment since we will cast this to a gc_thread and + * consequently the compiler may assume it is aligned. See #15482. + */ +StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)] + __attribute__((aligned(sizeof(W_)))); #endif // Number of threads running in *this* GC. Affects how many From git at git.haskell.org Mon Aug 6 22:30:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:30:04 +0000 (UTC) Subject: [commit: ghc] master: Improve error message for flags with missing required arguments (#12625) (ff06176) Message-ID: <20180806223004.D57D33A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ff06176b87078ce56cc7b6b3405a029ef3d0046f/ghc >--------------------------------------------------------------- commit ff06176b87078ce56cc7b6b3405a029ef3d0046f Author: roland Date: Mon Aug 6 12:50:38 2018 -0400 Improve error message for flags with missing required arguments (#12625) Test Plan: make TEST=T12625 Reviewers: jstolarek, austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #12625 Differential Revision: https://phabricator.haskell.org/D5030 >--------------------------------------------------------------- ff06176b87078ce56cc7b6b3405a029ef3d0046f compiler/main/CmdLineParser.hs | 6 ++++-- testsuite/tests/driver/T12625.hs | 2 ++ testsuite/tests/driver/{T3364.stderr => T12625.stderr} | 2 +- testsuite/tests/driver/all.T | 2 ++ 4 files changed, 9 insertions(+), 3 deletions(-) diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs index 49fbd8f..c876f58 100644 --- a/compiler/main/CmdLineParser.hs +++ b/compiler/main/CmdLineParser.hs @@ -242,8 +242,9 @@ processOneArg opt_kind rest arg args [] -> missingArgErr dash_arg (L _ arg1:args1) -> Right (f arg1, args1) + -- See Trac #12625 Prefix f | notNull rest_no_eq -> Right (f rest_no_eq, args) - | otherwise -> unknownFlagErr dash_arg + | otherwise -> missingArgErr dash_arg PrefixPred _ f | notNull rest_no_eq -> Right (f rest_no_eq, args) | otherwise -> unknownFlagErr dash_arg @@ -281,7 +282,8 @@ arg_ok :: OptKind t -> [Char] -> String -> Bool arg_ok (NoArg _) rest _ = null rest arg_ok (HasArg _) _ _ = True arg_ok (SepArg _) rest _ = null rest -arg_ok (Prefix _) rest _ = notNull rest +arg_ok (Prefix _) _ _ = True -- Missing argument checked for in processOneArg t + -- to improve error message (Trac #12625) arg_ok (PrefixPred p _) rest _ = notNull rest && p (dropEq rest) arg_ok (OptIntSuffix _) _ _ = True arg_ok (IntSuffix _) _ _ = True diff --git a/testsuite/tests/driver/T12625.hs b/testsuite/tests/driver/T12625.hs new file mode 100644 index 0000000..b34b914 --- /dev/null +++ b/testsuite/tests/driver/T12625.hs @@ -0,0 +1,2 @@ +main :: IO() +main = putStrLn "T12625" diff --git a/testsuite/tests/driver/T3364.stderr b/testsuite/tests/driver/T12625.stderr similarity index 50% copy from testsuite/tests/driver/T3364.stderr copy to testsuite/tests/driver/T12625.stderr index 852893f..a171dbd 100644 --- a/testsuite/tests/driver/T3364.stderr +++ b/testsuite/tests/driver/T12625.stderr @@ -1,2 +1,2 @@ -ghc: on the commandline: missing argument for flag: -H +ghc: on the commandline: missing argument for flag: -I Usage: For basic information, try the `--help' option. diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 6397598..07dc3bf 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -264,6 +264,8 @@ test('T12192', normal, run_command, ['mkdir foo && (cd foo && {compiler} -v0 ../ test('T10923', [], run_command, ['$MAKE -s --no-print-directory T10923']) +test('T12625', normal, compile_fail, ['-I']) + test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef']) test('T12955', normal, run_command, ['$MAKE -s --no-print-directory T12955']) From git at git.haskell.org Mon Aug 6 22:30:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:30:07 +0000 (UTC) Subject: [commit: ghc] master: Add since annotation to GHC.ByteOrder (8b357c6) Message-ID: <20180806223007.A86F93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8b357c6ad17bfe802c4a818b0cd7440bced024a3/ghc >--------------------------------------------------------------- commit 8b357c6ad17bfe802c4a818b0cd7440bced024a3 Author: Alexander Biehl Date: Sun Aug 5 12:29:51 2018 +0200 Add since annotation to GHC.ByteOrder (cherry picked from commit 6fb2620dbc420c976dc9da90b0efc6eae533ebff) >--------------------------------------------------------------- 8b357c6ad17bfe802c4a818b0cd7440bced024a3 libraries/base/GHC/ByteOrder.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/GHC/ByteOrder.hs b/libraries/base/GHC/ByteOrder.hs index a1f4da6..8a42e8d 100644 --- a/libraries/base/GHC/ByteOrder.hs +++ b/libraries/base/GHC/ByteOrder.hs @@ -12,6 +12,7 @@ -- -- Target byte ordering. -- +-- @since 4.11.0.0 ----------------------------------------------------------------------------- module GHC.ByteOrder where From git at git.haskell.org Mon Aug 6 22:30:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:30:10 +0000 (UTC) Subject: [commit: ghc] master: Unhide GHC.List for haddock (672f177) Message-ID: <20180806223010.78CBA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/672f177300b2df1b8a4cd49d560a6fd6da2415d2/ghc >--------------------------------------------------------------- commit 672f177300b2df1b8a4cd49d560a6fd6da2415d2 Author: Simon Jakobi Date: Thu Jul 19 14:35:15 2018 +0200 Unhide GHC.List for haddock The unhidden module GHC.OldList recommends using GHC.List instead. In consequence we should also have haddocks for GHC.List. (cherry picked from commit e3df129c8bf4c35693d01ea66238882f3e3b6fe1) >--------------------------------------------------------------- 672f177300b2df1b8a4cd49d560a6fd6da2415d2 libraries/base/GHC/List.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs index c6a1706..92b5952 100644 --- a/libraries/base/GHC/List.hs +++ b/libraries/base/GHC/List.hs @@ -1,7 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-} {-# LANGUAGE BangPatterns #-} -{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | From git at git.haskell.org Mon Aug 6 22:30:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:30:13 +0000 (UTC) Subject: [commit: ghc] master: docs: Fix wrong module name in hsig example (ce9b459) Message-ID: <20180806223013.4A5143A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ce9b459de30e15f2d65518ca12974a692256d477/ghc >--------------------------------------------------------------- commit ce9b459de30e15f2d65518ca12974a692256d477 Author: Mathieu Boespflug Date: Sat Jul 21 13:48:33 2018 +0200 docs: Fix wrong module name in hsig example In the module signatures section, two modules were defined, `Str` and `A`, but `A` was importing `Text`, not `Str`. (cherry picked from commit 26ab3635ca342c88310321d7f310f1c12c23ec4c) >--------------------------------------------------------------- ce9b459de30e15f2d65518ca12974a692256d477 docs/users_guide/separate_compilation.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst index 71a1a46..613e4de 100644 --- a/docs/users_guide/separate_compilation.rst +++ b/docs/users_guide/separate_compilation.rst @@ -790,7 +790,7 @@ be able to pick a particular implementation of strings:: toString s = s module A where - import Text + import Str z = toString empty By replacing ``Str.hs`` with a signature ``Str.hsig``, ``A`` (and From git at git.haskell.org Mon Aug 6 22:30:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Aug 2018 22:30:16 +0000 (UTC) Subject: [commit: ghc] master: fix timeout related i686 validation issues (e28bb01) Message-ID: <20180806223016.24C453A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e28bb01d707aee462eae07c5a30a596b2830579f/ghc >--------------------------------------------------------------- commit e28bb01d707aee462eae07c5a30a596b2830579f Author: Alp Mestanogullari Date: Mon Aug 6 17:53:29 2018 -0400 fix timeout related i686 validation issues As can be seen on https://circleci.com/gh/ghc/ghc/7578, some tests are failing on i686 due to too restrictive timeouts. This patch tweaks those in the hope of solving the 4 failures from that URL due to timeouts. Test Plan: ./validate on i686 Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5031 >--------------------------------------------------------------- e28bb01d707aee462eae07c5a30a596b2830579f testsuite/tests/perf/compiler/all.T | 15 +++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 2 +- 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index cc8f814..3e724ec 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -1186,6 +1186,11 @@ test('MultiLayerModules', ]), pre_cmd('./genMultiLayerModules'), extra_files(['genMultiLayerModules']), + compile_timeout_multiplier(2) + # 2 is _a lot_ (timeout after 600s, to build 600 modules), + # but this test has been failing every now and then, + # especially on i386. Let's just give it some room + # to complete successfully reliably everywhere. ], multimod_compile, ['MultiLayerModules', '-v0']) @@ -1229,6 +1234,11 @@ test('T13701', ]), pre_cmd('./genT13701'), extra_files(['genT13701']), + compile_timeout_multiplier(2) + # 2 is _a lot_ (timeout after 600s, to build 600 modules), + # but this test has been failing every now and then, + # especially on i386. Let's just give it some room + # to complete successfully reliably everywhere. ], multimod_compile, ['T13701', '-v0']) @@ -1241,6 +1251,11 @@ test('T13719', ]), pre_cmd('./genT13719'), extra_files(['genT13719']), + compile_timeout_multiplier(2) + # 2 is _a lot_ (timeout after 600s, to build 600 modules), + # but this test has been failing every now and then, + # especially on i386. Let's just give it some room + # to complete successfully reliably everywhere. ], multimod_compile, ['T13719', '-v0']) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index aba8c9b..378bdfa 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -337,7 +337,7 @@ test('tc260', normal, compile, ['']) test('tc261', normal, compile, ['']) test('tc262', normal, compile, ['']) test('tc263', [extra_files(['Tc263_Help.hs'])], multimod_compile, ['tc263', '-v0']) -test('tc265', compile_timeout_multiplier(0.01), compile, ['']) +test('tc265', normal, compile, ['']) test('tc266', [extra_files(['Tc266.hs', 'Tc266a.hs', 'Tc266.hs-boot'])], run_command, ['$MAKE -s --no-print-directory tc266']) test('Tc267', [extra_files(['Tc267a.hs', 'Tc267b.hs', 'Tc267a.hs-boot', 'Tc267b.hs-boot'])], run_command, ['$MAKE -s --no-print-directory Tc267']) test('tc268', normal, compile, ['']) From git at git.haskell.org Tue Aug 7 12:30:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 12:30:22 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: docs: Fix wrong module name in hsig example (6369aab) Message-ID: <20180807123022.4AA603A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/6369aab26e7a73e51efcd4da442c2adb6a0a5fbf/ghc >--------------------------------------------------------------- commit 6369aab26e7a73e51efcd4da442c2adb6a0a5fbf Author: Mathieu Boespflug Date: Sat Jul 21 13:48:33 2018 +0200 docs: Fix wrong module name in hsig example In the module signatures section, two modules were defined, `Str` and `A`, but `A` was importing `Text`, not `Str`. (cherry picked from commit 26ab3635ca342c88310321d7f310f1c12c23ec4c) (cherry picked from commit ce9b459de30e15f2d65518ca12974a692256d477) >--------------------------------------------------------------- 6369aab26e7a73e51efcd4da442c2adb6a0a5fbf docs/users_guide/separate_compilation.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst index e7501c2..e29d19e 100644 --- a/docs/users_guide/separate_compilation.rst +++ b/docs/users_guide/separate_compilation.rst @@ -790,7 +790,7 @@ be able to pick a particular implementation of strings:: toString s = s module A where - import Text + import Str z = toString empty By replacing ``Str.hs`` with a signature ``Str.hsig``, ``A`` (and From git at git.haskell.org Tue Aug 7 12:30:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 12:30:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: rts: Ensure that the_gc_thread is aligned (87a79e3) Message-ID: <20180807123025.1866B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/87a79e394013e5f722496900227b126015d0d780/ghc >--------------------------------------------------------------- commit 87a79e394013e5f722496900227b126015d0d780 Author: Ben Gamari Date: Mon Aug 6 14:52:59 2018 -0400 rts: Ensure that the_gc_thread is aligned Since we cast this to a gc_thread the compiler may assume that it's aligned. Make sure that this is so. Fixes #15482. (cherry picked from commit c6cc93bca69abc258513af8cf2370b14e70fd8fb) >--------------------------------------------------------------- 87a79e394013e5f722496900227b126015d0d780 rts/sm/GC.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 67eba93..bd4a81c 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -128,7 +128,11 @@ uint32_t mutlist_MUTVARS, gc_thread **gc_threads = NULL; #if !defined(THREADED_RTS) -StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)]; +/* Use conservative alignment since we will cast this to a gc_thread and + * consequently the compiler may assume it is aligned. See #15482. + */ +StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)] + __attribute__((aligned(sizeof(W_)))); #endif // Number of threads running in *this* GC. Affects how many From git at git.haskell.org Tue Aug 7 12:30:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 12:30:27 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Add since annotation to GHC.ByteOrder (b4302fd) Message-ID: <20180807123027.D9BB53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/b4302fd59b8ec127ad7011e6f6a4f969c78c486e/ghc >--------------------------------------------------------------- commit b4302fd59b8ec127ad7011e6f6a4f969c78c486e Author: Alexander Biehl Date: Sun Aug 5 12:29:51 2018 +0200 Add since annotation to GHC.ByteOrder (cherry picked from commit 6fb2620dbc420c976dc9da90b0efc6eae533ebff) (cherry picked from commit 8b357c6ad17bfe802c4a818b0cd7440bced024a3) >--------------------------------------------------------------- b4302fd59b8ec127ad7011e6f6a4f969c78c486e libraries/base/GHC/ByteOrder.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/GHC/ByteOrder.hs b/libraries/base/GHC/ByteOrder.hs index a1f4da6..8a42e8d 100644 --- a/libraries/base/GHC/ByteOrder.hs +++ b/libraries/base/GHC/ByteOrder.hs @@ -12,6 +12,7 @@ -- -- Target byte ordering. -- +-- @since 4.11.0.0 ----------------------------------------------------------------------------- module GHC.ByteOrder where From git at git.haskell.org Tue Aug 7 12:30:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 12:30:30 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Unhide GHC.List for haddock (eefac04) Message-ID: <20180807123030.A8AFB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/eefac0481b96ebad64dd6ddc17dae796b6b35797/ghc >--------------------------------------------------------------- commit eefac0481b96ebad64dd6ddc17dae796b6b35797 Author: Simon Jakobi Date: Thu Jul 19 14:35:15 2018 +0200 Unhide GHC.List for haddock The unhidden module GHC.OldList recommends using GHC.List instead. In consequence we should also have haddocks for GHC.List. (cherry picked from commit e3df129c8bf4c35693d01ea66238882f3e3b6fe1) (cherry picked from commit 672f177300b2df1b8a4cd49d560a6fd6da2415d2) >--------------------------------------------------------------- eefac0481b96ebad64dd6ddc17dae796b6b35797 libraries/base/GHC/List.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs index 793ff49..14991c2 100644 --- a/libraries/base/GHC/List.hs +++ b/libraries/base/GHC/List.hs @@ -1,7 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-} {-# LANGUAGE BangPatterns #-} -{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | From git at git.haskell.org Tue Aug 7 12:30:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 12:30:33 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: [docs] Add missed specialisations warnings to list of those not enabled by -Wall (8edc4b4) Message-ID: <20180807123033.7BC7F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/8edc4b4bac47d971b72b8ce62f847352cfe318e3/ghc >--------------------------------------------------------------- commit 8edc4b4bac47d971b72b8ce62f847352cfe318e3 Author: Maximilian Tagher Date: Sat Jul 28 14:04:16 2018 -0700 [docs] Add missed specialisations warnings to list of those not enabled by -Wall Enabling `-Weverything` does enable those warnings. (cherry picked from commit b062bd10a88ea407ae91610f822f0c352909bcce) (cherry picked from commit 24b76d1bef7e61791907fbd063f85643eeb1211a) >--------------------------------------------------------------- 8edc4b4bac47d971b72b8ce62f847352cfe318e3 docs/users_guide/using-warnings.rst | 2 ++ 1 file changed, 2 insertions(+) diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index 21e6aef..2643f8f 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -82,6 +82,8 @@ The following flags are simple ways to select standard "packages" of warnings: * :ghc-flag:`-Widentities` * :ghc-flag:`-Wredundant-constraints` * :ghc-flag:`-Wpartial-fields` + * :ghc-flag:`-Wmissed-specialisations` + * :ghc-flag:`-Wall-missed-specialisations` .. ghc-flag:: -Weverything :shortdesc: enable all warnings supported by GHC From git at git.haskell.org Tue Aug 7 12:30:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 12:30:36 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Testsuite driver: fix encoding issue when calling ghc-pkg (2bbff4d) Message-ID: <20180807123036.4A9873A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/2bbff4dccc05a82492458c113ba24b8cd6caf41d/ghc >--------------------------------------------------------------- commit 2bbff4dccc05a82492458c113ba24b8cd6caf41d Author: Krzysztof Gogolewski Date: Mon Aug 6 21:38:52 2018 +0200 Testsuite driver: fix encoding issue when calling ghc-pkg Summary: In Python 3, subprocess.communicate() returns a pair of bytes, which need to be decoded. In runtests.py, we were just calling str() instead, which converts b'x' to "b'x'". As a result, the loop that was checking pkginfo for lines starting with 'library-dirs' couldn't work. Reviewers: bgamari, thomie, Phyx Reviewed By: thomie Subscribers: Phyx, rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5046 (cherry picked from commit 36a4c19494e2cb7e968f1d0e0c09926a660e1a56) >--------------------------------------------------------------- 2bbff4dccc05a82492458c113ba24b8cd6caf41d testsuite/config/ghc | 4 ++-- testsuite/driver/runtests.py | 2 +- testsuite/driver/testutil.py | 5 ++--- 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/testsuite/config/ghc b/testsuite/config/ghc index f41f372..5e442b6 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -158,10 +158,10 @@ llvm_ways = [x[0] for x in config.way_flags.items() if '-fflvm' in x[1]] def get_compiler_info(): - s = getStdout([config.compiler, '--info']).decode('utf8') + s = getStdout([config.compiler, '--info']) s = re.sub('[\r\n]', '', s) compilerInfoDict = dict(eval(s)) - s = getStdout([config.compiler, '+RTS', '--info']).decode('utf8') + s = getStdout([config.compiler, '+RTS', '--info']) s = re.sub('[\r\n]', '', s) rtsInfoDict = dict(eval(s)) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 4e275c5..05f934e 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -193,7 +193,7 @@ def format_path(path): # On Windows we need to set $PATH to include the paths to all the DLLs # in order for the dynamic library tests to work. if windows or darwin: - pkginfo = str(getStdout([config.ghc_pkg, 'dump'])) + pkginfo = getStdout([config.ghc_pkg, 'dump']) topdir = config.libdir if windows: mingw = os.path.abspath(os.path.join(topdir, '../mingw/bin')) diff --git a/testsuite/driver/testutil.py b/testsuite/driver/testutil.py index dcba177..7c2efa8 100644 --- a/testsuite/driver/testutil.py +++ b/testsuite/driver/testutil.py @@ -11,8 +11,7 @@ def strip_quotes(s): return s.strip('\'"') def getStdout(cmd_and_args): - # Can't use subprocess.check_output as it's not available in Python 2.6; - # It's also not quite the same as check_output, since we also verify that + # Can't use subprocess.check_output, since we also verify that # no stderr was produced p = subprocess.Popen([strip_quotes(cmd_and_args[0])] + cmd_and_args[1:], stdout=subprocess.PIPE, @@ -23,7 +22,7 @@ def getStdout(cmd_and_args): raise Exception("Command failed: " + str(cmd_and_args)) if stderr: raise Exception("stderr from command: %s\nOutput:\n%s\n" % (cmd_and_args, stderr)) - return stdout + return stdout.decode('utf-8') def mkdirp(path): try: From git at git.haskell.org Tue Aug 7 12:33:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 12:33:46 +0000 (UTC) Subject: [commit: packages/binary] master: Set version to 0.8.6.0. (38adf7c) Message-ID: <20180807123346.51E5F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/38adf7ce1ad6a497fba61de500c3f35b186303a9 >--------------------------------------------------------------- commit 38adf7ce1ad6a497fba61de500c3f35b186303a9 Author: Lennart Kolmodin Date: Sat Aug 4 11:10:23 2018 +0000 Set version to 0.8.6.0. There was no breaking changes in version 0.10.0.0, so let's also release under 0.8.6.0. >--------------------------------------------------------------- 38adf7ce1ad6a497fba61de500c3f35b186303a9 binary.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/binary.cabal b/binary.cabal index 343903c..1d1b9cf 100644 --- a/binary.cabal +++ b/binary.cabal @@ -1,5 +1,5 @@ name: binary -version: 0.10.0.0 +version: 0.8.6.0 license: BSD3 license-file: LICENSE author: Lennart Kolmodin From git at git.haskell.org Tue Aug 7 12:33:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 12:33:48 +0000 (UTC) Subject: [commit: packages/binary] master: Add two more other-modules. (036e4eb) Message-ID: <20180807123348.570473A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/036e4ebb05f25803140eebddece7a44e30aca1be >--------------------------------------------------------------- commit 036e4ebb05f25803140eebddece7a44e30aca1be Author: Lennart Kolmodin Date: Mon Aug 6 09:34:52 2018 +0000 Add two more other-modules. >--------------------------------------------------------------- 036e4ebb05f25803140eebddece7a44e30aca1be binary.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/binary.cabal b/binary.cabal index 1d1b9cf..9b25877 100644 --- a/binary.cabal +++ b/binary.cabal @@ -158,6 +158,7 @@ benchmark get Data.Binary.Class Data.Binary.FloatCast Data.Binary.Generic + Data.Binary.Get Data.Binary.Get.Internal Data.Binary.Internal Data.Binary.Put @@ -190,6 +191,7 @@ benchmark put Data.Binary.Get Data.Binary.Get.Internal Data.Binary.Internal + Data.Binary.Put build-depends: base >= 4.5.0.0 && < 5, bytestring >= 0.10.4, From git at git.haskell.org Tue Aug 7 12:33:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 12:33:50 +0000 (UTC) Subject: [commit: packages/binary] master: Add initial Dockerfile running binary's tests. (6ef8384) Message-ID: <20180807123350.5ECB53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/6ef8384e077d5bd434ffe2646703c0ead6f7d6df >--------------------------------------------------------------- commit 6ef8384e077d5bd434ffe2646703c0ead6f7d6df Author: Lennart Kolmodin Date: Mon Aug 6 09:35:20 2018 +0000 Add initial Dockerfile running binary's tests. >--------------------------------------------------------------- 6ef8384e077d5bd434ffe2646703c0ead6f7d6df .dockerignore | 4 ++ docker/Dockerfile.ghc843 | 95 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 99 insertions(+) diff --git a/.dockerignore b/.dockerignore new file mode 100644 index 0000000..1e47413 --- /dev/null +++ b/.dockerignore @@ -0,0 +1,4 @@ +.git +dist +dist-newstyle +Dockerfile diff --git a/docker/Dockerfile.ghc843 b/docker/Dockerfile.ghc843 new file mode 100644 index 0000000..6b84c00 --- /dev/null +++ b/docker/Dockerfile.ghc843 @@ -0,0 +1,95 @@ +# Dockerfile to load a haskell environment for running binary's test suite. +# +# Building the Dockerfile creates an image which has the haskell environment +# with ghc and cabal setup and ready to use. +# +# Use a docker volume to cache built dependencies. It will greatly speed up +# running the tests repeatedly. +# +# Create a volume: +# +# docker volume create cabal-store-cache +# +# How to build: +# +# docker build -f docker/Dockerfile.ghc843 -t haskell/binary . +# +# How to run (caching the cabal store directory), default is 'cabal new-test': +# +# docker run -it haskell/binary -v cabal-store-cache:/root/.cabal/store +# +# Run 'cabal new-bench' or any other command (bash, to get into the machine): +# +# docker run -it haskell/binary -v cabal-store-cache:/root/.cabal/store \ +# cabal new-bench +# +# Hacks to build binary: +# +# 1) Copy all files from the host machine. +# +# 2) Rename binary to binary-next. This is an unfortunate consequence of +# binary being used by its test and benchmark dependencies. +# Not renaming binary will make cabal confused and it'll fail to build. +# +# Cabal can be made to build properly by carefully installing the test +# and benchmark dependencies manually, like it's done in .travis.yml. +# Unfortunately that setup is very fragile since changing the +# dependencies in binary.cabal also requires updating .travis.yml. +# Thus .travis.yml gets out of sync when we forget. +# This method also doesn't work with the nix-style commands which +# themselves take care of installing dependencies. +# The simples workaround I've found, and the only thing that works +# with nix-style commands, is to simply rename the package +# +# 3) Do 'cabal sdist' to get only the files for source distribution. +# +# 4) Unpack the .tar.gz file from (3) and copy generics-bench.cache.gz +# to the same dir. +# +# 5) The setup is complete. You may run cabal new-test, +# or any other command. +# + +FROM debian:stable + +# setup locale, US English with UTF-8. +# not setting a locale will make some apps fail when outputting utf8. +RUN apt-get update && \ + apt-get install -y locales && \ + locale-gen C.UTF-8 && \ + /usr/sbin/update-locale LANG=C.UTF-8 && \ + apt-get remove -y locales + +ENV LANG C.UTF-8 + +# key used by haskell repo +RUN apt-get update && apt-get install -y gnupg dirmngr +RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys BA3CBA3FFE22B574 + +# add haskell repo for debian +RUN echo "deb http://downloads.haskell.org/debian stretch main" > /etc/apt/sources.list.d/haskell.list + +RUN apt update && apt install -y cabal-install-2.2 +RUN apt update && apt install -y ghc-8.4.3 +RUN apt update && apt-get install -y zlib1g-dev + +ENV PATH=/opt/ghc/bin:$PATH + +RUN cabal update + +COPY . /workdir/copy + +WORKDIR /workdir/copy +RUN sed -i.bak -e 's/name:\s*binary/name: binary-next/' binary.cabal +RUN mv binary.cabal binary-next.cabal +RUN cabal sdist + +WORKDIR /workdir/builddir +RUN tar xf /workdir/copy/dist/*.tar.gz -C /workdir/builddir +RUN mv /workdir/builddir/binary-* /workdir/builddir/binary-next +# generics-bench.cache.gz is not part of the binary distribution, +# it's too large. It only lives in the git repo. Copy it manually. +RUN mv /workdir/copy/generics-bench.cache.gz /workdir/builddir/binary-next +WORKDIR /workdir/builddir/binary-next + +CMD cabal new-test From git at git.haskell.org Tue Aug 7 13:15:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 13:15:58 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Fix documentation building (60ea866) Message-ID: <20180807131558.D80473A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/60ea866b945de8de5660cc2085674d09b0d333a8/ghc >--------------------------------------------------------------- commit 60ea866b945de8de5660cc2085674d09b0d333a8 Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- 60ea866b945de8de5660cc2085674d09b0d333a8 .circleci/config.yml | 18 ++++++++------ .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 33 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 19 +++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 +++++++- .circleci/prepare-system.sh | 20 ++++++++++++--- 6 files changed, 93 insertions(+), 13 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 60ea866b945de8de5660cc2085674d09b0d333a8 From git at git.haskell.org Tue Aug 7 15:44:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 15:44:49 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: Bump hadrian submodule (5140b23) Message-ID: <20180807154449.42AA43A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/5140b23ae9fef1d59688643ce5c33eb2d44eaede/ghc >--------------------------------------------------------------- commit 5140b23ae9fef1d59688643ce5c33eb2d44eaede Author: Ben Gamari Date: Sun Aug 5 10:24:30 2018 -0400 Bump hadrian submodule >--------------------------------------------------------------- 5140b23ae9fef1d59688643ce5c33eb2d44eaede hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index a63ad32..4265e3a 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit a63ad3294b5d51eec50d454810a314c0b2a696c7 +Subproject commit 4265e3aab7df92722b81148cf8bf3954ebfc2d21 From git at git.haskell.org Tue Aug 7 15:44:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 15:44:52 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Fix documentation building (abc6239) Message-ID: <20180807154452.AB2923A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/abc6239d888e4f002bef79ae8b7796eedbb795f4/ghc >--------------------------------------------------------------- commit abc6239d888e4f002bef79ae8b7796eedbb795f4 Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- abc6239d888e4f002bef79ae8b7796eedbb795f4 .circleci/config.yml | 18 ++++++++------ .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 33 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 19 +++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 +++++++- .circleci/prepare-system.sh | 20 ++++++++++++--- 6 files changed, 93 insertions(+), 13 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc abc6239d888e4f002bef79ae8b7796eedbb795f4 From git at git.haskell.org Tue Aug 7 15:44:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 15:44:55 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs's head updated: circleci: Fix documentation building (abc6239) Message-ID: <20180807154455.8AA523A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/fix-docs' now includes: 48fe84e fixup! Disable T10962 on llvm for now d53e51f Bump Cabal submodule e384b96 Bump binary submodule 751febe Bump filepath submodule 26b6ffb Turn on MonadFail desugaring by default f4e5433 Fix the TcLevel not being set correctly when finding valid hole fits f6e889f Refactor printMinimalImports (#15439) 9f1b1ab circleci: Don't build validate-x86_64-linux-debug unregisterised 87a79e3 rts: Ensure that the_gc_thread is aligned b4302fd Add since annotation to GHC.ByteOrder 6369aab docs: Fix wrong module name in hsig example eefac04 Unhide GHC.List for haddock 8edc4b4 [docs] Add missed specialisations warnings to list of those not enabled by -Wall 2bbff4d Testsuite driver: fix encoding issue when calling ghc-pkg 5140b23 Bump hadrian submodule abc6239 circleci: Fix documentation building From git at git.haskell.org Tue Aug 7 15:47:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 15:47:58 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Fix documentation building (855f518) Message-ID: <20180807154758.B2B893A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/855f51807419485a89f96d7ba8193d30d22027d9/ghc >--------------------------------------------------------------- commit 855f51807419485a89f96d7ba8193d30d22027d9 Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- 855f51807419485a89f96d7ba8193d30d22027d9 .circleci/config.yml | 21 ++++++++-------- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 33 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 19 +++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 +++++++- .circleci/prepare-system.sh | 20 ++++++++++++--- 6 files changed, 94 insertions(+), 15 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 855f51807419485a89f96d7ba8193d30d22027d9 From git at git.haskell.org Tue Aug 7 16:41:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 16:41:21 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Fix documentation building (fb7b3d8) Message-ID: <20180807164121.E8B573A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/fb7b3d8bb3eef60999e66186768bd059fc5dd92d/ghc >--------------------------------------------------------------- commit fb7b3d8bb3eef60999e66186768bd059fc5dd92d Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- fb7b3d8bb3eef60999e66186768bd059fc5dd92d .circleci/config.yml | 21 ++++++++-------- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 33 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 19 +++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 +++++++- .circleci/prepare-system.sh | 20 ++++++++++++--- 6 files changed, 94 insertions(+), 15 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 fb7b3d8bb3eef60999e66186768bd059fc5dd92d From git at git.haskell.org Tue Aug 7 17:26:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 17:26:22 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump binary submodule to 0.8.6.0 (d092321) Message-ID: <20180807172622.C4BBD3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/d0923219fefc16770305169bb37fdb2700194d45/ghc >--------------------------------------------------------------- commit d0923219fefc16770305169bb37fdb2700194d45 Author: Ben Gamari Date: Mon Aug 6 18:39:35 2018 -0400 Bump binary submodule to 0.8.6.0 This is actually a decrease in the version number since a bump to 0.10 wasn't actually necessary. (cherry picked from commit 960a7d17a79417300ee81e884e867bf3de4e535b) >--------------------------------------------------------------- d0923219fefc16770305169bb37fdb2700194d45 compiler/ghc.cabal.in | 2 +- libraries/binary | 2 +- libraries/ghc-boot/ghc-boot.cabal.in | 2 +- libraries/ghci/ghci.cabal.in | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index bf2d190..01628dc 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -54,7 +54,7 @@ Library directory >= 1 && < 1.4, process >= 1 && < 1.7, bytestring >= 0.9 && < 0.11, - binary == 0.10.*, + binary == 0.8.*, time >= 1.4 && < 1.9, containers >= 0.5 && < 0.7, array >= 0.1 && < 0.6, diff --git a/libraries/binary b/libraries/binary index b5a2454..38adf7c 160000 --- a/libraries/binary +++ b/libraries/binary @@ -1 +1 @@ -Subproject commit b5a2454e331ba516a14bed77e30f7ef8251eea48 +Subproject commit 38adf7ce1ad6a497fba61de500c3f35b186303a9 diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in index ca1c19f..0ca9c1e 100644 --- a/libraries/ghc-boot/ghc-boot.cabal.in +++ b/libraries/ghc-boot/ghc-boot.cabal.in @@ -43,7 +43,7 @@ Library GHC.HandleEncoding build-depends: base >= 4.7 && < 4.13, - binary == 0.10.*, + binary == 0.8.*, bytestring == 0.10.*, directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, diff --git a/libraries/ghci/ghci.cabal.in b/libraries/ghci/ghci.cabal.in index d7f112e..32ce79c 100644 --- a/libraries/ghci/ghci.cabal.in +++ b/libraries/ghci/ghci.cabal.in @@ -70,7 +70,7 @@ library Build-Depends: array == 0.5.*, base >= 4.8 && < 4.13, - binary == 0.10.*, + binary == 0.8.*, bytestring == 0.10.*, containers >= 0.5 && < 0.7, deepseq == 1.4.*, From git at git.haskell.org Tue Aug 7 17:26:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 17:26:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.6's head updated: Bump binary submodule to 0.8.6.0 (d092321) Message-ID: <20180807172625.74B413A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'ghc-8.6' now includes: 5140b23 Bump hadrian submodule d092321 Bump binary submodule to 0.8.6.0 From git at git.haskell.org Tue Aug 7 17:56:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 17:56:00 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Fix documentation building (c1cbbea) Message-ID: <20180807175600.7AC0D3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/c1cbbea26913ea009ed52e30391dcdc87899f399/ghc >--------------------------------------------------------------- commit c1cbbea26913ea009ed52e30391dcdc87899f399 Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- c1cbbea26913ea009ed52e30391dcdc87899f399 .circleci/config.yml | 21 ++++++++-------- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 33 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 19 +++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 +++++++- .circleci/prepare-system.sh | 20 ++++++++++++--- libraries/Cabal | 2 +- 7 files changed, 95 insertions(+), 16 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 c1cbbea26913ea009ed52e30391dcdc87899f399 From git at git.haskell.org Tue Aug 7 19:55:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 19:55:37 +0000 (UTC) Subject: [commit: ghc] master: Support typechecking of type literals in backpack (7d77198) Message-ID: <20180807195537.1E25D3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7d771987c2766bfedc92f5183d6fd571ab508a0e/ghc >--------------------------------------------------------------- commit 7d771987c2766bfedc92f5183d6fd571ab508a0e Author: Piyush P Kurur Date: Mon Aug 6 18:37:56 2018 -0400 Support typechecking of type literals in backpack Backpack is unable to type check signatures that expect a data which is a type level literal. This was reported in issue #15138. These commits are a fix for this. It also includes a minimal test case that was mentioned in the issue. Reviewers: bgamari, ezyang, goldfire Reviewed By: bgamari, ezyang Subscribers: simonpj, ezyang, rwbarton, thomie, carter GHC Trac Issues: #15138 Differential Revision: https://phabricator.haskell.org/D4951 >--------------------------------------------------------------- 7d771987c2766bfedc92f5183d6fd571ab508a0e compiler/typecheck/TcRnDriver.hs | 12 +++++++- compiler/types/Type.hs | 6 ++++ testsuite/tests/backpack/should_run/T15138.bkp | 36 +++++++++++++++++++++++ testsuite/tests/backpack/should_run/T15138.stdout | 1 + testsuite/tests/backpack/should_run/all.T | 1 + 5 files changed, 55 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 4449d67..cc9518f 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -1016,7 +1016,6 @@ checkBootTyCon is_boot tc1 tc2 = ASSERT(tc1 == tc2) checkRoles roles1 roles2 `andThenCheck` check (eqTypeX env syn_rhs1 syn_rhs2) empty -- nothing interesting to say - -- This allows abstract 'data T a' to be implemented using 'type T = ...' -- and abstract 'class K a' to be implement using 'type K = ...' -- See Note [Synonyms implement abstract data] @@ -1031,6 +1030,17 @@ checkBootTyCon is_boot tc1 tc2 -- So for now, let it all through (it won't cause segfaults, anyway). -- Tracked at #12704. + -- This allows abstract 'data T :: Nat' to be implemented using + -- 'type T = 42' Since the kinds already match (we have checked this + -- upfront) all we need to check is that the implementation 'type T + -- = ...' defined an actual literal. See #15138 for the case this + -- handles. + | not is_boot + , isAbstractTyCon tc1 + , Just (_,ty2) <- synTyConDefn_maybe tc2 + , isJust (isLitTy ty2) + = Nothing + | Just fam_flav1 <- famTyConFlav_maybe tc1 , Just fam_flav2 <- famTyConFlav_maybe tc2 = ASSERT(tc1 == tc2) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 3a3048d..ac1c8b9 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -48,6 +48,7 @@ module Type ( mkNumLitTy, isNumLitTy, mkStrLitTy, isStrLitTy, + isLitTy, getRuntimeRep_maybe, getRuntimeRepFromKind_maybe, @@ -856,6 +857,11 @@ isStrLitTy ty | Just ty1 <- coreView ty = isStrLitTy ty1 isStrLitTy (LitTy (StrTyLit s)) = Just s isStrLitTy _ = Nothing +-- | Is this a type literal (symbol or numeric). +isLitTy :: Type -> Maybe TyLit +isLitTy ty | Just ty1 <- coreView ty = isLitTy ty1 +isLitTy (LitTy l) = Just l +isLitTy _ = Nothing -- | Is this type a custom user error? -- If so, give us the kind and the error message. diff --git a/testsuite/tests/backpack/should_run/T15138.bkp b/testsuite/tests/backpack/should_run/T15138.bkp new file mode 100644 index 0000000..7cb9eeb --- /dev/null +++ b/testsuite/tests/backpack/should_run/T15138.bkp @@ -0,0 +1,36 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} + +unit indef where + + signature Abstract where + import GHC.TypeLits + data NatType :: Nat + + module Util where + import Abstract + import Data.Proxy + import GHC.TypeLits + + natTypeToInteger :: KnownNat NatType => Proxy NatType -> Integer + natTypeToInteger = natVal + +unit concrete where + module Concrete where + type NatType = 32 + + +unit main where + dependency indef[Abstract=concrete:Concrete] (Util as MyUtil) + + module Main where + import Data.Proxy + import MyUtil + + main :: IO () + main = do print $ natTypeToInteger Proxy diff --git a/testsuite/tests/backpack/should_run/T15138.stdout b/testsuite/tests/backpack/should_run/T15138.stdout new file mode 100644 index 0000000..f5c8955 --- /dev/null +++ b/testsuite/tests/backpack/should_run/T15138.stdout @@ -0,0 +1 @@ +32 diff --git a/testsuite/tests/backpack/should_run/all.T b/testsuite/tests/backpack/should_run/all.T index 48ed0c6..61277b8 100644 --- a/testsuite/tests/backpack/should_run/all.T +++ b/testsuite/tests/backpack/should_run/all.T @@ -8,3 +8,4 @@ test('bkprun07', normal, backpack_run, ['']) test('bkprun08', normal, backpack_run, ['']) test('bkprun09', normal, backpack_run, ['-O']) test('T13955', normal, backpack_run, ['']) +test('T15138', normal, backpack_run, ['']) From git at git.haskell.org Tue Aug 7 19:55:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 19:55:40 +0000 (UTC) Subject: [commit: ghc] master: Bump binary submodule to 0.8.6.0 (2604d9b) Message-ID: <20180807195540.00EC73A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2604d9b48dfc3fee41082652dc26bf818626e317/ghc >--------------------------------------------------------------- commit 2604d9b48dfc3fee41082652dc26bf818626e317 Author: Ben Gamari Date: Mon Aug 6 18:39:35 2018 -0400 Bump binary submodule to 0.8.6.0 This is actually a decrease in the version number since a bump to 0.10 wasn't actually necessary. >--------------------------------------------------------------- 2604d9b48dfc3fee41082652dc26bf818626e317 compiler/ghc.cabal.in | 2 +- libraries/binary | 2 +- libraries/ghc-boot/ghc-boot.cabal.in | 2 +- libraries/ghci/ghci.cabal.in | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 2c057bc..5c9d88f 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -59,7 +59,7 @@ Library directory >= 1 && < 1.4, process >= 1 && < 1.7, bytestring >= 0.9 && < 0.11, - binary == 0.10.*, + binary == 0.8.*, time >= 1.4 && < 1.9, containers >= 0.5 && < 0.7, array >= 0.1 && < 0.6, diff --git a/libraries/binary b/libraries/binary index b5a2454..38adf7c 160000 --- a/libraries/binary +++ b/libraries/binary @@ -1 +1 @@ -Subproject commit b5a2454e331ba516a14bed77e30f7ef8251eea48 +Subproject commit 38adf7ce1ad6a497fba61de500c3f35b186303a9 diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in index ca1c19f..0ca9c1e 100644 --- a/libraries/ghc-boot/ghc-boot.cabal.in +++ b/libraries/ghc-boot/ghc-boot.cabal.in @@ -43,7 +43,7 @@ Library GHC.HandleEncoding build-depends: base >= 4.7 && < 4.13, - binary == 0.10.*, + binary == 0.8.*, bytestring == 0.10.*, directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, diff --git a/libraries/ghci/ghci.cabal.in b/libraries/ghci/ghci.cabal.in index d7f112e..32ce79c 100644 --- a/libraries/ghci/ghci.cabal.in +++ b/libraries/ghci/ghci.cabal.in @@ -70,7 +70,7 @@ library Build-Depends: array == 0.5.*, base >= 4.8 && < 4.13, - binary == 0.10.*, + binary == 0.8.*, bytestring == 0.10.*, containers >= 0.5 && < 0.7, deepseq == 1.4.*, From git at git.haskell.org Tue Aug 7 19:55:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 19:55:42 +0000 (UTC) Subject: [commit: ghc] master: fixup! Turn on MonadFail desugaring by default (e55d471) Message-ID: <20180807195542.D1F443A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e55d47128b3f0303d4468c879727683ec29fd02c/ghc >--------------------------------------------------------------- commit e55d47128b3f0303d4468c879727683ec29fd02c Author: Ben Gamari Date: Tue Aug 7 15:54:10 2018 -0400 fixup! Turn on MonadFail desugaring by default >--------------------------------------------------------------- e55d47128b3f0303d4468c879727683ec29fd02c testsuite/tests/annotations/should_run/annrun01.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/annotations/should_run/annrun01.hs b/testsuite/tests/annotations/should_run/annrun01.hs index 0dbd44d..9030a39 100644 --- a/testsuite/tests/annotations/should_run/annrun01.hs +++ b/testsuite/tests/annotations/should_run/annrun01.hs @@ -4,6 +4,7 @@ module Main where import GHC import MonadUtils ( liftIO ) +import Data.Maybe import DynFlags ( defaultFatalMessager, defaultFlushOut ) import Annotations ( AnnTarget(..), CoreAnnTarget ) import GHC.Serialized ( deserializeWithData ) @@ -34,7 +35,7 @@ main = defaultErrorHandler defaultFatalMessager defaultFlushOut liftIO $ putStrLn "Finding Module" mod <- findModule mod_nm Nothing liftIO $ putStrLn "Getting Module Info" - Just mod_info <- getModuleInfo mod + mod_info <- fromJust <$> getModuleInfo mod liftIO $ putStrLn "Showing Details For Module" showTargetAnns (ModuleTarget mod) From git at git.haskell.org Tue Aug 7 19:55:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 19:55:45 +0000 (UTC) Subject: [commit: ghc] master: Turn on MonadFail desugaring by default (6f4449e) Message-ID: <20180807195545.D1E1E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f4449ecf72790578b0106f32a78def58f682d9d/ghc >--------------------------------------------------------------- commit 6f4449ecf72790578b0106f32a78def58f682d9d Author: Herbert Valerio Riedel Date: Mon Aug 6 12:53:06 2018 -0400 Turn on MonadFail desugaring by default Summary: This contains two commits: ---- Make GHC's code-base compatible w/ `MonadFail` There were a couple of use-sites which implicitly used pattern-matches in `do`-notation even though the underlying `Monad` didn't explicitly support `fail` This refactoring turns those use-sites into explicit case discrimations and adds an `MonadFail` instance for `UniqSM` (`UniqSM` was the worst offender so this has been postponed for a follow-up refactoring) --- Turn on MonadFail desugaring by default This finally implements the phase scheduled for GHC 8.6 according to https://prime.haskell.org/wiki/Libraries/Proposals/MonadFail#Transitionalstrategy This also preserves some tests that assumed MonadFail desugaring to be active; all ghc boot libs were already made compatible with this `MonadFail` long ago, so no changes were needed there. Test Plan: Locally performed ./validate --fast Reviewers: bgamari, simonmar, jrtc27, RyanGlScott Reviewed By: bgamari Subscribers: bgamari, RyanGlScott, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5028 >--------------------------------------------------------------- 6f4449ecf72790578b0106f32a78def58f682d9d compiler/basicTypes/UniqSupply.hs | 6 ++++ compiler/codeGen/StgCmmCon.hs | 6 ++-- compiler/codeGen/StgCmmMonad.hs | 11 +++++++- compiler/codeGen/StgCmmPrim.hs | 29 +++++++++----------- compiler/coreSyn/MkCore.hs | 3 +- compiler/deSugar/Coverage.hs | 8 ++++-- compiler/ghci/ByteCodeAsm.hs | 9 ++++-- compiler/ghci/RtClosureInspect.hs | 6 ++-- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 32 ++++++++++++++++------ compiler/main/DynFlags.hs | 2 ++ compiler/main/InteractiveEval.hs | 6 +++- compiler/nativeGen/SPARC/CodeGen.hs | 10 +++++-- compiler/rename/RnNames.hs | 6 +++- compiler/typecheck/TcGenFunctor.hs | 25 ++++++++++------- docs/users_guide/8.6.1-notes.rst | 5 ++++ docs/users_guide/glasgow_exts.rst | 9 +++--- ghc/GHCi/UI.hs | 9 ++++-- testsuite/tests/deSugar/should_run/dsrun010.hs | 2 ++ testsuite/tests/determinism/determ017/A.hs | 2 +- testsuite/tests/monadfail/MonadFailWarnings.hs | 2 +- .../tests/monadfail/MonadFailWarningsDisabled.hs | 5 ++++ testsuite/tests/rebindable/rebindable1.hs | 2 +- testsuite/tests/simplCore/should_run/T3591.hs | 2 +- .../tests/wcompat-warnings/WCompatWarningsNotOn.hs | 2 +- .../tests/wcompat-warnings/WCompatWarningsOff.hs | 2 +- .../tests/wcompat-warnings/WCompatWarningsOn.hs | 2 +- .../tests/wcompat-warnings/WCompatWarningsOnOff.hs | 2 +- 27 files changed, 139 insertions(+), 66 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6f4449ecf72790578b0106f32a78def58f682d9d From git at git.haskell.org Tue Aug 7 19:55:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 19:55:48 +0000 (UTC) Subject: [commit: ghc] master: users-guide: Enlarge title underlines in 8.8 release notes (f22baa4) Message-ID: <20180807195548.BBD9E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f22baa424aed66cd75ea05d4db7efdcd0e021217/ghc >--------------------------------------------------------------- commit f22baa424aed66cd75ea05d4db7efdcd0e021217 Author: Ben Gamari Date: Mon Aug 6 18:54:06 2018 -0400 users-guide: Enlarge title underlines in 8.8 release notes Somehow the level-2 headings were all missing a tilde, causing Sphinx to complain. >--------------------------------------------------------------- f22baa424aed66cd75ea05d4db7efdcd0e021217 docs/users_guide/8.8.1-notes.rst | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/docs/users_guide/8.8.1-notes.rst b/docs/users_guide/8.8.1-notes.rst index de5f978..2661b33 100644 --- a/docs/users_guide/8.8.1-notes.rst +++ b/docs/users_guide/8.8.1-notes.rst @@ -20,7 +20,7 @@ Full details ------------ Language -~~~~~~~ +~~~~~~~~ - :extension:`ScopedTypeVariables`: The type variable that a type signature on a pattern can bring into scope can now stand for arbitrary types. Previously, @@ -28,27 +28,27 @@ Language unnecessary in `GHC proposal #29 `__. Also see :ghc-ticket:`15050`. Compiler -~~~~~~~ +~~~~~~~~ Runtime system -~~~~~~~~~~~~~ +~~~~~~~~~~~~~~ Template Haskell -~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~ ``ghc`` library -~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~ ``base`` library -~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~ Build system -~~~~~~~~~~~ +~~~~~~~~~~~~ Included libraries From git at git.haskell.org Tue Aug 7 19:55:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 19:55:51 +0000 (UTC) Subject: [commit: ghc] master: Bump Cabal submodule (515a98b) Message-ID: <20180807195551.949FC3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/515a98bd258344b1f3725dd1b1ad687cbc245299/ghc >--------------------------------------------------------------- commit 515a98bd258344b1f3725dd1b1ad687cbc245299 Author: Ben Gamari Date: Tue Aug 7 13:37:13 2018 -0400 Bump Cabal submodule >--------------------------------------------------------------- 515a98bd258344b1f3725dd1b1ad687cbc245299 libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 6671506..5ed4d20 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 6671506b488a0fe2079f9059a23510b35514c031 +Subproject commit 5ed4d20ea5101a82254c025d16477c33489e0a0d From git at git.haskell.org Tue Aug 7 19:55:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 19:55:55 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add (broken) test for #15473 (a533a09) Message-ID: <20180807195555.061AA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a533a09231450b9ce0c94d2990d77749fc744baa/ghc >--------------------------------------------------------------- commit a533a09231450b9ce0c94d2990d77749fc744baa Author: Ben Gamari Date: Tue Aug 7 13:59:31 2018 -0400 testsuite: Add (broken) test for #15473 >--------------------------------------------------------------- a533a09231450b9ce0c94d2990d77749fc744baa testsuite/tests/typecheck/should_compile/T15473.hs | 12 ++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 13 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T15473.hs b/testsuite/tests/typecheck/should_compile/T15473.hs new file mode 100644 index 0000000..d6bf57b --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15473.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +-- {-# LANGUAGE UndecidableInstances #-} +module Bug where + +type family Undefined :: k where {} + +type family LetInterleave xs t ts is (a_ahkO :: [a]) (a_ahkP :: [[a]]) :: [[a]] where + LetInterleave xs t ts is y z = Undefined y z + diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 378bdfa..c36eaea 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -647,3 +647,4 @@ test('T15431a', normal, compile, ['']) test('T15428', normal, compile, ['']) test('T15412', normal, compile, ['']) test('T15141', normal, compile, ['']) +test('T15473', expect_broken(15473), compile, ['']) From git at git.haskell.org Tue Aug 7 19:57:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 19:57:15 +0000 (UTC) Subject: [commit: ghc] master: Bump Cabal submodule (e5b128c) Message-ID: <20180807195715.E6A1B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e5b128c18bfbf5ae38d8ed3403cd32afc8675bec/ghc >--------------------------------------------------------------- commit e5b128c18bfbf5ae38d8ed3403cd32afc8675bec Author: Ben Gamari Date: Tue Aug 7 13:37:13 2018 -0400 Bump Cabal submodule >--------------------------------------------------------------- e5b128c18bfbf5ae38d8ed3403cd32afc8675bec libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 6671506..5ed4d20 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 6671506b488a0fe2079f9059a23510b35514c031 +Subproject commit 5ed4d20ea5101a82254c025d16477c33489e0a0d From git at git.haskell.org Tue Aug 7 19:57:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 19:57:19 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add (broken) test for #15473 (5487f30) Message-ID: <20180807195719.567473A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5487f305d9dea298f0822082389d8a0225956c55/ghc >--------------------------------------------------------------- commit 5487f305d9dea298f0822082389d8a0225956c55 Author: Ben Gamari Date: Tue Aug 7 13:59:31 2018 -0400 testsuite: Add (broken) test for #15473 >--------------------------------------------------------------- 5487f305d9dea298f0822082389d8a0225956c55 testsuite/tests/typecheck/should_compile/T15473.hs | 12 ++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 13 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T15473.hs b/testsuite/tests/typecheck/should_compile/T15473.hs new file mode 100644 index 0000000..d6bf57b --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15473.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +-- {-# LANGUAGE UndecidableInstances #-} +module Bug where + +type family Undefined :: k where {} + +type family LetInterleave xs t ts is (a_ahkO :: [a]) (a_ahkP :: [[a]]) :: [[a]] where + LetInterleave xs t ts is y z = Undefined y z + diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 378bdfa..c36eaea 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -647,3 +647,4 @@ test('T15431a', normal, compile, ['']) test('T15428', normal, compile, ['']) test('T15412', normal, compile, ['']) test('T15141', normal, compile, ['']) +test('T15473', expect_broken(15473), compile, ['']) From git at git.haskell.org Tue Aug 7 19:57:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 19:57:22 +0000 (UTC) Subject: [commit: ghc] master: Turn on MonadFail desugaring by default (aab8656) Message-ID: <20180807195722.4FFE53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aab8656ba0561e56048a1222c396d2d117aca5a7/ghc >--------------------------------------------------------------- commit aab8656ba0561e56048a1222c396d2d117aca5a7 Author: Herbert Valerio Riedel Date: Mon Aug 6 12:53:06 2018 -0400 Turn on MonadFail desugaring by default Summary: This contains two commits: ---- Make GHC's code-base compatible w/ `MonadFail` There were a couple of use-sites which implicitly used pattern-matches in `do`-notation even though the underlying `Monad` didn't explicitly support `fail` This refactoring turns those use-sites into explicit case discrimations and adds an `MonadFail` instance for `UniqSM` (`UniqSM` was the worst offender so this has been postponed for a follow-up refactoring) --- Turn on MonadFail desugaring by default This finally implements the phase scheduled for GHC 8.6 according to https://prime.haskell.org/wiki/Libraries/Proposals/MonadFail#Transitionalstrategy This also preserves some tests that assumed MonadFail desugaring to be active; all ghc boot libs were already made compatible with this `MonadFail` long ago, so no changes were needed there. Test Plan: Locally performed ./validate --fast Reviewers: bgamari, simonmar, jrtc27, RyanGlScott Reviewed By: bgamari Subscribers: bgamari, RyanGlScott, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5028 >--------------------------------------------------------------- aab8656ba0561e56048a1222c396d2d117aca5a7 compiler/basicTypes/UniqSupply.hs | 6 ++++ compiler/codeGen/StgCmmCon.hs | 6 ++-- compiler/codeGen/StgCmmMonad.hs | 11 +++++++- compiler/codeGen/StgCmmPrim.hs | 29 +++++++++----------- compiler/coreSyn/MkCore.hs | 3 +- compiler/deSugar/Coverage.hs | 8 ++++-- compiler/ghci/ByteCodeAsm.hs | 9 ++++-- compiler/ghci/RtClosureInspect.hs | 6 ++-- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 32 ++++++++++++++++------ compiler/main/DynFlags.hs | 2 ++ compiler/main/InteractiveEval.hs | 6 +++- compiler/nativeGen/SPARC/CodeGen.hs | 10 +++++-- compiler/rename/RnNames.hs | 6 +++- compiler/typecheck/TcGenFunctor.hs | 25 ++++++++++------- docs/users_guide/8.6.1-notes.rst | 5 ++++ docs/users_guide/glasgow_exts.rst | 9 +++--- ghc/GHCi/UI.hs | 9 ++++-- testsuite/tests/annotations/should_run/annrun01.hs | 3 +- testsuite/tests/deSugar/should_run/dsrun010.hs | 2 ++ testsuite/tests/determinism/determ017/A.hs | 2 +- testsuite/tests/monadfail/MonadFailWarnings.hs | 2 +- .../tests/monadfail/MonadFailWarningsDisabled.hs | 5 ++++ testsuite/tests/rebindable/rebindable1.hs | 2 +- testsuite/tests/simplCore/should_run/T3591.hs | 2 +- .../tests/wcompat-warnings/WCompatWarningsNotOn.hs | 2 +- .../tests/wcompat-warnings/WCompatWarningsOff.hs | 2 +- .../tests/wcompat-warnings/WCompatWarningsOn.hs | 2 +- .../tests/wcompat-warnings/WCompatWarningsOnOff.hs | 2 +- 28 files changed, 141 insertions(+), 67 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 aab8656ba0561e56048a1222c396d2d117aca5a7 From git at git.haskell.org Tue Aug 7 20:00:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 20:00:14 +0000 (UTC) Subject: [commit: ghc] master: Yet another Cabal submodule bump (e2db2d5) Message-ID: <20180807200014.383443A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e2db2d5fec79086cf18dd1910ca9dc416cd7afc6/ghc >--------------------------------------------------------------- commit e2db2d5fec79086cf18dd1910ca9dc416cd7afc6 Author: Ben Gamari Date: Tue Aug 7 15:59:22 2018 -0400 Yet another Cabal submodule bump >--------------------------------------------------------------- e2db2d5fec79086cf18dd1910ca9dc416cd7afc6 libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 5ed4d20..fe10982 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 5ed4d20ea5101a82254c025d16477c33489e0a0d +Subproject commit fe10982db1f2fa7d828fc5f8ddaa5beedceaddec From git at git.haskell.org Tue Aug 7 20:01:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 20:01:35 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Fix documentation building (08057ae) Message-ID: <20180807200135.99C653A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/08057aec122995291c69555f553705fa8191412d/ghc >--------------------------------------------------------------- commit 08057aec122995291c69555f553705fa8191412d Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- 08057aec122995291c69555f553705fa8191412d .circleci/config.yml | 21 ++++++++-------- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 33 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 19 +++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 +++++++- .circleci/prepare-system.sh | 20 ++++++++++++--- libraries/Cabal | 2 +- 7 files changed, 95 insertions(+), 16 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 08057aec122995291c69555f553705fa8191412d From git at git.haskell.org Tue Aug 7 20:28:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 20:28:21 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Fix documentation building (b77fb8e) Message-ID: <20180807202821.292BB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/b77fb8ef54bbec02795b9fd8b5194af433220e5e/ghc >--------------------------------------------------------------- commit b77fb8ef54bbec02795b9fd8b5194af433220e5e Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- b77fb8ef54bbec02795b9fd8b5194af433220e5e .circleci/config.yml | 21 ++++++++-------- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 33 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 19 +++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 +++++++- .circleci/prepare-system.sh | 20 ++++++++++++--- libraries/Cabal | 2 +- 7 files changed, 95 insertions(+), 16 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 b77fb8ef54bbec02795b9fd8b5194af433220e5e From git at git.haskell.org Tue Aug 7 22:31:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Aug 2018 22:31:02 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Fix documentation building (db5d025) Message-ID: <20180807223102.E5F873A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/db5d0259116832fcb4e390a9c8304c9c155242be/ghc >--------------------------------------------------------------- commit db5d0259116832fcb4e390a9c8304c9c155242be Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- db5d0259116832fcb4e390a9c8304c9c155242be .circleci/config.yml | 21 ++++++++-------- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 33 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 19 +++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 +++++++- .circleci/prepare-system.sh | 20 ++++++++++++--- libraries/Cabal | 2 +- 7 files changed, 95 insertions(+), 16 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 db5d0259116832fcb4e390a9c8304c9c155242be From git at git.haskell.org Wed Aug 8 00:09:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 00:09:21 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Fix documentation building (126f421) Message-ID: <20180808000921.184983A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/126f42186f460e715a67e9055e59b9e0d820df8f/ghc >--------------------------------------------------------------- commit 126f42186f460e715a67e9055e59b9e0d820df8f Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- 126f42186f460e715a67e9055e59b9e0d820df8f .circleci/config.yml | 21 ++++++++-------- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 33 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 20 ++++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 +++++++- .circleci/prepare-system.sh | 20 ++++++++++++--- libraries/Cabal | 2 +- 7 files changed, 96 insertions(+), 16 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 126f42186f460e715a67e9055e59b9e0d820df8f From git at git.haskell.org Wed Aug 8 18:22:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 18:22:55 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: Try fixing OS X build (7cea902) Message-ID: <20180808182255.1BE4F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/7cea9020a7c717a8069dff9efc62dfd0fc1d6f8e/ghc >--------------------------------------------------------------- commit 7cea9020a7c717a8069dff9efc62dfd0fc1d6f8e Author: Ben Gamari Date: Wed Aug 8 14:22:23 2018 -0400 Try fixing OS X build >--------------------------------------------------------------- 7cea9020a7c717a8069dff9efc62dfd0fc1d6f8e .circleci/config.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index a2b3478..39db42f 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -17,7 +17,7 @@ aliases: - &buildenv THREADS: 9 SKIP_PERF_TESTS: YES - VERBOSE: 2 + VERBOSE: 1 - &boot run: name: Boot @@ -135,7 +135,7 @@ jobs: environment: # Disable sphinx PDF output as MacTeX apparently doesn't provide xelatex BUILD_SPHINX_PDF: "NO" - MACOSX_DEPLOYMENT_TARGET: "10.7" + #MACOSX_DEPLOYMENT_TARGET: "10.7" # Only Sierra and onwards supports clock_gettime. See #12858 ac_cv_func_clock_gettime: "no" GHC_COLLECTOR_FLAVOR: x86_64-darwin From git at git.haskell.org Wed Aug 8 19:54:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 19:54:25 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: Try fixing OS X build (b799fa0) Message-ID: <20180808195425.0DB5A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/b799fa04f5e33f0f981df57986dc0800bfdd8afc/ghc >--------------------------------------------------------------- commit b799fa04f5e33f0f981df57986dc0800bfdd8afc Author: Ben Gamari Date: Wed Aug 8 14:22:23 2018 -0400 Try fixing OS X build >--------------------------------------------------------------- b799fa04f5e33f0f981df57986dc0800bfdd8afc .circleci/config.yml | 2 +- libraries/Cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index a2b3478..ec085b3 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -135,7 +135,7 @@ jobs: environment: # Disable sphinx PDF output as MacTeX apparently doesn't provide xelatex BUILD_SPHINX_PDF: "NO" - MACOSX_DEPLOYMENT_TARGET: "10.7" + #MACOSX_DEPLOYMENT_TARGET: "10.7" # Only Sierra and onwards supports clock_gettime. See #12858 ac_cv_func_clock_gettime: "no" GHC_COLLECTOR_FLAVOR: x86_64-darwin diff --git a/libraries/Cabal b/libraries/Cabal index 5ed4d20..fe10982 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 5ed4d20ea5101a82254c025d16477c33489e0a0d +Subproject commit fe10982db1f2fa7d828fc5f8ddaa5beedceaddec From git at git.haskell.org Wed Aug 8 19:54:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 19:54:27 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Reduce build verbosity (f2a205e) Message-ID: <20180808195427.D81B43A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/f2a205e568a6c610204ec63c093bf5fd79f71352/ghc >--------------------------------------------------------------- commit f2a205e568a6c610204ec63c093bf5fd79f71352 Author: Ben Gamari Date: Wed Aug 8 15:53:42 2018 -0400 circleci: Reduce build verbosity >--------------------------------------------------------------- f2a205e568a6c610204ec63c093bf5fd79f71352 .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index ec085b3..f500375 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -50,7 +50,7 @@ aliases: - &make run: name: Build - command: "make -j$THREADS" + command: "make -j$THREADS V=0" - &build_hadrian run: name: Build GHC using Hadrian From git at git.haskell.org Wed Aug 8 21:21:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 21:21:17 +0000 (UTC) Subject: [commit: ghc] master: Allow arbitrary options to be passed to tar compression (4d6dfc3) Message-ID: <20180808212117.E72323A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4d6dfc35c06abb747de318ada2f27985c9369a6d/ghc >--------------------------------------------------------------- commit 4d6dfc35c06abb747de318ada2f27985c9369a6d Author: Ben Gamari Date: Wed Aug 8 16:08:02 2018 -0400 Allow arbitrary options to be passed to tar compression >--------------------------------------------------------------- 4d6dfc35c06abb747de318ada2f27985c9369a6d mk/config.mk.in | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mk/config.mk.in b/mk/config.mk.in index 90579fb..1105012 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -801,13 +801,13 @@ TAR_COMP ?= xz # select compression command and .tar extension based on TAR_COMP value ifeq "$(TAR_COMP)" "bzip2" -TAR_COMP_CMD = $(BZIP2_CMD) +TAR_COMP_CMD = $(BZIP2_CMD) $(TAR_COMP_OPTS) TAR_COMP_EXT = bz2 else ifeq "$(TAR_COMP)" "gzip" -TAR_COMP_CMD = $(GZIP_CMD) +TAR_COMP_CMD = $(GZIP_CMD) $(TAR_COMP_OPTS) TAR_COMP_EXT = gz else ifeq "$(TAR_COMP)" "xz" -TAR_COMP_CMD = $(XZ_CMD) +TAR_COMP_CMD = $(XZ_CMD) $(TAR_COMP_OPTS) TAR_COMP_EXT = xz else $(error $$(TAR_COMP) set to unknown value "$(TAR_COMP)" (supported: "bzip2", "gzip", "xz")) From git at git.haskell.org Wed Aug 8 23:00:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 23:00:14 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: Bump Cabal submodule (6826815) Message-ID: <20180808230014.D26F83A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/682681502ebcb0951be5dd280bb2a17d8587fe93/ghc >--------------------------------------------------------------- commit 682681502ebcb0951be5dd280bb2a17d8587fe93 Author: Ben Gamari Date: Tue Aug 7 20:10:01 2018 -0400 Bump Cabal submodule >--------------------------------------------------------------- 682681502ebcb0951be5dd280bb2a17d8587fe93 libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 6671506..fe10982 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 6671506b488a0fe2079f9059a23510b35514c031 +Subproject commit fe10982db1f2fa7d828fc5f8ddaa5beedceaddec From git at git.haskell.org Wed Aug 8 23:00:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 23:00:17 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: Try fixing OS X build (690bfd7) Message-ID: <20180808230017.A554E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/690bfd7f91896917a419d91123676ef23c8da7cd/ghc >--------------------------------------------------------------- commit 690bfd7f91896917a419d91123676ef23c8da7cd Author: Ben Gamari Date: Wed Aug 8 14:22:23 2018 -0400 Try fixing OS X build >--------------------------------------------------------------- 690bfd7f91896917a419d91123676ef23c8da7cd .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index a2b3478..ec085b3 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -135,7 +135,7 @@ jobs: environment: # Disable sphinx PDF output as MacTeX apparently doesn't provide xelatex BUILD_SPHINX_PDF: "NO" - MACOSX_DEPLOYMENT_TARGET: "10.7" + #MACOSX_DEPLOYMENT_TARGET: "10.7" # Only Sierra and onwards supports clock_gettime. See #12858 ac_cv_func_clock_gettime: "no" GHC_COLLECTOR_FLAVOR: x86_64-darwin From git at git.haskell.org Wed Aug 8 23:00:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 23:00:20 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Reduce build verbosity (108abf9) Message-ID: <20180808230020.7263C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/108abf9103e73a53011dffdf613c5d3d863b6656/ghc >--------------------------------------------------------------- commit 108abf9103e73a53011dffdf613c5d3d863b6656 Author: Ben Gamari Date: Wed Aug 8 15:53:42 2018 -0400 circleci: Reduce build verbosity >--------------------------------------------------------------- 108abf9103e73a53011dffdf613c5d3d863b6656 .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index ec085b3..f500375 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -50,7 +50,7 @@ aliases: - &make run: name: Build - command: "make -j$THREADS" + command: "make -j$THREADS V=0" - &build_hadrian run: name: Build GHC using Hadrian From git at git.haskell.org Wed Aug 8 23:00:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 23:00:23 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Fix documentation building (8712d32) Message-ID: <20180808230023.D2D813A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/8712d32805870f4aff14f7e8e74a29bce1071bee/ghc >--------------------------------------------------------------- commit 8712d32805870f4aff14f7e8e74a29bce1071bee Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- 8712d32805870f4aff14f7e8e74a29bce1071bee .circleci/config.yml | 21 ++++++++-------- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 33 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 20 ++++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 +++++++- .circleci/prepare-system.sh | 20 ++++++++++++--- 6 files changed, 95 insertions(+), 15 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 8712d32805870f4aff14f7e8e74a29bce1071bee From git at git.haskell.org Wed Aug 8 23:00:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 23:00:26 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: circleci: Reduce compression effort to 3 (87ceabb) Message-ID: <20180808230026.A0E2A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/87ceabb79b8a26beb06749739534777dfd3afa70/ghc >--------------------------------------------------------------- commit 87ceabb79b8a26beb06749739534777dfd3afa70 Author: Ben Gamari Date: Wed Aug 8 18:45:53 2018 -0400 circleci: Reduce compression effort to 3 >--------------------------------------------------------------- 87ceabb79b8a26beb06749739534777dfd3afa70 .circleci/config.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index f500375..f86f351 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -73,7 +73,8 @@ aliases: - &bindist run: name: Create bindist - command: make binary-dist + # Reduce compression effort to 3 + command: make binary-dist TAR_COMP_OPTS="-2" # Building bindist takes ~15 minutes without output, account for # that. no_output_timeout: "30m" From git at git.haskell.org Wed Aug 8 23:00:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 23:00:29 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: Allow arbitrary options to be passed to tar compression (9228a13) Message-ID: <20180808230029.6D7EB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/9228a13b1217f86dabe74b9072e7054abfb57fbd/ghc >--------------------------------------------------------------- commit 9228a13b1217f86dabe74b9072e7054abfb57fbd Author: Ben Gamari Date: Wed Aug 8 16:08:02 2018 -0400 Allow arbitrary options to be passed to tar compression (cherry picked from commit 4d6dfc35c06abb747de318ada2f27985c9369a6d) >--------------------------------------------------------------- 9228a13b1217f86dabe74b9072e7054abfb57fbd mk/config.mk.in | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mk/config.mk.in b/mk/config.mk.in index 6ff8e0e..c112a5f 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -798,13 +798,13 @@ TAR_COMP ?= xz # select compression command and .tar extension based on TAR_COMP value ifeq "$(TAR_COMP)" "bzip2" -TAR_COMP_CMD = $(BZIP2_CMD) +TAR_COMP_CMD = $(BZIP2_CMD) $(TAR_COMP_OPTS) TAR_COMP_EXT = bz2 else ifeq "$(TAR_COMP)" "gzip" -TAR_COMP_CMD = $(GZIP_CMD) +TAR_COMP_CMD = $(GZIP_CMD) $(TAR_COMP_OPTS) TAR_COMP_EXT = gz else ifeq "$(TAR_COMP)" "xz" -TAR_COMP_CMD = $(XZ_CMD) +TAR_COMP_CMD = $(XZ_CMD) $(TAR_COMP_OPTS) TAR_COMP_EXT = xz else $(error $$(TAR_COMP) set to unknown value "$(TAR_COMP)" (supported: "bzip2", "gzip", "xz")) From git at git.haskell.org Wed Aug 8 23:00:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 23:00:32 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: Revert "rts: Ensure that the_gc_thread is aligned" (6d68553) Message-ID: <20180808230032.3FEEF3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/6d68553346af842e390b9e8bab846482e50930a2/ghc >--------------------------------------------------------------- commit 6d68553346af842e390b9e8bab846482e50930a2 Author: Ben Gamari Date: Wed Aug 8 18:59:44 2018 -0400 Revert "rts: Ensure that the_gc_thread is aligned" This reverts commit 87a79e394013e5f722496900227b126015d0d780. >--------------------------------------------------------------- 6d68553346af842e390b9e8bab846482e50930a2 rts/sm/GC.c | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/rts/sm/GC.c b/rts/sm/GC.c index bd4a81c..67eba93 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -128,11 +128,7 @@ uint32_t mutlist_MUTVARS, gc_thread **gc_threads = NULL; #if !defined(THREADED_RTS) -/* Use conservative alignment since we will cast this to a gc_thread and - * consequently the compiler may assume it is aligned. See #15482. - */ -StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)] - __attribute__((aligned(sizeof(W_)))); +StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)]; #endif // Number of threads running in *this* GC. Affects how many From git at git.haskell.org Wed Aug 8 23:00:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 23:00:35 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs's head updated: Revert "rts: Ensure that the_gc_thread is aligned" (6d68553) Message-ID: <20180808230035.123AC3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/fix-docs' now includes: d092321 Bump binary submodule to 0.8.6.0 6826815 Bump Cabal submodule 8712d32 circleci: Fix documentation building 690bfd7 Try fixing OS X build 108abf9 circleci: Reduce build verbosity 87ceabb circleci: Reduce compression effort to 3 9228a13 Allow arbitrary options to be passed to tar compression 6d68553 Revert "rts: Ensure that the_gc_thread is aligned" From git at git.haskell.org Wed Aug 8 23:05:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 23:05:00 +0000 (UTC) Subject: [commit: ghc] master: Revert "rts: Ensure that the_gc_thread is aligned" (e2b5c54) Message-ID: <20180808230500.760C53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e2b5c54f30a31f6b030d29394356fb133b8a0001/ghc >--------------------------------------------------------------- commit e2b5c54f30a31f6b030d29394356fb133b8a0001 Author: Ben Gamari Date: Wed Aug 8 19:02:03 2018 -0400 Revert "rts: Ensure that the_gc_thread is aligned" This caused segmentation faults on Darwin. This reverts commit c6cc93bca69abc258513af8cf2370b14e70fd8fb. >--------------------------------------------------------------- e2b5c54f30a31f6b030d29394356fb133b8a0001 rts/sm/GC.c | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 9b31516..742ae36 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -128,11 +128,7 @@ uint32_t mutlist_MUTVARS, gc_thread **gc_threads = NULL; #if !defined(THREADED_RTS) -/* Use conservative alignment since we will cast this to a gc_thread and - * consequently the compiler may assume it is aligned. See #15482. - */ -StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)] - __attribute__((aligned(sizeof(W_)))); +StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)]; #endif // Number of threads running in *this* GC. Affects how many From git at git.haskell.org Wed Aug 8 23:05:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Aug 2018 23:05:43 +0000 (UTC) Subject: [commit: ghc] wip/fix-docs: Revert "Try fixing OS X build" (244eda9) Message-ID: <20180808230543.3A5373A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/fix-docs Link : http://ghc.haskell.org/trac/ghc/changeset/244eda91d767afe0edbeb41af8aecd6dc1eda589/ghc >--------------------------------------------------------------- commit 244eda91d767afe0edbeb41af8aecd6dc1eda589 Author: Ben Gamari Date: Wed Aug 8 19:05:29 2018 -0400 Revert "Try fixing OS X build" This reverts commit 690bfd7f91896917a419d91123676ef23c8da7cd. >--------------------------------------------------------------- 244eda91d767afe0edbeb41af8aecd6dc1eda589 .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index f86f351..18ae109 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -136,7 +136,7 @@ jobs: environment: # Disable sphinx PDF output as MacTeX apparently doesn't provide xelatex BUILD_SPHINX_PDF: "NO" - #MACOSX_DEPLOYMENT_TARGET: "10.7" + MACOSX_DEPLOYMENT_TARGET: "10.7" # Only Sierra and onwards supports clock_gettime. See #12858 ac_cv_func_clock_gettime: "no" GHC_COLLECTOR_FLAVOR: x86_64-darwin From git at git.haskell.org Thu Aug 9 12:35:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 12:35:30 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Allow arbitrary options to be passed to tar compression (6328e89) Message-ID: <20180809123530.698903A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/6328e89f3e50f8bb89866c430b9d2632f2de0bc1/ghc >--------------------------------------------------------------- commit 6328e89f3e50f8bb89866c430b9d2632f2de0bc1 Author: Ben Gamari Date: Wed Aug 8 16:08:02 2018 -0400 Allow arbitrary options to be passed to tar compression (cherry picked from commit 4d6dfc35c06abb747de318ada2f27985c9369a6d) >--------------------------------------------------------------- 6328e89f3e50f8bb89866c430b9d2632f2de0bc1 mk/config.mk.in | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mk/config.mk.in b/mk/config.mk.in index 6ff8e0e..c112a5f 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -798,13 +798,13 @@ TAR_COMP ?= xz # select compression command and .tar extension based on TAR_COMP value ifeq "$(TAR_COMP)" "bzip2" -TAR_COMP_CMD = $(BZIP2_CMD) +TAR_COMP_CMD = $(BZIP2_CMD) $(TAR_COMP_OPTS) TAR_COMP_EXT = bz2 else ifeq "$(TAR_COMP)" "gzip" -TAR_COMP_CMD = $(GZIP_CMD) +TAR_COMP_CMD = $(GZIP_CMD) $(TAR_COMP_OPTS) TAR_COMP_EXT = gz else ifeq "$(TAR_COMP)" "xz" -TAR_COMP_CMD = $(XZ_CMD) +TAR_COMP_CMD = $(XZ_CMD) $(TAR_COMP_OPTS) TAR_COMP_EXT = xz else $(error $$(TAR_COMP) set to unknown value "$(TAR_COMP)" (supported: "bzip2", "gzip", "xz")) From git at git.haskell.org Thu Aug 9 12:35:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 12:35:33 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: circleci: Fix documentation building (d414a11) Message-ID: <20180809123533.C7C523A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/d414a115379b960437acf2234e977e7563d3c468/ghc >--------------------------------------------------------------- commit d414a115379b960437acf2234e977e7563d3c468 Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building (cherry picked from commit 9f937142f67ccf1c8bff9bb809539deca39a7a6f) >--------------------------------------------------------------- d414a115379b960437acf2234e977e7563d3c468 .circleci/config.yml | 21 ++++++++-------- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 33 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 20 ++++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 +++++++- .circleci/prepare-system.sh | 20 ++++++++++++--- 6 files changed, 95 insertions(+), 15 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 d414a115379b960437acf2234e977e7563d3c468 From git at git.haskell.org Thu Aug 9 12:35:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 12:35:36 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: circleci: Reduce build verbosity (1741e85) Message-ID: <20180809123536.A223C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/1741e858c60688dd33996cc2a32cbf1c092b6899/ghc >--------------------------------------------------------------- commit 1741e858c60688dd33996cc2a32cbf1c092b6899 Author: Ben Gamari Date: Wed Aug 8 15:53:42 2018 -0400 circleci: Reduce build verbosity (cherry picked from commit 5be646f251b25c22ba24ad2a4eb5af66b3f95d74) >--------------------------------------------------------------- 1741e858c60688dd33996cc2a32cbf1c092b6899 .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index a2b3478..2e673c0 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -50,7 +50,7 @@ aliases: - &make run: name: Build - command: "make -j$THREADS" + command: "make -j$THREADS V=0" - &build_hadrian run: name: Build GHC using Hadrian From git at git.haskell.org Thu Aug 9 12:35:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 12:35:39 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: circleci: Reduce compression effort to 3 (e734b8c) Message-ID: <20180809123539.6F2B13A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/e734b8c5aa21529ecff7a92b0ea9c27bb262cd8e/ghc >--------------------------------------------------------------- commit e734b8c5aa21529ecff7a92b0ea9c27bb262cd8e Author: Ben Gamari Date: Wed Aug 8 18:45:53 2018 -0400 circleci: Reduce compression effort to 3 (cherry picked from commit 60e12f26a28ce4ed0ecb905baef207a0388947f1) >--------------------------------------------------------------- e734b8c5aa21529ecff7a92b0ea9c27bb262cd8e .circleci/config.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 2e673c0..18ae109 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -73,7 +73,8 @@ aliases: - &bindist run: name: Create bindist - command: make binary-dist + # Reduce compression effort to 3 + command: make binary-dist TAR_COMP_OPTS="-2" # Building bindist takes ~15 minutes without output, account for # that. no_output_timeout: "30m" From git at git.haskell.org Thu Aug 9 12:35:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 12:35:42 +0000 (UTC) Subject: [commit: ghc] ghc-8.6's head updated: circleci: Reduce compression effort to 3 (e734b8c) Message-ID: <20180809123542.244183A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'ghc-8.6' now includes: 6826815 Bump Cabal submodule 6328e89 Allow arbitrary options to be passed to tar compression d414a11 circleci: Fix documentation building 1741e85 circleci: Reduce build verbosity e734b8c circleci: Reduce compression effort to 3 From git at git.haskell.org Thu Aug 9 15:28:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 15:28:30 +0000 (UTC) Subject: [commit: ghc] master: circleci: Fix documentation building (9f93714) Message-ID: <20180809152830.5AD733A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9f937142f67ccf1c8bff9bb809539deca39a7a6f/ghc >--------------------------------------------------------------- commit 9f937142f67ccf1c8bff9bb809539deca39a7a6f Author: Ben Gamari Date: Fri Aug 3 16:48:18 2018 -0400 circleci: Fix documentation building >--------------------------------------------------------------- 9f937142f67ccf1c8bff9bb809539deca39a7a6f .circleci/config.yml | 21 ++++++++-------- .circleci/images/i386-linux/Dockerfile | 6 +++++ .circleci/images/update-image | 33 +++++++++++++++++++++++++ .circleci/images/x86_64-linux-fedora/Dockerfile | 20 ++++++++++++++- .circleci/images/x86_64-linux/Dockerfile | 10 +++++++- .circleci/prepare-system.sh | 20 ++++++++++++--- 6 files changed, 95 insertions(+), 15 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 9f937142f67ccf1c8bff9bb809539deca39a7a6f From git at git.haskell.org Thu Aug 9 15:28:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 15:28:33 +0000 (UTC) Subject: [commit: ghc] master: circleci: Reduce build verbosity (5be646f) Message-ID: <20180809152833.311173A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5be646f251b25c22ba24ad2a4eb5af66b3f95d74/ghc >--------------------------------------------------------------- commit 5be646f251b25c22ba24ad2a4eb5af66b3f95d74 Author: Ben Gamari Date: Wed Aug 8 15:53:42 2018 -0400 circleci: Reduce build verbosity >--------------------------------------------------------------- 5be646f251b25c22ba24ad2a4eb5af66b3f95d74 .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 8035114..e07e952 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -52,7 +52,7 @@ aliases: - &make run: name: Build - command: "make -j`mk/detect-cpu-count.sh`" + command: "make -j`mk/detect-cpu-count.sh` V=0" - &build_hadrian run: name: Build GHC using Hadrian From git at git.haskell.org Thu Aug 9 15:28:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 15:28:36 +0000 (UTC) Subject: [commit: ghc] master: circleci: Reduce compression effort to 3 (60e12f2) Message-ID: <20180809152836.04DD03A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/60e12f26a28ce4ed0ecb905baef207a0388947f1/ghc >--------------------------------------------------------------- commit 60e12f26a28ce4ed0ecb905baef207a0388947f1 Author: Ben Gamari Date: Wed Aug 8 18:45:53 2018 -0400 circleci: Reduce compression effort to 3 >--------------------------------------------------------------- 60e12f26a28ce4ed0ecb905baef207a0388947f1 .circleci/config.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index e07e952..55cb87f 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -75,7 +75,8 @@ aliases: - &bindist run: name: Create bindist - command: make binary-dist + # Reduce compression effort to 3 + command: make binary-dist TAR_COMP_OPTS="-2" # Building bindist takes ~15 minutes without output, account for # that. no_output_timeout: "30m" From git at git.haskell.org Thu Aug 9 15:28:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 15:28:38 +0000 (UTC) Subject: [commit: ghc] master: Add FreeBSD amd64 LLVM target (396aac4) Message-ID: <20180809152838.CFA283A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/396aac4c65a47b6252e0a73d2a3066e924d53f11/ghc >--------------------------------------------------------------- commit 396aac4c65a47b6252e0a73d2a3066e924d53f11 Author: Viktor Dukhovni Date: Thu Aug 9 01:47:02 2018 -0400 Add FreeBSD amd64 LLVM target >--------------------------------------------------------------- 396aac4c65a47b6252e0a73d2a3066e924d53f11 llvm-targets | 1 + utils/llvm-targets/gen-data-layout.sh | 3 +++ 2 files changed, 4 insertions(+) diff --git a/llvm-targets b/llvm-targets index a0277f3..2537ece 100644 --- a/llvm-targets +++ b/llvm-targets @@ -16,6 +16,7 @@ ,("armv7-unknown-linux-androideabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("aarch64-unknown-linux-android", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("powerpc64le-unknown-linux", ("e-m:e-i64:64-n32:64", "ppc64le", "")) +,("amd64-portbld-freebsd", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) ,("arm-unknown-nto-qnx-eabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm7tdmi", "+strict-align")) ,("i386-apple-darwin", ("e-m:o-p:32:32-f64:32:64-f80:128-n8:16:32-S128", "yonah", "")) ,("x86_64-apple-darwin", ("e-m:o-i64:64-f80:128-n8:16:32:64-S128", "core2", "")) diff --git a/utils/llvm-targets/gen-data-layout.sh b/utils/llvm-targets/gen-data-layout.sh index 3d222d0..85ee5c5 100755 --- a/utils/llvm-targets/gen-data-layout.sh +++ b/utils/llvm-targets/gen-data-layout.sh @@ -32,6 +32,9 @@ TARGETS=( # Linux ppc64le "powerpc64le-unknown-linux" + # FreeBSD amd64 + "amd64-portbld-freebsd" + # QNX "arm-unknown-nto-qnx-eabi" From git at git.haskell.org Thu Aug 9 15:28:41 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 15:28:41 +0000 (UTC) Subject: [commit: ghc] master: base: improve Functor documentation (ce47a9c) Message-ID: <20180809152841.A3AF93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ce47a9c16f47511575925a6958d167241c4b6c89/ghc >--------------------------------------------------------------- commit ce47a9c16f47511575925a6958d167241c4b6c89 Author: Tobias Pflug Date: Fri Aug 3 21:17:51 2018 +0200 base: improve Functor documentation - Rewrite module documentation - Rewrite class documentation >--------------------------------------------------------------- ce47a9c16f47511575925a6958d167241c4b6c89 libraries/base/Data/Functor.hs | 27 +++++++++++++++++++++++++-- libraries/base/GHC/Base.hs | 12 +++++------- 2 files changed, 30 insertions(+), 9 deletions(-) diff --git a/libraries/base/Data/Functor.hs b/libraries/base/Data/Functor.hs index 2c0fbc3..4cbfcfc 100644 --- a/libraries/base/Data/Functor.hs +++ b/libraries/base/Data/Functor.hs @@ -11,8 +11,31 @@ -- Stability : provisional -- Portability : portable -- --- Functors: uniform action over a parameterized type, generalizing the --- 'Data.List.map' function on lists. +-- +-- A type @f@ is a Functor if it provides a function @fmap@ which, given any types @a@ and @b@, +-- lets you apply any function of type @(a -> b)@ to turn an @f a@ into an @f b@, preserving the +-- structure of @f at . +-- +-- ==== __Examples__ +-- +-- >>> fmap show (Just 1) -- (a -> b) -> f a -> f b +-- Just "1" -- (Int -> String) -> Maybe Int -> Maybe String +-- +-- >>> fmap show Nothing -- (a -> b) -> f a -> f b +-- Nothing -- (Int -> String) -> Maybe Int -> Maybe String +-- +-- >>> fmap show [1,2,3] -- (a -> b) -> f a -> f b +-- ["1", "2", "3"] -- (Int -> String) -> [Int] -> [String] +-- +-- >>> fmap show [] -- (a -> b) -> f a -> f b +-- [] -- (Int -> String) -> [Int] -> [String] +-- +-- The 'fmap' function is also available as the infix operator '<$>': +-- +-- >>> fmap show (Just 1) -- (Int -> String) -> Maybe Int -> Maybe String +-- Just "1" +-- >>> show <$> (Just 1) -- (Int -> String) -> Maybe Int -> Maybe String +-- Just "1" module Data.Functor ( diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 4953a7d..efa8d46 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -444,14 +444,12 @@ instance Semigroup a => Semigroup (IO a) where instance Monoid a => Monoid (IO a) where mempty = pure mempty -{- | The 'Functor' class is used for types that can be mapped over. -Instances of 'Functor' should satisfy the following laws: +{- | A type @f@ is a Functor if it provides a function @fmap@ which, given any types @a@ and @b@ +lets you apply any function from @(a -> b)@ to turn an @f a@ into an @f b@, preserving the +structure of @f at . Furthermore @f@ needs to adhere to the following laws: -> fmap id == id -> fmap (f . g) == fmap f . fmap g - -The instances of 'Functor' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO' -satisfy these laws. +> fmap id == id +> fmap (f . g) == fmap f . fmap g -} class Functor f where From git at git.haskell.org Thu Aug 9 15:28:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 15:28:44 +0000 (UTC) Subject: [commit: ghc] master: Bump unix submodule (342f27f) Message-ID: <20180809152844.7E1F13A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/342f27f372acd45cba207880bf482c41e0f06044/ghc >--------------------------------------------------------------- commit 342f27f372acd45cba207880bf482c41e0f06044 Author: Ben Gamari Date: Thu Aug 9 11:28:04 2018 -0400 Bump unix submodule >--------------------------------------------------------------- 342f27f372acd45cba207880bf482c41e0f06044 libraries/unix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/unix b/libraries/unix index ee3e99a..f4f500d 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit ee3e99a0d8a75edc90a1a4e9fb1c593a99a02bb9 +Subproject commit f4f500d53b4c73e542a377a5c675309dbbe5774d From git at git.haskell.org Thu Aug 9 16:31:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 16:31:29 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Bump for unix 2.7 (b44e747) Message-ID: <20180809163129.42D983A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b44e747ffc45f5c0d075225f457f748313d683f1/ghc >--------------------------------------------------------------- commit b44e747ffc45f5c0d075225f457f748313d683f1 Author: Ben Gamari Date: Thu Aug 9 12:30:43 2018 -0400 testsuite: Bump for unix 2.7 >--------------------------------------------------------------- b44e747ffc45f5c0d075225f457f748313d683f1 libraries/base/tests/T7773.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/tests/T7773.hs b/libraries/base/tests/T7773.hs index 7f73b12..13ec40d 100644 --- a/libraries/base/tests/T7773.hs +++ b/libraries/base/tests/T7773.hs @@ -3,7 +3,7 @@ import System.Posix.IO main = do putStrLn "hello" - fd <- openFd "/dev/random" ReadOnly defaultFileFlags + fd <- openFd "/dev/random" ReadOnly Nothing defaultFileFlags threadWaitRead fd putStrLn "goodbye" From git at git.haskell.org Thu Aug 9 17:16:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 17:16:01 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Add FreeBSD amd64 LLVM target (3893215) Message-ID: <20180809171601.36A013A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/3893215068b964ed7968c8f06bb6c30617ecbb67/ghc >--------------------------------------------------------------- commit 3893215068b964ed7968c8f06bb6c30617ecbb67 Author: Viktor Dukhovni Date: Thu Aug 9 01:47:02 2018 -0400 Add FreeBSD amd64 LLVM target (cherry picked from commit 396aac4c65a47b6252e0a73d2a3066e924d53f11) >--------------------------------------------------------------- 3893215068b964ed7968c8f06bb6c30617ecbb67 llvm-targets | 1 + utils/llvm-targets/gen-data-layout.sh | 3 +++ 2 files changed, 4 insertions(+) diff --git a/llvm-targets b/llvm-targets index a0277f3..2537ece 100644 --- a/llvm-targets +++ b/llvm-targets @@ -16,6 +16,7 @@ ,("armv7-unknown-linux-androideabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("aarch64-unknown-linux-android", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("powerpc64le-unknown-linux", ("e-m:e-i64:64-n32:64", "ppc64le", "")) +,("amd64-portbld-freebsd", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) ,("arm-unknown-nto-qnx-eabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm7tdmi", "+strict-align")) ,("i386-apple-darwin", ("e-m:o-p:32:32-f64:32:64-f80:128-n8:16:32-S128", "yonah", "")) ,("x86_64-apple-darwin", ("e-m:o-i64:64-f80:128-n8:16:32:64-S128", "core2", "")) diff --git a/utils/llvm-targets/gen-data-layout.sh b/utils/llvm-targets/gen-data-layout.sh index ab036a9..9ae8e45 100755 --- a/utils/llvm-targets/gen-data-layout.sh +++ b/utils/llvm-targets/gen-data-layout.sh @@ -32,6 +32,9 @@ TARGETS=( # Linux ppc64le "powerpc64le-unknown-linux" + # FreeBSD amd64 + "amd64-portbld-freebsd" + # QNX "arm-unknown-nto-qnx-eabi" From git at git.haskell.org Thu Aug 9 17:16:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 17:16:04 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump unix submodule (fd7cedc) Message-ID: <20180809171604.00C123A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/fd7cedc8b28b4e35000dbad7d86c1d79fe127437/ghc >--------------------------------------------------------------- commit fd7cedc8b28b4e35000dbad7d86c1d79fe127437 Author: Ben Gamari Date: Thu Aug 9 11:28:04 2018 -0400 Bump unix submodule >--------------------------------------------------------------- fd7cedc8b28b4e35000dbad7d86c1d79fe127437 libraries/unix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/unix b/libraries/unix index ee3e99a..f4f500d 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit ee3e99a0d8a75edc90a1a4e9fb1c593a99a02bb9 +Subproject commit f4f500d53b4c73e542a377a5c675309dbbe5774d From git at git.haskell.org Thu Aug 9 17:16:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Aug 2018 17:16:06 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: testsuite: Bump for unix 2.7 (1a0a971) Message-ID: <20180809171606.C02D53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/1a0a971b76c0b717794af9af4e27dcb488924800/ghc >--------------------------------------------------------------- commit 1a0a971b76c0b717794af9af4e27dcb488924800 Author: Ben Gamari Date: Thu Aug 9 12:30:43 2018 -0400 testsuite: Bump for unix 2.7 >--------------------------------------------------------------- 1a0a971b76c0b717794af9af4e27dcb488924800 libraries/base/tests/T7773.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/tests/T7773.hs b/libraries/base/tests/T7773.hs index 7f73b12..13ec40d 100644 --- a/libraries/base/tests/T7773.hs +++ b/libraries/base/tests/T7773.hs @@ -3,7 +3,7 @@ import System.Posix.IO main = do putStrLn "hello" - fd <- openFd "/dev/random" ReadOnly defaultFileFlags + fd <- openFd "/dev/random" ReadOnly Nothing defaultFileFlags threadWaitRead fd putStrLn "goodbye" From git at git.haskell.org Fri Aug 10 13:21:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 10 Aug 2018 13:21:27 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Revert "rts: Ensure that the_gc_thread is aligned" (da11727) Message-ID: <20180810132127.280423A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/da11727090d2f7c340df2df7e667521328b31d14/ghc >--------------------------------------------------------------- commit da11727090d2f7c340df2df7e667521328b31d14 Author: Ben Gamari Date: Fri Aug 10 09:21:05 2018 -0400 Revert "rts: Ensure that the_gc_thread is aligned" This reverts commit 87a79e394013e5f722496900227b126015d0d780. >--------------------------------------------------------------- da11727090d2f7c340df2df7e667521328b31d14 rts/sm/GC.c | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/rts/sm/GC.c b/rts/sm/GC.c index bd4a81c..67eba93 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -128,11 +128,7 @@ uint32_t mutlist_MUTVARS, gc_thread **gc_threads = NULL; #if !defined(THREADED_RTS) -/* Use conservative alignment since we will cast this to a gc_thread and - * consequently the compiler may assume it is aligned. See #15482. - */ -StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)] - __attribute__((aligned(sizeof(W_)))); +StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)]; #endif // Number of threads running in *this* GC. Affects how many From git at git.haskell.org Sat Aug 11 02:36:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Aug 2018 02:36:37 +0000 (UTC) Subject: [commit: ghc] wip/enable-freebsd-ci: circleci: Reenable FreeBSD (76a09b1) Message-ID: <20180811023637.999083A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/enable-freebsd-ci Link : http://ghc.haskell.org/trac/ghc/changeset/76a09b14380390551d69f52c951adac123e9de26/ghc >--------------------------------------------------------------- commit 76a09b14380390551d69f52c951adac123e9de26 Author: Ben Gamari Date: Tue Jul 24 11:43:06 2018 -0400 circleci: Reenable FreeBSD >--------------------------------------------------------------- 76a09b14380390551d69f52c951adac123e9de26 .circleci/config.yml | 23 +++++++++++------------ .circleci/prepare-system.sh | 7 ++++--- 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 55cb87f..45b1ae1 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -285,18 +285,17 @@ workflows: version: 2 validate: jobs: - - validate-x86_64-linux: - *trigger_on_tags - # FreeBSD disabled: https://github.com/haskell/unix/issues/102 - # - validate-x86_64-freebsd - - validate-x86_64-darwin: - *trigger_on_tags - - validate-x86_64-linux-llvm - - validate-i386-linux: - *trigger_on_tags - - validate-hadrian-x86_64-linux - - validate-x86_64-fedora: - *trigger_on_tags + #- validate-x86_64-linux: + # *trigger_on_tags + - validate-x86_64-freebsd + #- validate-x86_64-darwin: + # *trigger_on_tags + #- validate-x86_64-linux-llvm + #- validate-i386-linux: + # *trigger_on_tags + #- validate-hadrian-x86_64-linux + #- validate-x86_64-fedora: + # *trigger_on_tags nightly: triggers: diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index dbb1011..9a57464 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -29,17 +29,18 @@ case "$(uname)" in # cross-compiling to FreeBSD add-apt-repository -y ppa:hvr/ghc apt-get update -qq - apt-get install -qy ghc-8.0.2 cabal-install-1.24 alex happy \ + apt-get install -qy ghc-8.4.3 cabal-install alex happy \ ncurses-dev git make automake autoconf gcc perl \ python3 texinfo xz-utils lbzip2 patch cabal update - cabal install --reinstall hscolour --index-state=$hackage_index_state + cabal install --reinstall hscolour ln -s $HOME/.cabal/bin/HsColour /usr/local/bin/HsColour + ls -l /opt/ghc echo 'HADDOCK_DOCS = NO' >> mk/build.mk echo 'WERROR=' >> mk/build.mk # https://circleci.com/docs/2.0/env-vars/#interpolating-environment-variables-to-set-other-environment-variables - echo 'export PATH=/opt/ghc/bin:$PATH' >> $BASH_ENV + echo 'export PATH=/opt/ghc/8.4.3/bin:$PATH' >> $BASH_ENV else fail "TARGET=$target not supported" fi From git at git.haskell.org Sat Aug 11 02:36:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Aug 2018 02:36:40 +0000 (UTC) Subject: [commit: ghc] wip/enable-freebsd-ci's head updated: circleci: Reenable FreeBSD (76a09b1) Message-ID: <20180811023640.D64193A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/enable-freebsd-ci' now includes: 4ea9311 Fix the GHCi debugger with ApplicativeDo f629442 Fix a major copy'n'paste error in LLVM CodeGen 3aa09cc Fix pretty-printing of data declarations in splices fd1cf1f Disable T10962 on llvm for now a606750 fixup! Disable T10962 on llvm for now af62407 Fix some casts. f0d27f5 Stop marking soluble ~R# constraints as insoluble e1b5a11 Fix a nasty bug in piResultTys 44a7b9b Suppress -Winaccessible-code in derived code 47561c9 Remove dead code in TcUnify 0dc86f6 Clone relevant constraints to avoid side-effects on HoleDests. Fixes #15370. 6c19112 Build more implications 12c0f03 Set GenSigCtxt for the argument part of tcSubType f7d3054 Improve error message on un-satisfied import c5d31df Treat isConstraintKind more consistently 857ef25 Fix and document cloneWC a434bcb tc-tracing only 0f5a63e Comments only 9897f67 Fix PrelRules.caseRules to account for out-of-range tags 4c571f3 Comments only f265008 Refactor (~) to reduce the suerpclass stack 45cfe65 Small refactor in desugar of pattern matching 890f646 Bump haddock submodule 7a3e1b2 rts: Flush eventlog in hs_init_ghc (fixes #15440) 25e1ea9 Make :doc work for the ghc library 13d40ff Add a script for running a ghci that can load and run ghc 774f366 Fail instead of panic-ing when qAddTopDecls has conversion error 3c311e5 Run StgCse after unarise, fixes #15300 e431d75 Fix gcCAFs() 3581212 Add an expect_broken test for #14185 e5f3de2 update core-spec for GRefl and re-factored Refl 60ecf43 Modifications to support loading GHC into GHCi ccdc032 rts: More forceful cc debugging flags 40e9ec9 Disable GNUC_ATTR_HOT when compiling with DEBUG d7cb1bb Fix endian issues in ghc-heap 2cb08d7 Remove dead code in testsuite driver 754c3a5 Fix Ar crashing on odd-sized object files (Trac #15396) 3539561 Fix Git commit ID detection in Git worktrees 11de438 Fix #15453: bug in ForAllCo case in opt_trans_rule 9d388eb Fix #15385 by using addDictsDs in matchGuards a7c8acd GHC doesn't handle ./ prefixed paths correctly (#12674) c626246 Bump terminfo submodule to 0.4.1.2 a698bbf Fix minor formatting issue in users_guide/bugs.rst 56590db base: Make Foreign.Marshal.Alloc.allocBytes[Aligned] NOINLINE 2110738 Don't inline functions with RULES too early 3a06561 Add the paper "Evidence normalisation in System FC" 80b8540 rts: Disable -fkeep-inline-functions due to lack of support on Clang 123aeb9 Enable two-step allocator on FreeBSD cb8efe7 doc: Fix command for creating a shared library. 6d2a9ec Bump Cabal submodule f8e5da9 testsuite: Add test for #14346 0e34a9f users-guide: Document default +RTS -I value 5e103a1 base: Fix documentation of System.Environment.Blank 9bd4864 rts: Fix unused function 1df50a0 Revert "Don't inline functions with RULES too early" f8618a9 Remove the type-checking knot. 52065e9 Plugin dependency information is stored separately b803c40 linker: Nub rpaths 7f3cb50 Fix #15450 by refactoring checkEmptyCase' 120cc9f Fix #15415 and simplify tcWildCardBinders c50574a Remove obsolete file c955a51 Remove decideKindGeneralisationPlan 653dc5f Bump Cabal submodule 8d04822 Bump binary submodule 7535fd6 Bump filepath submodule 8801642 testsuite: Bump T3064 expected allocations 47e54a0 Bump hadrian submodule 73683f1 Refactor printMinimalImports (#15439) 0095cde Fix typos f355b72 circleci: Don't build validate-x86_64-linux-debug unregisterised 4d91cab Allow scoped type variables refer to types d7bc05e Create 8.8.1 release notes b14040d Move 8.8.1-notes.rst to the right directory f811685 Mention #15050 in the release notes for 8.8.1 e94cc29 Use -fobject-code in the GHCi script for loading GHC 29dfb63 Strip ../ from testdir (fixes #15469) 36a4c19 Testsuite driver: fix encoding issue when calling ghc-pkg 4fc6524 Stop the linker panic ff06176 Improve error message for flags with missing required arguments (#12625) c6cc93b rts: Ensure that the_gc_thread is aligned 8b357c6 Add since annotation to GHC.ByteOrder ce9b459 docs: Fix wrong module name in hsig example 672f177 Unhide GHC.List for haddock 24b76d1 [docs] Add missed specialisations warnings to list of those not enabled by -Wall e28bb01 fix timeout related i686 validation issues 7d77198 Support typechecking of type literals in backpack 2604d9b Bump binary submodule to 0.8.6.0 f22baa4 users-guide: Enlarge title underlines in 8.8 release notes aab8656 Turn on MonadFail desugaring by default e5b128c Bump Cabal submodule 5487f30 testsuite: Add (broken) test for #15473 e2db2d5 Yet another Cabal submodule bump 4d6dfc3 Allow arbitrary options to be passed to tar compression e2b5c54 Revert "rts: Ensure that the_gc_thread is aligned" 9f93714 circleci: Fix documentation building 5be646f circleci: Reduce build verbosity 60e12f2 circleci: Reduce compression effort to 3 396aac4 Add FreeBSD amd64 LLVM target ce47a9c base: improve Functor documentation 342f27f Bump unix submodule b44e747 testsuite: Bump for unix 2.7 76a09b1 circleci: Reenable FreeBSD From git at git.haskell.org Sat Aug 11 12:02:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Aug 2018 12:02:05 +0000 (UTC) Subject: [commit: ghc] wip/enable-freebsd-ci: circleci: Reenable FreeBSD (569a94b) Message-ID: <20180811120205.5129A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/enable-freebsd-ci Link : http://ghc.haskell.org/trac/ghc/changeset/569a94b46fcd5326447ffaf268dbb48b9792175a/ghc >--------------------------------------------------------------- commit 569a94b46fcd5326447ffaf268dbb48b9792175a Author: Ben Gamari Date: Tue Jul 24 11:43:06 2018 -0400 circleci: Reenable FreeBSD >--------------------------------------------------------------- 569a94b46fcd5326447ffaf268dbb48b9792175a .circleci/config.yml | 23 +++++++++++------------ .circleci/images/x86_64-freebsd/Dockerfile | 7 ++++++- .circleci/prepare-system.sh | 7 ++++--- 3 files changed, 21 insertions(+), 16 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 55cb87f..45b1ae1 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -285,18 +285,17 @@ workflows: version: 2 validate: jobs: - - validate-x86_64-linux: - *trigger_on_tags - # FreeBSD disabled: https://github.com/haskell/unix/issues/102 - # - validate-x86_64-freebsd - - validate-x86_64-darwin: - *trigger_on_tags - - validate-x86_64-linux-llvm - - validate-i386-linux: - *trigger_on_tags - - validate-hadrian-x86_64-linux - - validate-x86_64-fedora: - *trigger_on_tags + #- validate-x86_64-linux: + # *trigger_on_tags + - validate-x86_64-freebsd + #- validate-x86_64-darwin: + # *trigger_on_tags + #- validate-x86_64-linux-llvm + #- validate-i386-linux: + # *trigger_on_tags + #- validate-hadrian-x86_64-linux + #- validate-x86_64-fedora: + # *trigger_on_tags nightly: triggers: diff --git a/.circleci/images/x86_64-freebsd/Dockerfile b/.circleci/images/x86_64-freebsd/Dockerfile index 9c51cc0..1b8bedd 100644 --- a/.circleci/images/x86_64-freebsd/Dockerfile +++ b/.circleci/images/x86_64-freebsd/Dockerfile @@ -1,6 +1,8 @@ FROM ubuntu:16.04 -RUN apt-get update && apt-get install -y --no-install-recommends \ +RUN apt-get update + +RUN apt-get install -y --no-install-recommends \ autoconf \ automake \ bzip2 \ @@ -20,5 +22,8 @@ RUN apt-get update && apt-get install -y --no-install-recommends \ wget \ xz-utils +# Documentation tools +RUN apt-get install -qy python3-sphinx texlive-xetex texlive-latex-extra + COPY build-toolchain.sh /tmp/ RUN /tmp/build-toolchain.sh x86_64 diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index dbb1011..9a57464 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -29,17 +29,18 @@ case "$(uname)" in # cross-compiling to FreeBSD add-apt-repository -y ppa:hvr/ghc apt-get update -qq - apt-get install -qy ghc-8.0.2 cabal-install-1.24 alex happy \ + apt-get install -qy ghc-8.4.3 cabal-install alex happy \ ncurses-dev git make automake autoconf gcc perl \ python3 texinfo xz-utils lbzip2 patch cabal update - cabal install --reinstall hscolour --index-state=$hackage_index_state + cabal install --reinstall hscolour ln -s $HOME/.cabal/bin/HsColour /usr/local/bin/HsColour + ls -l /opt/ghc echo 'HADDOCK_DOCS = NO' >> mk/build.mk echo 'WERROR=' >> mk/build.mk # https://circleci.com/docs/2.0/env-vars/#interpolating-environment-variables-to-set-other-environment-variables - echo 'export PATH=/opt/ghc/bin:$PATH' >> $BASH_ENV + echo 'export PATH=/opt/ghc/8.4.3/bin:$PATH' >> $BASH_ENV else fail "TARGET=$target not supported" fi From git at git.haskell.org Sat Aug 11 13:22:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Aug 2018 13:22:45 +0000 (UTC) Subject: [commit: ghc] wip/enable-freebsd-ci: circleci: Reenable FreeBSD (cf29bd1) Message-ID: <20180811132245.60D913A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/enable-freebsd-ci Link : http://ghc.haskell.org/trac/ghc/changeset/cf29bd1acc54aea16d0fcf4551d3ae15f6a96e80/ghc >--------------------------------------------------------------- commit cf29bd1acc54aea16d0fcf4551d3ae15f6a96e80 Author: Ben Gamari Date: Tue Jul 24 11:43:06 2018 -0400 circleci: Reenable FreeBSD >--------------------------------------------------------------- cf29bd1acc54aea16d0fcf4551d3ae15f6a96e80 .circleci/config.yml | 25 ++++++++++++------------- .circleci/images/x86_64-freebsd/Dockerfile | 7 ++++++- .circleci/prepare-system.sh | 7 ++++--- 3 files changed, 22 insertions(+), 17 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 55cb87f..74742d2 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -115,7 +115,7 @@ jobs: "validate-x86_64-freebsd": resource_class: xlarge docker: - - image: ghcci/x86_64-freebsd + - image: ghcci/x86_64-freebsd:0.0.2 environment: TARGET: FreeBSD <<: *buildenv @@ -285,18 +285,17 @@ workflows: version: 2 validate: jobs: - - validate-x86_64-linux: - *trigger_on_tags - # FreeBSD disabled: https://github.com/haskell/unix/issues/102 - # - validate-x86_64-freebsd - - validate-x86_64-darwin: - *trigger_on_tags - - validate-x86_64-linux-llvm - - validate-i386-linux: - *trigger_on_tags - - validate-hadrian-x86_64-linux - - validate-x86_64-fedora: - *trigger_on_tags + #- validate-x86_64-linux: + # *trigger_on_tags + - validate-x86_64-freebsd + #- validate-x86_64-darwin: + # *trigger_on_tags + #- validate-x86_64-linux-llvm + #- validate-i386-linux: + # *trigger_on_tags + #- validate-hadrian-x86_64-linux + #- validate-x86_64-fedora: + # *trigger_on_tags nightly: triggers: diff --git a/.circleci/images/x86_64-freebsd/Dockerfile b/.circleci/images/x86_64-freebsd/Dockerfile index 9c51cc0..1b8bedd 100644 --- a/.circleci/images/x86_64-freebsd/Dockerfile +++ b/.circleci/images/x86_64-freebsd/Dockerfile @@ -1,6 +1,8 @@ FROM ubuntu:16.04 -RUN apt-get update && apt-get install -y --no-install-recommends \ +RUN apt-get update + +RUN apt-get install -y --no-install-recommends \ autoconf \ automake \ bzip2 \ @@ -20,5 +22,8 @@ RUN apt-get update && apt-get install -y --no-install-recommends \ wget \ xz-utils +# Documentation tools +RUN apt-get install -qy python3-sphinx texlive-xetex texlive-latex-extra + COPY build-toolchain.sh /tmp/ RUN /tmp/build-toolchain.sh x86_64 diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index dbb1011..9a57464 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -29,17 +29,18 @@ case "$(uname)" in # cross-compiling to FreeBSD add-apt-repository -y ppa:hvr/ghc apt-get update -qq - apt-get install -qy ghc-8.0.2 cabal-install-1.24 alex happy \ + apt-get install -qy ghc-8.4.3 cabal-install alex happy \ ncurses-dev git make automake autoconf gcc perl \ python3 texinfo xz-utils lbzip2 patch cabal update - cabal install --reinstall hscolour --index-state=$hackage_index_state + cabal install --reinstall hscolour ln -s $HOME/.cabal/bin/HsColour /usr/local/bin/HsColour + ls -l /opt/ghc echo 'HADDOCK_DOCS = NO' >> mk/build.mk echo 'WERROR=' >> mk/build.mk # https://circleci.com/docs/2.0/env-vars/#interpolating-environment-variables-to-set-other-environment-variables - echo 'export PATH=/opt/ghc/bin:$PATH' >> $BASH_ENV + echo 'export PATH=/opt/ghc/8.4.3/bin:$PATH' >> $BASH_ENV else fail "TARGET=$target not supported" fi From git at git.haskell.org Sat Aug 11 16:01:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Aug 2018 16:01:24 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Pass -no-pie to GCC (2dfae4d) Message-ID: <20180811160124.D7E8C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/2dfae4d5d5c509f09d8e67a52094b3719fd75e8c/ghc >--------------------------------------------------------------- commit 2dfae4d5d5c509f09d8e67a52094b3719fd75e8c Author: Ben Gamari Date: Fri Nov 11 12:05:21 2016 -0500 Pass -no-pie to GCC Certain distributions (e.g. Debian and Ubuntu) have enabled PIE be default in their GCC packaging. This breaks our abuse of GCC as a linker which requires that we pass -Wl,-r, which is incompatible with PIE (since the former implies that we are generating a relocatable object file and the latter an executable). This is a second attempt at D2691. This attempt constrasts with D2691 in that it preserves the "does gcc support -no-pie" flag in settings, allowing this to be reconfigured by `configure` during installation of a binary distribution. Thanks for @rwbarton for drawing attention to this issue. Test Plan: Validate Reviewers: austin, hvr, erikd Reviewed By: erikd Subscribers: thomie, rwbarton, erikd Differential Revision: https://phabricator.haskell.org/D2693 GHC Trac Issues: #12759 (cherry picked from commit d421a7e22e0be3de32376970b8c38ec308f959da) >--------------------------------------------------------------- 2dfae4d5d5c509f09d8e67a52094b3719fd75e8c aclocal.m4 | 21 +++++++++++++++++++++ compiler/main/DriverPipeline.hs | 10 ++++++++++ compiler/main/DynFlags.hs | 1 + compiler/main/SysTools.hs | 6 ++++++ configure.ac | 3 +++ distrib/configure.ac.in | 1 + settings.in | 1 + 7 files changed, 43 insertions(+) diff --git a/aclocal.m4 b/aclocal.m4 index 874e190..b58d181 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -489,12 +489,14 @@ AC_DEFUN([FP_SETTINGS], fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" + SettingsCCompilerSupportsNoPie="$CONF_GCC_SUPPORTS_NO_PIE" SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2" AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) AC_SUBST(SettingsCCompilerLinkFlags) + AC_SUBST(SettingsCCompilerSupportsNoPie) AC_SUBST(SettingsLdCommand) AC_SUBST(SettingsLdFlags) AC_SUBST(SettingsArCommand) @@ -1249,6 +1251,25 @@ AC_SUBST(GccIsClang) rm -f conftest.txt ]) +# FP_GCC_SUPPORTS_NO_PIE +# ---------------------- +# Does gcc support the -no-pie option? If so we should pass it to gcc when +# joining objects since -pie may be enabled by default. +AC_DEFUN([FP_GCC_SUPPORTS_NO_PIE], +[ + AC_REQUIRE([AC_PROG_CC]) + AC_MSG_CHECKING([whether GCC supports -no-pie]) + echo 'int main() { return 0; }' > conftest.c + if ${CC-cc} -o conftest -no-pie conftest.c > /dev/null 2>&1; then + CONF_GCC_SUPPORTS_NO_PIE=YES + AC_MSG_RESULT([yes]) + else + CONF_GCC_SUPPORTS_NO_PIE=NO + AC_MSG_RESULT([no]) + fi + rm -f conftest.c conftest.o conftest +]) + dnl Small feature test for perl version. Assumes PerlCmd dnl contains path to perl binary. dnl diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index ff71cb4..3eb0327 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1944,6 +1944,11 @@ linkBinary' staticLink dflags o_files dep_packages = do ++ map SysTools.Option ( [] + -- See Note [No PIE eating when linking] + ++ (if sGccSupportsNoPie mySettings + then ["-no-pie"] + else []) + -- Permit the linker to auto link _symbol to _imp_symbol. -- This lets us link against DLLs without needing an "import library". ++ (if platformOS platform == OSMinGW32 @@ -2198,6 +2203,11 @@ joinObjectFiles dflags o_files output_fn = do SysTools.Option "-nostdlib", SysTools.Option "-Wl,-r" ] + -- See Note [No PIE eating while linking] in SysTools + ++ (if sGccSupportsNoPie mySettings + then [SysTools.Option "-no-pie"] + else []) + ++ (if any (cc ==) [Clang, AppleClang, AppleClang51] then [] else [SysTools.Option "-nodefaultlibs"]) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 42ac14e..9942d7a 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -922,6 +922,7 @@ data Settings = Settings { sLdSupportsBuildId :: Bool, sLdSupportsFilelist :: Bool, sLdIsGnuLd :: Bool, + sGccSupportsNoPie :: Bool, -- commands for particular phases sPgm_L :: String, sPgm_P :: (String,[Option]), diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 8c3ab1a..078cc2b 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -242,6 +242,7 @@ initSysTools mbMinusB -- to make that possible, so for now you can't. gcc_prog <- getSetting "C compiler command" gcc_args_str <- getSetting "C compiler flags" + gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" cpp_prog <- getSetting "Haskell CPP command" cpp_args_str <- getSetting "Haskell CPP flags" let unreg_gcc_args = if targetUnregisterised @@ -333,6 +334,7 @@ initSysTools mbMinusB sLdSupportsBuildId = ldSupportsBuildId, sLdSupportsFilelist = ldSupportsFilelist, sLdIsGnuLd = ldIsGnuLd, + sGccSupportsNoPie = gccSupportsNoPie, sProgramName = "ghc", sProjectVersion = cProjectVersion, sPgm_L = unlit_path, @@ -1719,6 +1721,10 @@ linkDynLib dflags0 o_files dep_packages ++ [ Option "-o" , FileOption "" output_fn ] + -- See Note [No PIE eating when linking] + ++ (if sGccSupportsNoPie (settings dflags) + then [Option "-no-pie"] + else []) ++ map Option o_files ++ [ Option "-shared" ] ++ map Option bsymbolicFlag diff --git a/configure.ac b/configure.ac index 37601ae..84f063a 100644 --- a/configure.ac +++ b/configure.ac @@ -667,6 +667,9 @@ dnl If gcc, make sure it's at least 3.0 dnl FP_GCC_VERSION +dnl ** See whether gcc supports -no-pie +FP_GCC_SUPPORTS_NO_PIE + dnl ** look to see if we have a C compiler using an llvm back end. dnl FP_CC_LLVM_BACKEND diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in index f1abd91..5935775 100644 --- a/distrib/configure.ac.in +++ b/distrib/configure.ac.in @@ -92,6 +92,7 @@ FIND_LD([LdCmd]) AC_SUBST([LdCmd]) FP_GCC_VERSION +FP_GCC_SUPPORTS_NO_PIE AC_PROG_CPP FP_PROG_LD_IS_GNU diff --git a/settings.in b/settings.in index 5f54fd9..1f2ec3d 100644 --- a/settings.in +++ b/settings.in @@ -2,6 +2,7 @@ ("C compiler command", "@SettingsCCompilerCommand@"), ("C compiler flags", "@SettingsCCompilerFlags@"), ("C compiler link flags", "@SettingsCCompilerLinkFlags@"), + ("C compiler supports -no-pie", "@SettingsCCompilerSupportsNoPie@"), ("Haskell CPP command","@SettingsHaskellCPPCommand@"), ("Haskell CPP flags","@SettingsHaskellCPPFlags@"), ("ld command", "@SettingsLdCommand@"), From git at git.haskell.org Sat Aug 11 16:01:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Aug 2018 16:01:27 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: configure: Verify that GCC recognizes -no-pie flag (0f9f1da) Message-ID: <20180811160127.AC9243A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/0f9f1da3d76ccbd1c19a08929f8aa4a8b73cac29/ghc >--------------------------------------------------------------- commit 0f9f1da3d76ccbd1c19a08929f8aa4a8b73cac29 Author: Ben Gamari Date: Mon Nov 14 14:13:30 2016 -0500 configure: Verify that GCC recognizes -no-pie flag It seems like GCC versions prior to 4.8 exit with code 0 when faced with an unrecognized flag. Silly compilers. Test Plan: Validate Reviewers: hvr, austin, ggreif Reviewed By: ggreif Subscribers: thomie, erikd Differential Revision: https://phabricator.haskell.org/D2707 GHC Trac Issues: #12759 (cherry picked from commit 011af2bf448c28db68a55293abaa5b294f170e37) >--------------------------------------------------------------- 0f9f1da3d76ccbd1c19a08929f8aa4a8b73cac29 aclocal.m4 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/aclocal.m4 b/aclocal.m4 index b58d181..2c69b78 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1260,7 +1260,8 @@ AC_DEFUN([FP_GCC_SUPPORTS_NO_PIE], AC_REQUIRE([AC_PROG_CC]) AC_MSG_CHECKING([whether GCC supports -no-pie]) echo 'int main() { return 0; }' > conftest.c - if ${CC-cc} -o conftest -no-pie conftest.c > /dev/null 2>&1; then + # Some GCC versions only warn when passed an unrecognized flag. + if $CC -no-pie -x c /dev/null -dM -E > conftest.txt 2>&1 && ! grep -i unrecognized conftest.txt > /dev/null 2>&1; then CONF_GCC_SUPPORTS_NO_PIE=YES AC_MSG_RESULT([yes]) else From git at git.haskell.org Sat Aug 11 16:01:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Aug 2018 16:01:30 +0000 (UTC) Subject: [commit: ghc] wip/circleci: fixup! CircleCI: Build and archive binary distribution (b2054d0) Message-ID: <20180811160130.78CFC3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/circleci Link : http://ghc.haskell.org/trac/ghc/changeset/b2054d0a3f9685937ddd022047bb96efbb23599a/ghc >--------------------------------------------------------------- commit b2054d0a3f9685937ddd022047bb96efbb23599a Author: Ben Gamari Date: Fri Oct 27 11:55:34 2017 -0400 fixup! CircleCI: Build and archive binary distribution >--------------------------------------------------------------- b2054d0a3f9685937ddd022047bb96efbb23599a .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index d04973e..8f16515 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -10,7 +10,7 @@ jobs: name: git command: | apt-get update - apt-get install -y git openssh-client make automake autoconf gcc perl python3 python-sphinx + apt-get install -y git openssh-client make automake autoconf gcc perl python3 python-sphinx xz-utils - checkout - run: name: submodules From git at git.haskell.org Sat Aug 11 16:01:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Aug 2018 16:01:33 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump parsec submodule (15b5347) Message-ID: <20180811160133.4C49D3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/15b5347906619048a9f017caa5076aea3047aac9/ghc >--------------------------------------------------------------- commit 15b5347906619048a9f017caa5076aea3047aac9 Author: Ben Gamari Date: Sat Aug 11 12:00:44 2018 -0400 Bump parsec submodule >--------------------------------------------------------------- 15b5347906619048a9f017caa5076aea3047aac9 libraries/parsec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/parsec b/libraries/parsec index 610d7aa..34f9e98 160000 --- a/libraries/parsec +++ b/libraries/parsec @@ -1 +1 @@ -Subproject commit 610d7aa58bb5d436aac47b7c03fa6a0f8cb82ba7 +Subproject commit 34f9e98c64cae99abeabbd3d34cec5469f87291a From git at git.haskell.org Sat Aug 11 16:01:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Aug 2018 16:01:35 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Second optimization (5abaa92) Message-ID: <20180811160135.7E8103A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: 114f79e Make it compile d475343 Quickly stub out optimization suggested by Richard 5abaa92 Second optimization From git at git.haskell.org Sat Aug 11 18:18:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Aug 2018 18:18:48 +0000 (UTC) Subject: [commit: ghc] master: Filter plugin dylib locations (b324c56) Message-ID: <20180811181848.4AC8A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b324c5624432f2c3d5b0a689fdff75a1ccc563f5/ghc >--------------------------------------------------------------- commit b324c5624432f2c3d5b0a689fdff75a1ccc563f5 Author: Christiaan Baaij Date: Sat Aug 11 18:56:34 2018 +0200 Filter plugin dylib locations Summary: Previously we just created a cartesian product of the library paths of the plugin package and the libraries of the package. Of course, some of these combinations result in a filepath of a file doesn't exists, leading to #15475. Instead of making `haskFile` return Nothing in case a file doesn't exist (which would hide errors), we look at all the possible dylib locations and ensure that at least one of those locations is an existing file. If the list turns out to be empty however, we panic. Reviewers: mpickering, bgamari Reviewed By: mpickering Subscribers: monoidal, rwbarton, carter GHC Trac Issues: #15475 Differential Revision: https://phabricator.haskell.org/D5048 >--------------------------------------------------------------- b324c5624432f2c3d5b0a689fdff75a1ccc563f5 compiler/deSugar/DsUsage.hs | 35 +++++++++++++++++----- testsuite/tests/plugins/Makefile | 9 ++++++ testsuite/tests/plugins/all.T | 7 +++++ ...nge.stderr => plugin-recomp-change-prof.stderr} | 6 ++++ testsuite/tests/plugins/plugin-recomp/Makefile | 4 ++- 5 files changed, 53 insertions(+), 8 deletions(-) diff --git a/compiler/deSugar/DsUsage.hs b/compiler/deSugar/DsUsage.hs index 45d4dcf..58c31ee 100644 --- a/compiler/deSugar/DsUsage.hs +++ b/compiler/deSugar/DsUsage.hs @@ -25,6 +25,7 @@ import Maybes import Packages import Finder +import Control.Monad (filterM) import Data.List import Data.IORef import Data.Map (Map) @@ -166,14 +167,19 @@ mkPluginUsage hsc_env pluginModule = case lookupPluginModuleWithSuggestions dflags pNm Nothing of -- The plug is from an external package, we just look up the dylib that -- contains the plugin - LookupFound _ pkg -> + LookupFound _ pkg -> do let searchPaths = collectLibraryPaths dflags [pkg] libs = packageHsLibs dflags pkg - dynlibs = [ searchPath mkHsSOName platform lib + dynlibLocs = [ searchPath mkHsSOName platform lib | searchPath <- searchPaths , lib <- libs ] - in mapM hashFile (nub dynlibs) + dynlibs <- filterM doesFileExist dynlibLocs + case dynlibs of + [] -> pprPanic + ("mkPluginUsage: no dylibs, tried:\n" ++ unlines dynlibLocs) + (ppr pNm) + _ -> mapM hashFile (nub dynlibs) _ -> do foundM <- findPluginModule hsc_env pNm case foundM of @@ -186,10 +192,25 @@ mkPluginUsage hsc_env pluginModule return (nub (pluginObject : depObjects)) _ -> pprPanic "mkPluginUsage: no object or dylib" (ppr pNm) where - -- plugins are shared libraries, so add WayDyn to the dflags in order to get - -- the correct filenames and library paths; just in case the object that is - -- currently being build is not going to be linked dynamically - dflags = addWay' WayDyn (hsc_dflags hsc_env) + -- plugins are shared libraries, so WayDyn should be part of the dflags in + -- order to get the correct filenames and library paths. + -- + -- We can distinguish two scenarios: + -- + -- 1. The dflags do not contain WayDyn, in this case we need to remove + -- all other ways and only add WayDyn. Why? Because other ways change + -- the library tags, i.e. WayProf adds `_p`, and we would end up looking + -- for a profiled plugin which might not be installed. See #15492 + -- + -- 2. The dflags do contain WayDyn, in this case we can leave the ways as + -- is, because the plugin must be compiled with the same ways as the + -- module that is currently being build, e.g., if the module is + -- build with WayDyn and WayProf, then the plugin that was used + -- would've also had to been build with WayProf (and WayDyn). + dflags1 = hsc_dflags hsc_env + dflags = if WayDyn `elem` ways dflags1 + then dflags1 + else updateWays (addWay' WayDyn (dflags1 {ways = []})) platform = targetPlatform dflags pNm = moduleName (mi_module pluginModule) pPkg = moduleUnitId (mi_module pluginModule) diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile index 688ac04..8a6af5b 100644 --- a/testsuite/tests/plugins/Makefile +++ b/testsuite/tests/plugins/Makefile @@ -112,3 +112,12 @@ plugin-recomp-change: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin "$(MAKE)" -s --no-print-directory -C plugin-recomp package.plugins01 TOP=$(TOP) RUN=-DRUN2 "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + +# Should recompile the module because the plugin changed, test for 15492 +.PHONY: plugin-recomp-change-prof +plugin-recomp-change-prof: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + "$(TEST_HC)" $(TEST_HC_OPTS) -prof -osuf p_o -hisuf p_hi -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + "$(MAKE)" -s --no-print-directory -C plugin-recomp package.plugins01 TOP=$(TOP) RUN=-DRUN2 + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + "$(TEST_HC)" $(TEST_HC_OPTS) -prof -osuf p_o -hisuf p_hi -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index 48efb05..339b9ba 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -161,3 +161,10 @@ test('plugin-recomp-change', pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}') ], run_command, ['$MAKE -s --no-print-directory plugin-recomp-change']) + +test('plugin-recomp-change-prof', + [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']), + pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}'), + when(not config.have_profiling,skip) + ], + run_command, ['$MAKE -s --no-print-directory plugin-recomp-change-prof']) diff --git a/testsuite/tests/plugins/plugin-recomp-change.stderr b/testsuite/tests/plugins/plugin-recomp-change-prof.stderr similarity index 50% copy from testsuite/tests/plugins/plugin-recomp-change.stderr copy to testsuite/tests/plugins/plugin-recomp-change-prof.stderr index 91747c8..b801805 100644 --- a/testsuite/tests/plugins/plugin-recomp-change.stderr +++ b/testsuite/tests/plugins/plugin-recomp-change-prof.stderr @@ -3,4 +3,10 @@ Got options: Simple Plugin Pass Run Simple Plugin Passes Queried Got options: +Simple Plugin Pass Run +Simple Plugin Passes Queried +Got options: +Simple Plugin Pass Run 2 +Simple Plugin Passes Queried +Got options: Simple Plugin Pass Run 2 diff --git a/testsuite/tests/plugins/plugin-recomp/Makefile b/testsuite/tests/plugins/plugin-recomp/Makefile index db2df8d..9ee7737 100644 --- a/testsuite/tests/plugins/plugin-recomp/Makefile +++ b/testsuite/tests/plugins/plugin-recomp/Makefile @@ -16,6 +16,8 @@ package.%: "$(GHC_PKG)" init pkg.$*/local.package.conf - pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --ghc-option="$(RUN)" --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) + # The bogus extra-lib-dirs ensures the package is registered with multiple + # dynamic-library-directories which tests that the fix for #15475 works + pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --ghc-option="$(RUN)" --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --extra-lib-dirs="$(HERE)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) pkg.$*/setup build --distdir pkg.$*/dist -v0 pkg.$*/setup install --distdir pkg.$*/dist -v0 From git at git.haskell.org Sat Aug 11 19:05:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Aug 2018 19:05:53 +0000 (UTC) Subject: [commit: ghc] master: Simplify testsuite driver (f27d714) Message-ID: <20180811190553.2CCC63A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f27d7145414eae17a211b88908965c91b0236a0f/ghc >--------------------------------------------------------------- commit f27d7145414eae17a211b88908965c91b0236a0f Author: Krzysztof Gogolewski Date: Sat Aug 11 21:04:04 2018 +0200 Simplify testsuite driver Summary: - remove clean_cmd - framework_failures was undefined - times_file was not used - if_verbose_dump was called only when verbose >= 1; remove the check - simplify normalise_whitespace Test Plan: validate Reviewers: bgamari, thomie Reviewed By: thomie Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5061 >--------------------------------------------------------------- f27d7145414eae17a211b88908965c91b0236a0f testsuite/driver/runtests.py | 2 +- testsuite/driver/testglobals.py | 6 ------ testsuite/driver/testlib.py | 23 ++++++++--------------- testsuite/tests/driver/recomp015/all.T | 1 - testsuite/tests/driver/retc001/all.T | 1 - testsuite/tests/safeHaskell/safeLanguage/all.T | 2 +- testsuite/tests/simplCore/should_compile/all.T | 1 - 7 files changed, 10 insertions(+), 26 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index e01f67c..ae4f32b 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -297,7 +297,7 @@ if config.list_broken: print('') if t.framework_failures: - print('WARNING:', len(framework_failures), 'framework failures!') + print('WARNING:', len(t.framework_failures), 'framework failures!') print('') else: # completion watcher diff --git a/testsuite/driver/testglobals.py b/testsuite/driver/testglobals.py index 246f26c..067b7d4 100644 --- a/testsuite/driver/testglobals.py +++ b/testsuite/driver/testglobals.py @@ -43,9 +43,6 @@ class TestConfig: # with --verbose=0. self.no_print_summary = False - # File in which to save the times - self.times_file = '' - # What platform are we running on? self.platform = '' self.os = '' @@ -249,9 +246,6 @@ class TestOptions: # Command to run before the test self.pre_cmd = None - # Command to run for extra cleaning - self.clean_cmd = None - # Command wrapper: a function to apply to the command before running it self.cmd_wrapper = None diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index ef2b8dd..971ed40 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -454,12 +454,6 @@ def _pre_cmd( name, opts, cmd ): # ---- -def clean_cmd( cmd ): - # TODO. Remove all calls to clean_cmd. - return lambda _name, _opts: None - -# ---- - def cmd_prefix( prefix ): return lambda name, opts, p=prefix: _cmd_prefix(name, opts, prefix) @@ -1222,7 +1216,7 @@ def simple_build(name, way, extra_hc_opts, should_fail, top_mod, link, addsuf, b if config.verbose >= 1 and _expect_pass(way): print('Compile failed (exit code {0}) errors were:'.format(exit_code)) actual_stderr_path = in_testdir(name, 'comp.stderr') - if_verbose_dump(1, actual_stderr_path) + dump_file(actual_stderr_path) # ToDo: if the sub-shell was killed by ^C, then exit @@ -1636,7 +1630,7 @@ def compare_outputs(way, kind, normaliser, expected_file, actual_file, def normalise_whitespace( str ): # Merge contiguous whitespace characters into a single space. - return ' '.join(w for w in str.split()) + return ' '.join(str.split()) callSite_re = re.compile(r', called at (.+):[\d]+:[\d]+ in [\w\-\.]+:') @@ -1800,13 +1794,12 @@ def if_verbose( n, s ): if config.verbose >= n: print(s) -def if_verbose_dump( n, f ): - if config.verbose >= n: - try: - with io.open(f) as file: - print(file.read()) - except Exception: - print('') +def dump_file(f): + try: + with io.open(f) as file: + print(file.read()) + except Exception: + print('') def runCmd(cmd, stdin=None, stdout=None, stderr=None, timeout_multiplier=1.0, print_output=0): timeout_prog = strip_quotes(config.timeout_prog) diff --git a/testsuite/tests/driver/recomp015/all.T b/testsuite/tests/driver/recomp015/all.T index e0b77f3..9399534 100644 --- a/testsuite/tests/driver/recomp015/all.T +++ b/testsuite/tests/driver/recomp015/all.T @@ -2,7 +2,6 @@ test('recomp015', [extra_files(['Generate.hs']), - clean_cmd('$MAKE -s clean'), # See ticket:11022#comment:7 unless(opsys('linux') or opsys('solaris2') or opsys('openbsd'), skip), when(arch('arm'), skip), diff --git a/testsuite/tests/driver/retc001/all.T b/testsuite/tests/driver/retc001/all.T index 3f15ed1..a5b0c82 100644 --- a/testsuite/tests/driver/retc001/all.T +++ b/testsuite/tests/driver/retc001/all.T @@ -1,6 +1,5 @@ test('retc001', [extra_files(['A.hs', 'B1.hs', 'B2.hs', 'C.hs']), - clean_cmd('$MAKE -s clean'), # See issue 11204, this test sometimes passes and sometimes fails on OSX when(opsys('darwin'), skip)], run_command, diff --git a/testsuite/tests/safeHaskell/safeLanguage/all.T b/testsuite/tests/safeHaskell/safeLanguage/all.T index a8a1bc0..2807f73 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/all.T +++ b/testsuite/tests/safeHaskell/safeLanguage/all.T @@ -36,6 +36,6 @@ test('SafeLang18', normal, compile, ['']) # Test building a package, that trust values are set correctly # and can be changed correctly #test('SafeRecomp01', -# clean_cmd('$MAKE -s --no-print-directory cleanSafeRecomp01'), +# normal, # run_command, ['$MAKE -s --no-print-directory safeRecomp01']) diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index d4eaf19..95a9d99 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -148,7 +148,6 @@ test('T7785', only_ways(['optasm']), compile, ['-ddump-rules']) test('T7702', [extra_files(['T7702plugin']), pre_cmd('$MAKE -s --no-print-directory -C T7702plugin package.T7702 TOP={top}'), - clean_cmd('$MAKE -s --no-print-directory -C T7702plugin clean.T7702'), # we say 18mb peak allocated +/- 70% because other compiler flags have # a large effect on allocation which is hard to separate from the # allocation done by the plugin... but a regression allocates > 90mb From git at git.haskell.org Sun Aug 12 08:10:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Aug 2018 08:10:21 +0000 (UTC) Subject: [commit: ghc] master: Simplify testsuite driver, part 2 (97596a4) Message-ID: <20180812081021.5C71B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/97596a44cafefba6b03f1dca8f445078dae12ba7/ghc >--------------------------------------------------------------- commit 97596a44cafefba6b03f1dca8f445078dae12ba7 Author: Krzysztof Gogolewski Date: Sun Aug 12 10:09:41 2018 +0200 Simplify testsuite driver, part 2 Summary: - Avoid import *; this helps tools such as pyflakes. The last occurrence in runtests.py is not easy to remove as it's used by .T files. - Use False/True instead of 0/1. Test Plan: validate Reviewers: bgamari, thomie, simonmar Reviewed By: thomie Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5062 >--------------------------------------------------------------- 97596a44cafefba6b03f1dca8f445078dae12ba7 testsuite/config/ghc | 14 +++++++------- testsuite/driver/runtests.py | 8 ++++---- testsuite/driver/testlib.py | 19 +++++++++---------- testsuite/mk/test.mk | 24 ++++++++++++------------ testsuite/tests/concurrent/prog002/all.T | 2 +- testsuite/tests/rts/all.T | 8 ++++---- 6 files changed, 37 insertions(+), 38 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 97596a44cafefba6b03f1dca8f445078dae12ba7 From git at git.haskell.org Sun Aug 12 08:31:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Aug 2018 08:31:04 +0000 (UTC) Subject: [commit: ghc] master: CSE should deal with letrec (ec49b42) Message-ID: <20180812083104.0B8823A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ec49b42bbff4ee81c825a0facee26b13f1f297a7/ghc >--------------------------------------------------------------- commit ec49b42bbff4ee81c825a0facee26b13f1f297a7 Author: roland Date: Sun Aug 12 10:24:29 2018 +0200 CSE should deal with letrec Summary: Add testcase for #9441 Test Plan: make test TESTS="T9441a T9441b T9441c" Reviewers: dfeuer, simonpj, thomie, austin, bgamari Reviewed By: dfeuer Subscribers: rwbarton, carter GHC Trac Issues: #9441 Differential Revision: https://phabricator.haskell.org/D5038 >--------------------------------------------------------------- ec49b42bbff4ee81c825a0facee26b13f1f297a7 testsuite/tests/simplCore/should_compile/Makefile | 13 +++++++++++++ testsuite/tests/simplCore/should_compile/T9441a.hs | 9 +++++++++ testsuite/tests/simplCore/should_compile/T9441a.stdout | 1 + testsuite/tests/simplCore/should_compile/T9441b.hs | 15 +++++++++++++++ testsuite/tests/simplCore/should_compile/T9441b.stdout | 1 + testsuite/tests/simplCore/should_compile/T9441c.hs | 13 +++++++++++++ testsuite/tests/simplCore/should_compile/T9441c.stdout | 1 + testsuite/tests/simplCore/should_compile/all.T | 3 +++ 8 files changed, 56 insertions(+) diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile index 5f077b2..0fb5dc2 100644 --- a/testsuite/tests/simplCore/should_compile/Makefile +++ b/testsuite/tests/simplCore/should_compile/Makefile @@ -27,6 +27,19 @@ T8848: '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-rule-firings T8848.hs | grep 'SPEC map2' # Should fire twice +T9441a: + $(RM) -f T9941a.o T9941a.hi + '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-all T9441a.hs | grep 'f1 = f2' + # Grep output should show 'f1 = f2' +T9441b: + $(RM) -f T9941b.o T9941b.hi + '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-all T9441b.hs | grep 'Rec {' + # Grep output should show only one recursive Bind 'Rec {' +T9441c: + $(RM) -f T9941c.o T9941c.hi + '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-all T9441c.hs | grep 'Rec {' + # Grep output should show only one recursive Bind 'Rec {' + T9509: $(RM) -f T9509*.o T9509*.hi '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T9509a.hs diff --git a/testsuite/tests/simplCore/should_compile/T9441a.hs b/testsuite/tests/simplCore/should_compile/T9441a.hs new file mode 100644 index 0000000..9eef17d --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9441a.hs @@ -0,0 +1,9 @@ +module T9441a where + +f1 :: Integer -> Integer +f1 1 = 1 +f1 n = n * f1 (n - 1) + +f2 :: Integer -> Integer +f2 1 = 1 +f2 m = m * f2 (m - 1) diff --git a/testsuite/tests/simplCore/should_compile/T9441a.stdout b/testsuite/tests/simplCore/should_compile/T9441a.stdout new file mode 100644 index 0000000..205ae52 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9441a.stdout @@ -0,0 +1 @@ +f1 = f2 diff --git a/testsuite/tests/simplCore/should_compile/T9441b.hs b/testsuite/tests/simplCore/should_compile/T9441b.hs new file mode 100644 index 0000000..464c96e --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9441b.hs @@ -0,0 +1,15 @@ +module T9441b where + +f1 :: Integer -> Integer +f1 n + | n <= 1 = 1 + | otherwise = go n 1 + where + go 0 r = r + go m r = go (m - 1) (r * m) + +f2 :: Integer -> Integer +f2 n = go n 1 + where + go 0 s = s + go p s = go (p - 1) (s * p) diff --git a/testsuite/tests/simplCore/should_compile/T9441b.stdout b/testsuite/tests/simplCore/should_compile/T9441b.stdout new file mode 100644 index 0000000..10be0cd --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9441b.stdout @@ -0,0 +1 @@ +Rec { diff --git a/testsuite/tests/simplCore/should_compile/T9441c.hs b/testsuite/tests/simplCore/should_compile/T9441c.hs new file mode 100644 index 0000000..872e97e --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9441c.hs @@ -0,0 +1,13 @@ +module T9441 where +-- Core output should show only one recursive Bind Rec { .. } +import GHC.Exts (build) + +{-# INLINE reverse' #-} +reverse' :: [a] -> [a] +reverse' xs = build $ \c n -> foldl (\a x -> x `c` a) n xs + +appRev :: [a] -> [a] -> [a] +appRev xs ys = xs ++ reverse' ys + +revAppRev :: [a] -> [a] -> [a] +revAppRev xs ys = reverse' xs ++ reverse' ys diff --git a/testsuite/tests/simplCore/should_compile/T9441c.stdout b/testsuite/tests/simplCore/should_compile/T9441c.stdout new file mode 100644 index 0000000..10be0cd --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9441c.stdout @@ -0,0 +1 @@ +Rec { diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 95a9d99..07b5f0a 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -196,6 +196,9 @@ test('T8848a', only_ways(['optasm']), compile, ['-ddump-rules']) test('T8331', only_ways(['optasm']), compile, ['-ddump-rules']) test('T6056', only_ways(['optasm']), multimod_compile, ['T6056', '-v0 -ddump-rule-firings']) test('T9400', only_ways(['optasm']), compile, ['-O0 -ddump-simpl -dsuppress-uniques']) +test('T9441a', normal, run_command, ['$MAKE -s --no-print-directory T9441a']) +test('T9441b', normal, run_command, ['$MAKE -s --no-print-directory T9441b']) +test('T9441c', normal, run_command, ['$MAKE -s --no-print-directory T9441c']) test('T9583', only_ways(['optasm']), compile, ['']) test('T9565', only_ways(['optasm']), compile, ['']) test('T5821', only_ways(['optasm']), compile, ['']) From git at git.haskell.org Sun Aug 12 08:54:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Aug 2018 08:54:56 +0000 (UTC) Subject: [commit: ghc] master: use *test instead of *slowtest for llvm validation on Circle CI (193eeee) Message-ID: <20180812085456.1FE673A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/193eeee6bdbd5b2ec38e26c70e8aa79ce7bd2f99/ghc >--------------------------------------------------------------- commit 193eeee6bdbd5b2ec38e26c70e8aa79ce7bd2f99 Author: Alp Mestanogullari Date: Sun Aug 12 10:54:30 2018 +0200 use *test instead of *slowtest for llvm validation on Circle CI Summary: Since the LLVM backend is slow enough that *slowtest can't run in the allocated time on Circle CI, let's just use *test. If that still doesn't fit in the allocated 5 hours, we can try running just the compiler tests. Test Plan: Circle CI validation for LLVM Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5033 >--------------------------------------------------------------- 193eeee6bdbd5b2ec38e26c70e8aa79ce7bd2f99 .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 55cb87f..19780ab 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -207,7 +207,7 @@ jobs: - *boot - *configure_unix - *make - - *slowtest + - *test # Nightly build with -DDEBUG using devel2 flavour "validate-x86_64-linux-debug": From git at git.haskell.org Sun Aug 12 10:25:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Aug 2018 10:25:15 +0000 (UTC) Subject: [commit: ghc] master: --show-iface: Qualify all non-local names (d42eef3) Message-ID: <20180812102515.885073A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d42eef344a71990d12f27e88cdf10ba0b2a2f34b/ghc >--------------------------------------------------------------- commit d42eef344a71990d12f27e88cdf10ba0b2a2f34b Author: Simon Jakobi Date: Sun Aug 12 11:10:39 2018 +0200 --show-iface: Qualify all non-local names Summary: In order to disambiguate names from different modules, qualify all names that don't originate in the current module. Also update docs for QueryQualifyName Test Plan: validate Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie, carter, tdammers GHC Trac Issues: #15269 Differential Revision: https://phabricator.haskell.org/D4852 >--------------------------------------------------------------- d42eef344a71990d12f27e88cdf10ba0b2a2f34b compiler/iface/LoadIface.hs | 18 +++++++++++++++++- compiler/utils/Outputable.hs | 8 ++------ testsuite/tests/showIface/Orphans.stdout | 12 ++++++------ testsuite/tests/simplCore/should_compile/T4306.stdout | 2 +- testsuite/tests/simplCore/should_compile/T4918.stdout | 4 ++-- 5 files changed, 28 insertions(+), 16 deletions(-) diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index 4524402..34ba1cb 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -1047,6 +1047,15 @@ ifaceStats eps Printing interfaces * * ************************************************************************ + +Note [Name qualification with --show-iface] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In order to disambiguate between identifiers from different modules, we qualify +all names that don't originate in the current module. In order to keep visual +noise as low as possible, we keep local names unqualified. + +For some background on this choice see trac #15269. -} -- | Read binary interface, and print it out @@ -1057,8 +1066,15 @@ showIface hsc_env filename = do iface <- initTcRnIf 's' hsc_env () () $ readBinIface IgnoreHiWay TraceBinIFaceReading filename let dflags = hsc_dflags hsc_env + -- See Note [Name qualification with --show-iface] + qualifyImportedNames mod _ + | mod == mi_module iface = NameUnqual + | otherwise = NameNotInScope1 + print_unqual = QueryQualify qualifyImportedNames + neverQualifyModules + neverQualifyPackages putLogMsg dflags NoReason SevDump noSrcSpan - (defaultDumpStyle dflags) (pprModIface iface) + (mkDumpStyle dflags print_unqual) (pprModIface iface) -- Show a ModIface but don't display details; suitable for ModIfaces stored in -- the EPT. diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index 4df9adf..929c7f3 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -181,12 +181,8 @@ data PrintUnqualified = QueryQualify { queryQualifyPackage :: QueryQualifyPackage } --- | given an /original/ name, this function tells you which module --- name it should be qualified with when printing for the user, if --- any. For example, given @Control.Exception.catch@, which is in scope --- as @Exception.catch@, this function will return @Just "Exception"@. --- Note that the return value is a ModuleName, not a Module, because --- in source code, names are qualified by ModuleNames. +-- | Given a `Name`'s `Module` and `OccName`, decide whether and how to qualify +-- it. type QueryQualifyName = Module -> OccName -> QualifyName -- | For a given module, we need to know whether to print it with diff --git a/testsuite/tests/showIface/Orphans.stdout b/testsuite/tests/showIface/Orphans.stdout index d61a5c9..63fcd79 100644 --- a/testsuite/tests/showIface/Orphans.stdout +++ b/testsuite/tests/showIface/Orphans.stdout @@ -1,6 +1,6 @@ -instance [orphan] IsList [Bool] = $fIsListBool -instance IsList [X] = $fIsListX -family instance Item [X] = D:R:ItemX -family instance [orphan] Item [Bool] = D:R:ItemBool -"myrule1" [orphan] forall @ a id @ (a -> a) (id @ a) = id @ a -"myrule2" forall id @ (X -> X) f = f +instance [orphan] GHC.Exts.IsList [GHC.Types.Bool] = $fIsListBool +instance GHC.Exts.IsList [X] = $fIsListX +family instance GHC.Exts.Item [X] = D:R:ItemX +family instance [orphan] GHC.Exts.Item [GHC.Types.Bool] +"myrule1" [orphan] forall @ a +"myrule2" forall GHC.Base.id @ (X -> X) f = f diff --git a/testsuite/tests/simplCore/should_compile/T4306.stdout b/testsuite/tests/simplCore/should_compile/T4306.stdout index 3d52e94..b2a93ff 100644 --- a/testsuite/tests/simplCore/should_compile/T4306.stdout +++ b/testsuite/tests/simplCore/should_compile/T4306.stdout @@ -1 +1 @@ - $wupd :: Double# -> Double# + $wupd :: GHC.Prim.Double# -> GHC.Prim.Double# diff --git a/testsuite/tests/simplCore/should_compile/T4918.stdout b/testsuite/tests/simplCore/should_compile/T4918.stdout index 257dbb5..4e957c0 100644 --- a/testsuite/tests/simplCore/should_compile/T4918.stdout +++ b/testsuite/tests/simplCore/should_compile/T4918.stdout @@ -1,2 +1,2 @@ - {- HasNoCafRefs, Strictness: m, Unfolding: (C# 'p'#) -} - {- HasNoCafRefs, Strictness: m, Unfolding: (C# 'q'#) -} + {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'p'#) -} + {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'q'#) -} From git at git.haskell.org Sun Aug 12 15:14:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Aug 2018 15:14:51 +0000 (UTC) Subject: [commit: ghc] master: Check if files are same in combineSrcSpans (f7f9820) Message-ID: <20180812151451.CAD163A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f7f9820e8f5601e9a072e504f3d772fd78df6700/ghc >--------------------------------------------------------------- commit f7f9820e8f5601e9a072e504f3d772fd78df6700 Author: Zubin Duggal Date: Sun Aug 12 15:51:29 2018 +0200 Check if files are same in combineSrcSpans Summary: If this is not checked, SrcSpans are sometimes mangled by CPP. Test Plan: ./validate Reviewers: bgamari, dfeuer Reviewed By: bgamari Subscribers: dfeuer, rwbarton, thomie, carter GHC Trac Issues: #15279 Differential Revision: https://phabricator.haskell.org/D4866 >--------------------------------------------------------------- f7f9820e8f5601e9a072e504f3d772fd78df6700 compiler/basicTypes/SrcLoc.hs | 6 ++++-- testsuite/tests/parser/should_compile/T15279.hs | 7 +++++++ testsuite/tests/parser/should_compile/T15279.hs-incl | 2 ++ testsuite/tests/parser/should_compile/T15279.stderr | 3 +++ testsuite/tests/parser/should_compile/all.T | 13 +++++++++++++ 5 files changed, 29 insertions(+), 2 deletions(-) diff --git a/compiler/basicTypes/SrcLoc.hs b/compiler/basicTypes/SrcLoc.hs index eeba3d7..3276f41 100644 --- a/compiler/basicTypes/SrcLoc.hs +++ b/compiler/basicTypes/SrcLoc.hs @@ -307,12 +307,14 @@ mkSrcSpan (RealSrcLoc loc1) (RealSrcLoc loc2) = RealSrcSpan (mkRealSrcSpan loc1 loc2) -- | Combines two 'SrcSpan' into one that spans at least all the characters --- within both spans. Assumes the "file" part is the same in both inputs +-- within both spans. Returns UnhelpfulSpan if the files differ. combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful combineSrcSpans l (UnhelpfulSpan _) = l combineSrcSpans (RealSrcSpan span1) (RealSrcSpan span2) - = RealSrcSpan (combineRealSrcSpans span1 span2) + | srcSpanFile span1 == srcSpanFile span2 + = RealSrcSpan (combineRealSrcSpans span1 span2) + | otherwise = UnhelpfulSpan (fsLit "") -- | Combines two 'SrcSpan' into one that spans at least all the characters -- within both spans. Assumes the "file" part is the same in both inputs diff --git a/testsuite/tests/parser/should_compile/T15279.hs b/testsuite/tests/parser/should_compile/T15279.hs new file mode 100644 index 0000000..b80bd32 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15279.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -ddump-parsed-ast #-} +module T15279 where + +foo :: Char -> Char +#include "T15279.hs-incl" +foo _ = 'a' diff --git a/testsuite/tests/parser/should_compile/T15279.hs-incl b/testsuite/tests/parser/should_compile/T15279.hs-incl new file mode 100644 index 0000000..d6385f2 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15279.hs-incl @@ -0,0 +1,2 @@ +foo 'a' = 'b' +foo 'b' = 'c' diff --git a/testsuite/tests/parser/should_compile/T15279.stderr b/testsuite/tests/parser/should_compile/T15279.stderr new file mode 100644 index 0000000..ff215a7 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15279.stderr @@ -0,0 +1,3 @@ +(MG +(NoExt) +({ } diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T index 1fd8c69..d949f2b 100644 --- a/testsuite/tests/parser/should_compile/all.T +++ b/testsuite/tests/parser/should_compile/all.T @@ -117,3 +117,16 @@ test('T13986', normal, compile, ['']) test('T10855', normal, compile, ['']) test('T15139', normal, compile, ['-Wincomplete-patterns -fdiagnostics-show-caret']) test('T15323', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast']) + +def only_MG_loc(x): + """ + Only compares the location embedded inside the MatchGroup, which has the form + (MG + (NoExt) + ({ + """ + ls = x.split("\n") + mgLocs = (loc.strip() for (mg,loc) in zip(ls,ls[2:]) + if mg.strip().startswith("(MG")) + return '\n'.join(mgLocs) +test('T15279', normalise_errmsg_fun(only_MG_loc), compile, ['']) From git at git.haskell.org Sun Aug 12 16:49:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Aug 2018 16:49:34 +0000 (UTC) Subject: [commit: ghc] master: Suppress redundant givens during error reporting (c552fee) Message-ID: <20180812164934.518AF3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c552feea127d8ed8cbf4994a157c4bbe254b96c3/ghc >--------------------------------------------------------------- commit c552feea127d8ed8cbf4994a157c4bbe254b96c3 Author: Ryan Scott Date: Sun Aug 12 17:27:27 2018 +0200 Suppress redundant givens during error reporting Summary: When GHC reports that it cannot solve a constraint in error messages, it often reports what given constraints it has in scope. Unfortunately, sometimes redundant constraints (like `* ~ *`, from #15361) can sneak in. The fix is simple: blast away these redundant constraints using `mkMinimalBySCs`. Test Plan: make test TEST=T15361 Reviewers: simonpj, bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15361 Differential Revision: https://phabricator.haskell.org/D5002 >--------------------------------------------------------------- c552feea127d8ed8cbf4994a157c4bbe254b96c3 compiler/typecheck/TcErrors.hs | 44 +++++++++++++++++++++- testsuite/tests/typecheck/should_fail/T15361.hs | 20 ++++++++++ .../tests/typecheck/should_fail/T15361.stderr | 36 ++++++++++++++++++ testsuite/tests/typecheck/should_fail/T5853.stderr | 2 +- testsuite/tests/typecheck/should_fail/all.T | 1 + 5 files changed, 100 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index ecb4042..c044cde 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -1809,7 +1809,8 @@ misMatchOrCND ctxt ct oriented ty1 ty2 eq_pred = ctEvPred ev orig = ctEvOrigin ev givens = [ given | given <- getUserGivens ctxt, not (ic_no_eqs given)] - -- Keep only UserGivens that have some equalities + -- Keep only UserGivens that have some equalities. + -- See Note [Suppress redundant givens during error reporting] couldNotDeduce :: [UserGiven] -> (ThetaType, CtOrigin) -> SDoc couldNotDeduce givens (wanteds, orig) @@ -1824,10 +1825,49 @@ pp_givens givens : map (ppr_given (text "or from:")) gs where ppr_given herald implic@(Implic { ic_given = gs, ic_info = skol_info }) - = hang (herald <+> pprEvVarTheta gs) + = hang (herald <+> pprEvVarTheta (mkMinimalBySCs evVarPred gs)) + -- See Note [Suppress redundant givens during error reporting] + -- for why we use mkMinimalBySCs above. 2 (sep [ text "bound by" <+> ppr skol_info , text "at" <+> ppr (tcl_loc (implicLclEnv implic)) ]) +{- +Note [Suppress redundant givens during error reporting] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When GHC is unable to solve a constraint and prints out an error message, it +will print out what given constraints are in scope to provide some context to +the programmer. But we shouldn't print out /every/ given, since some of them +are not terribly helpful to diagnose type errors. Consider this example: + + foo :: Int :~: Int -> a :~: b -> a :~: c + foo Refl Refl = Refl + +When reporting that GHC can't solve (a ~ c), there are two givens in scope: +(Int ~ Int) and (a ~ b). But (Int ~ Int) is trivially soluble (i.e., +redundant), so it's not terribly useful to report it in an error message. +To accomplish this, we discard any Implications that do not bind any +equalities by filtering the `givens` selected in `misMatchOrCND` (based on +the `ic_no_eqs` field of the Implication). + +But this is not enough to avoid all redundant givens! Consider this example, +from #15361: + + goo :: forall (a :: Type) (b :: Type) (c :: Type). + a :~~: b -> a :~~: c + goo HRefl = HRefl + +Matching on HRefl brings the /single/ given (* ~ *, a ~ b) into scope. +The (* ~ *) part arises due the kinds of (:~~:) being unified. More +importantly, (* ~ *) is redundant, so we'd like not to report it. However, +the Implication (* ~ *, a ~ b) /does/ bind an equality (as reported by its +ic_no_eqs field), so the test above will keep it wholesale. + +To refine this given, we apply mkMinimalBySCs on it to extract just the (a ~ b) +part. This works because mkMinimalBySCs eliminates reflexive equalities in +addition to superclasses (see Note [Remove redundant provided dicts] +in TcPatSyn). +-} + extraTyVarEqInfo :: ReportErrCtxt -> TcTyVar -> TcType -> SDoc -- Add on extra info about skolem constants -- NB: The types themselves are already tidied diff --git a/testsuite/tests/typecheck/should_fail/T15361.hs b/testsuite/tests/typecheck/should_fail/T15361.hs new file mode 100644 index 0000000..53ae965 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15361.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeOperators #-} +module T15361 where + +import Data.Kind +import Data.Type.Equality + +-- Don't report (* ~ *) here +foo :: forall (a :: Type) (b :: Type) (c :: Type). + a :~~: b -> a :~~: c +foo HRefl = HRefl + +data Chumbawamba :: Type -> Type where + IGetKnockedDown :: (Eq a, Ord a) => a -> Chumbawamba a + +-- Don't report (Eq a) here +goo :: Chumbawamba a -> String +goo (IGetKnockedDown x) = show x diff --git a/testsuite/tests/typecheck/should_fail/T15361.stderr b/testsuite/tests/typecheck/should_fail/T15361.stderr new file mode 100644 index 0000000..93b0174 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15361.stderr @@ -0,0 +1,36 @@ + +T15361.hs:13:13: error: + • Could not deduce: a ~ c + from the context: b ~ a + bound by a pattern with constructor: + HRefl :: forall k1 (a :: k1). a :~~: a, + in an equation for ‘foo’ + at T15361.hs:13:5-9 + ‘a’ is a rigid type variable bound by + the type signature for: + foo :: forall a b c. (a :~~: b) -> a :~~: c + at T15361.hs:(11,1)-(12,27) + ‘c’ is a rigid type variable bound by + the type signature for: + foo :: forall a b c. (a :~~: b) -> a :~~: c + at T15361.hs:(11,1)-(12,27) + Expected type: a :~~: c + Actual type: a :~~: a + • In the expression: HRefl + In an equation for ‘foo’: foo HRefl = HRefl + • Relevant bindings include + foo :: (a :~~: b) -> a :~~: c (bound at T15361.hs:13:1) + +T15361.hs:20:27: error: + • Could not deduce (Show a) arising from a use of ‘show’ + from the context: Ord a + bound by a pattern with constructor: + IGetKnockedDown :: forall a. (Eq a, Ord a) => a -> Chumbawamba a, + in an equation for ‘goo’ + at T15361.hs:20:6-22 + Possible fix: + add (Show a) to the context of + the type signature for: + goo :: forall a. Chumbawamba a -> String + • In the expression: show x + In an equation for ‘goo’: goo (IGetKnockedDown x) = show x diff --git a/testsuite/tests/typecheck/should_fail/T5853.stderr b/testsuite/tests/typecheck/should_fail/T5853.stderr index decc6ad..573a532 100644 --- a/testsuite/tests/typecheck/should_fail/T5853.stderr +++ b/testsuite/tests/typecheck/should_fail/T5853.stderr @@ -2,7 +2,7 @@ T5853.hs:15:46: error: • Could not deduce: Subst (Subst fa a) b ~ Subst fa b arising from a use of ‘<$>’ - from the context: (F fa, Elem fa ~ Elem fa, Elem (Subst fa b) ~ b, + from the context: (F fa, Elem (Subst fa b) ~ b, Subst fa b ~ Subst fa b, Subst (Subst fa b) (Elem fa) ~ fa, F (Subst fa a), Elem (Subst fa a) ~ a, Elem fa ~ Elem fa, Subst (Subst fa a) (Elem fa) ~ fa, Subst fa a ~ Subst fa a) diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 9a042ec..72023d2 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -475,4 +475,5 @@ test('T14904a', normal, compile_fail, ['']) test('T14904b', normal, compile_fail, ['']) test('T15067', normal, compile_fail, ['']) test('T15330', normal, compile_fail, ['']) +test('T15361', normal, compile_fail, ['']) test('T15438', normal, compile_fail, ['']) From git at git.haskell.org Mon Aug 13 13:21:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Aug 2018 13:21:49 +0000 (UTC) Subject: [commit: ghc] master: Bump parsec submodule (bd48a88) Message-ID: <20180813132149.6506A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bd48a88c4269a963b8ce0d522b0c0654a44c25f2/ghc >--------------------------------------------------------------- commit bd48a88c4269a963b8ce0d522b0c0654a44c25f2 Author: Ben Gamari Date: Sat Aug 11 12:00:44 2018 -0400 Bump parsec submodule >--------------------------------------------------------------- bd48a88c4269a963b8ce0d522b0c0654a44c25f2 libraries/parsec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/parsec b/libraries/parsec index 610d7aa..34f9e98 160000 --- a/libraries/parsec +++ b/libraries/parsec @@ -1 +1 @@ -Subproject commit 610d7aa58bb5d436aac47b7c03fa6a0f8cb82ba7 +Subproject commit 34f9e98c64cae99abeabbd3d34cec5469f87291a From git at git.haskell.org Tue Aug 14 23:03:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Aug 2018 23:03:14 +0000 (UTC) Subject: [commit: ghc] master: Properly designate LambdaCase alts as CaseAlt in TH (32008a9) Message-ID: <20180814230314.888233A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/32008a9d0e09f0cc8899aa871d9a6b63fcc28a1a/ghc >--------------------------------------------------------------- commit 32008a9d0e09f0cc8899aa871d9a6b63fcc28a1a Author: Ryan Scott Date: Tue Aug 14 22:35:23 2018 +0200 Properly designate LambdaCase alts as CaseAlt in TH Summary: When `\case` expressions are parsed normally, their alternatives are marked as `CaseAlt` (which means that they are pretty-printed without a `\` character in front of them, unlike for lambda expressions). However, `\case` expressions created by way of Template Haskell (in `Convert`) inconsistently designated the case alternatives as `LambdaExpr`, causing them to be pretty-printed poorly (as shown in #15518). The fix is simple: use `CaseAlt` consistently. Test Plan: make test TEST=T15518 Reviewers: goldfire, bgamari Subscribers: rwbarton, carter GHC Trac Issues: #15518 Differential Revision: https://phabricator.haskell.org/D5069 >--------------------------------------------------------------- 32008a9d0e09f0cc8899aa871d9a6b63fcc28a1a compiler/hsSyn/Convert.hs | 2 +- testsuite/tests/th/T15518.hs | 8 ++++++++ testsuite/tests/th/T15518.stderr | 10 ++++++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 20 insertions(+), 1 deletion(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 84e4594..fbecf9c 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -829,7 +829,7 @@ cvtl e = wrapL (cvt e) ; return $ HsLam noExt (mkMatchGroup FromSource [mkSimpleMatch LambdaExpr pats e'])} - cvt (LamCaseE ms) = do { ms' <- mapM (cvtMatch LambdaExpr) ms + cvt (LamCaseE ms) = do { ms' <- mapM (cvtMatch CaseAlt) ms ; return $ HsLamCase noExt (mkMatchGroup FromSource ms') } diff --git a/testsuite/tests/th/T15518.hs b/testsuite/tests/th/T15518.hs new file mode 100644 index 0000000..eb424a9 --- /dev/null +++ b/testsuite/tests/th/T15518.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskell #-} +module T15518 where + +$([d| f :: Bool -> () + f = \case True -> () + False -> () + |]) diff --git a/testsuite/tests/th/T15518.stderr b/testsuite/tests/th/T15518.stderr new file mode 100644 index 0000000..7d9ef29 --- /dev/null +++ b/testsuite/tests/th/T15518.stderr @@ -0,0 +1,10 @@ +T15518.hs:(5,3)-(8,6): Splicing declarations + [d| f :: Bool -> () + f = \case + True -> () + False -> () |] + ======> + f :: Bool -> () + f = \case + True -> () + False -> () diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 0fddd44..5c7037d 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -425,3 +425,4 @@ test('T14471', normal, compile, ['']) test('TH_rebindableAdo', normal, compile, ['']) test('T14627', normal, compile_fail, ['']) test('TH_invalid_add_top_decl', normal, compile_fail, ['']) +test('T15518', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) From git at git.haskell.org Wed Aug 15 15:58:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Aug 2018 15:58:15 +0000 (UTC) Subject: [commit: ghc] master: primops: Drop support for WORD_SIZE_IN_BITS < 32 (2908899) Message-ID: <20180815155815.7DDE63A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/290889927244c79479c4347dfa6c851a134dd6e0/ghc >--------------------------------------------------------------- commit 290889927244c79479c4347dfa6c851a134dd6e0 Author: Ben Gamari Date: Wed Aug 15 16:49:26 2018 +0200 primops: Drop support for WORD_SIZE_IN_BITS < 32 Summary: Fixes #15486. Test Plan: Validate Reviewers: monoidal Reviewed By: monoidal Subscribers: rwbarton, carter GHC Trac Issues: #15486 Differential Revision: https://phabricator.haskell.org/D5050 >--------------------------------------------------------------- 290889927244c79479c4347dfa6c851a134dd6e0 compiler/prelude/primops.txt.pp | 27 --------------------------- 1 file changed, 27 deletions(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 2cb3b0d..a658c51 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -142,13 +142,8 @@ section "The word size story." -- Define synonyms for indexing ops. -#if WORD_SIZE_IN_BITS < 32 -#define INT32 Int32# -#define WORD32 Word32# -#else #define INT32 Int# #define WORD32 Word# -#endif #if WORD_SIZE_IN_BITS < 64 #define INT64 Int64# @@ -480,28 +475,6 @@ primop Narrow16WordOp "narrow16Word#" Monadic Word# -> Word# primop Narrow32WordOp "narrow32Word#" Monadic Word# -> Word# -#if WORD_SIZE_IN_BITS < 32 ------------------------------------------------------------------------- -section "Int32#" - {Operations on 32-bit integers ({\tt Int32\#}). This type is only used - if plain {\tt Int\#} has less than 32 bits. In any case, the operations - are not primops; they are implemented (if needed) as ccalls instead.} ------------------------------------------------------------------------- - -primtype Int32# - ------------------------------------------------------------------------- -section "Word32#" - {Operations on 32-bit unsigned words. This type is only used - if plain {\tt Word\#} has less than 32 bits. In any case, the operations - are not primops; they are implemented (if needed) as ccalls instead.} ------------------------------------------------------------------------- - -primtype Word32# - -#endif - - #if WORD_SIZE_IN_BITS < 64 ------------------------------------------------------------------------ section "Int64#" From git at git.haskell.org Wed Aug 15 15:58:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Aug 2018 15:58:19 +0000 (UTC) Subject: [commit: ghc] master: Add a test for Trac #15523 (9f932d8) Message-ID: <20180815155819.2A00A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9f932d8a609f54127510a432f399b9487ea84d6a/ghc >--------------------------------------------------------------- commit 9f932d8a609f54127510a432f399b9487ea84d6a Author: Krzysztof Gogolewski Date: Wed Aug 15 16:49:32 2018 +0200 Add a test for Trac #15523 Summary: Fortunately the bug is not present in master. Test Plan: make test TEST=T15523 Reviewers: bgamari, RyanGlScott Reviewed By: RyanGlScott Subscribers: RyanGlScott, rwbarton, carter GHC Trac Issues: #15523 Differential Revision: https://phabricator.haskell.org/D5070 >--------------------------------------------------------------- 9f932d8a609f54127510a432f399b9487ea84d6a testsuite/tests/typecheck/should_fail/T15523.hs | 6 ++++++ testsuite/tests/typecheck/should_fail/T15523.stderr | 6 ++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 3 files changed, 13 insertions(+) diff --git a/testsuite/tests/typecheck/should_fail/T15523.hs b/testsuite/tests/typecheck/should_fail/T15523.hs new file mode 100644 index 0000000..89b1bb4 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15523.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE StrictData #-} + +module T15523 where + +newtype Duration = Foo +data Literal = LitDuration Duration diff --git a/testsuite/tests/typecheck/should_fail/T15523.stderr b/testsuite/tests/typecheck/should_fail/T15523.stderr new file mode 100644 index 0000000..83b7cdb --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15523.stderr @@ -0,0 +1,6 @@ + +T15523.hs:5:20: error: + • The constructor of a newtype must have exactly one field + but ‘Foo’ has none + • In the definition of data constructor ‘Foo’ + In the newtype declaration for ‘Duration’ diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 72023d2..962ffb7 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -477,3 +477,4 @@ test('T15067', normal, compile_fail, ['']) test('T15330', normal, compile_fail, ['']) test('T15361', normal, compile_fail, ['']) test('T15438', normal, compile_fail, ['']) +test('T15523', normal, compile_fail, ['-O']) From git at git.haskell.org Wed Aug 15 16:23:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Aug 2018 16:23:49 +0000 (UTC) Subject: [commit: ghc] master: Cosmetics in GraphColor (1e741fe) Message-ID: <20180815162349.5BD4C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1e741fe829dcf25acf5bf07ce4593f2b537dd351/ghc >--------------------------------------------------------------- commit 1e741fe829dcf25acf5bf07ce4593f2b537dd351 Author: Krzysztof Gogolewski Date: Wed Aug 15 18:20:36 2018 +0200 Cosmetics in GraphColor This allows to run ghc-in-ghci when :set -XTypeApplications is in .ghciconfig. >--------------------------------------------------------------- 1e741fe829dcf25acf5bf07ce4593f2b537dd351 compiler/utils/GraphColor.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/utils/GraphColor.hs b/compiler/utils/GraphColor.hs index 34cbb29..4c1388e 100644 --- a/compiler/utils/GraphColor.hs +++ b/compiler/utils/GraphColor.hs @@ -193,7 +193,7 @@ colorScan_spin iterative triv spill graph -- we were able to coalesce something -- go back to Simplify and see if this frees up more nodes to be trivially colorable. - (graph2, kksCoalesceFound @(_:_)) + (graph2, kksCoalesceFound@(_:_)) -> colorScan_spin iterative triv spill graph2 ksTriv ksSpill (reverse kksCoalesceFound ++ kksCoalesce) From git at git.haskell.org Wed Aug 15 19:21:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Aug 2018 19:21:14 +0000 (UTC) Subject: [commit: ghc] branch 'wip/t-12758_circleci_push_perf_notes' created Message-ID: <20180815192114.D40DA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/t-12758_circleci_push_perf_notes Referencing: 4222bf218308d204037562284c43402bbf81a0be From git at git.haskell.org Wed Aug 15 19:21:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Aug 2018 19:21:18 +0000 (UTC) Subject: [commit: ghc] wip/t-12758_circleci_push_perf_notes: testsuite: Save performance metrics in git notes. (4222bf2) Message-ID: <20180815192118.700033A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/t-12758_circleci_push_perf_notes Link : http://ghc.haskell.org/trac/ghc/changeset/4222bf218308d204037562284c43402bbf81a0be/ghc >--------------------------------------------------------------- commit 4222bf218308d204037562284c43402bbf81a0be Author: David Eichmann Date: Wed Aug 8 11:35:44 2018 +0100 testsuite: Save performance metrics in git notes. Summary: Can now load up git note data into the python test driver. Reviewers: bgamari Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5059 GHC Trac Issues: #12758 >--------------------------------------------------------------- 4222bf218308d204037562284c43402bbf81a0be .circleci/config.yml | 29 +- libraries/base/tests/all.T | 18 +- testsuite/driver/README.md | 161 ++++ testsuite/driver/perf_notes.py | 262 ++++++ testsuite/driver/runtests.py | 34 +- testsuite/driver/testglobals.py | 13 +- testsuite/driver/testlib.py | 211 +++-- testsuite/driver/testutil.py | 6 + testsuite/mk/test.mk | 8 + testsuite/tests/callarity/perf/all.T | 12 +- testsuite/tests/deriving/perf/all.T | 11 +- testsuite/tests/perf/compiler/all.T | 1051 ++---------------------- testsuite/tests/perf/haddock/all.T | 183 +---- testsuite/tests/perf/join_points/all.T | 16 +- testsuite/tests/perf/should_run/all.T | 355 ++------ testsuite/tests/perf/space_leaks/all.T | 75 +- testsuite/tests/pmcheck/should_compile/all.T | 27 +- testsuite/tests/primops/should_run/all.T | 6 +- testsuite/tests/simplCore/should_compile/all.T | 3 +- testsuite/tests/simplStg/should_run/all.T | 5 +- 20 files changed, 785 insertions(+), 1701 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 4222bf218308d204037562284c43402bbf81a0be From git at git.haskell.org Thu Aug 16 11:30:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 16 Aug 2018 11:30:10 +0000 (UTC) Subject: [commit: ghc] master: primops: Drop documentation for WORD_SIZE_IN_BITS < 32 (7a63f75) Message-ID: <20180816113010.1EA8D3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a63f75353d73743d7c57bbbee701f67210a64de/ghc >--------------------------------------------------------------- commit 7a63f75353d73743d7c57bbbee701f67210a64de Author: Chai T. Rex Date: Wed Aug 15 16:37:55 2018 -0400 primops: Drop documentation for WORD_SIZE_IN_BITS < 32 Removes documentation suggesting that 30 and 31-bit code generation is supported (in support of https://github.com/ghc/ghc/commit/290889927244c79479c4347dfa6c851a134dd6e0). >--------------------------------------------------------------- 7a63f75353d73743d7c57bbbee701f67210a64de compiler/prelude/primops.txt.pp | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index a658c51..df92bfa 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -91,10 +91,11 @@ section "The word size story." This is normally set based on the {\tt config.h} parameter {\tt SIZEOF\_HSWORD}, i.e., 32 bits on 32-bit machines, 64 bits on 64-bit machines. However, it can also be explicitly - set to a smaller number, e.g., 31 bits, to allow the + set to a smaller number than 64, e.g., 62 bits, to allow the possibility of using tag bits. Currently GHC itself has only - 32-bit and 64-bit variants, but 30 or 31-bit code can be + 32-bit and 64-bit variants, but 61, 62, or 63-bit code can be exported as an external core file for use in other back ends. + 30 and 31-bit code is no longer supported. GHC also implements a primitive unsigned integer type {\tt Word\#} which always has the same number of bits as {\tt @@ -179,7 +180,7 @@ primop OrdOp "ord#" GenPrimOp Char# -> Int# ------------------------------------------------------------------------ section "Int#" - {Operations on native-size integers (30+ bits).} + {Operations on native-size integers (32+ bits).} ------------------------------------------------------------------------ primtype Int# @@ -316,7 +317,7 @@ primop ISrlOp "uncheckedIShiftRL#" GenPrimOp Int# -> Int# -> Int# ------------------------------------------------------------------------ section "Word#" - {Operations on native-sized unsigned words (30+ bits).} + {Operations on native-sized unsigned words (32+ bits).} ------------------------------------------------------------------------ primtype Word# From git at git.haskell.org Thu Aug 16 11:30:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 16 Aug 2018 11:30:13 +0000 (UTC) Subject: [commit: ghc] master: Fix #15527 by pretty-printing an RdrName prefixly (5238f20) Message-ID: <20180816113013.785283A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5238f204482ac7f05f4e2d2e92576288cc00d42d/ghc >--------------------------------------------------------------- commit 5238f204482ac7f05f4e2d2e92576288cc00d42d Author: Ryan Scott Date: Thu Aug 16 11:53:33 2018 +0200 Fix #15527 by pretty-printing an RdrName prefixly Summary: When `(.) @Int` is used without enabling `TypeApplications`, the resulting error message will pretty-print the (symbolic) `RdrName` `(.)`. However, it does so without parenthesizing it, which causes the pretty-printed expression to appear as `. at Int`. Yuck. Since the expression in a type application will always be prefix, we can fix this issue by using `pprPrefixOcc` instead of plain ol' `ppr`. Test Plan: make test TEST=T15527 Reviewers: bgamari, monoidal, simonpj Reviewed By: monoidal, simonpj Subscribers: rwbarton, carter GHC Trac Issues: #15527 Differential Revision: https://phabricator.haskell.org/D5071 >--------------------------------------------------------------- 5238f204482ac7f05f4e2d2e92576288cc00d42d compiler/hsSyn/HsExpr.hs | 2 +- testsuite/tests/typecheck/should_fail/T15527.hs | 4 ++++ testsuite/tests/typecheck/should_fail/T15527.stderr | 4 ++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 4 files changed, 10 insertions(+), 1 deletion(-) diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index a5c65fb..6ca37e0 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -1087,7 +1087,7 @@ ppr_expr (ArithSeq _ _ info) = brackets (ppr info) ppr_expr (EWildPat _) = char '_' ppr_expr (ELazyPat _ e) = char '~' <> ppr e -ppr_expr (EAsPat _ v e) = ppr v <> char '@' <> ppr e +ppr_expr (EAsPat _ (L _ v) e) = pprPrefixOcc v <> char '@' <> ppr e ppr_expr (EViewPat _ p e) = ppr p <+> text "->" <+> ppr e ppr_expr (HsSCC _ st (StringLiteral stl lbl) expr) diff --git a/testsuite/tests/typecheck/should_fail/T15527.hs b/testsuite/tests/typecheck/should_fail/T15527.hs new file mode 100644 index 0000000..b65c26c --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15527.hs @@ -0,0 +1,4 @@ +module T15527 where + +f :: (Int -> Int) -> (Int -> Int) -> (Int -> Int) +f = (.) @Int diff --git a/testsuite/tests/typecheck/should_fail/T15527.stderr b/testsuite/tests/typecheck/should_fail/T15527.stderr new file mode 100644 index 0000000..dd03a0a --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15527.stderr @@ -0,0 +1,4 @@ + +T15527.hs:4:6: error: + Pattern syntax in expression context: (.)@Int + Did you mean to enable TypeApplications? diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 962ffb7..9c4df89 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -478,3 +478,4 @@ test('T15330', normal, compile_fail, ['']) test('T15361', normal, compile_fail, ['']) test('T15438', normal, compile_fail, ['']) test('T15523', normal, compile_fail, ['-O']) +test('T15527', normal, compile_fail, ['']) From git at git.haskell.org Fri Aug 17 03:59:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Aug 2018 03:59:38 +0000 (UTC) Subject: [commit: ghc] master: Rename SigTv to TyVarTv (#15480) (a50244c) Message-ID: <20180817035938.366DC3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a50244c6a87176a4df8d41e6a1a3f102ba129032/ghc >--------------------------------------------------------------- commit a50244c6a87176a4df8d41e6a1a3f102ba129032 Author: Joachim Breitner Date: Thu Aug 16 17:16:44 2018 -0700 Rename SigTv to TyVarTv (#15480) because since #15050, these are no longer used in pattern SIGnatures, but still in other places where meta-variables should only be unified with TYpe VARiables. I also found mentions of `SigTv` in parts of the renamer and desugarer that do not seem to directly relate to `SigTv` as used in the type checker, but rather to uses of `forall a.` in type signatures. I renamed these to `ScopedTv`. Differential Revision: https://phabricator.haskell.org/D5074 >--------------------------------------------------------------- a50244c6a87176a4df8d41e6a1a3f102ba129032 compiler/deSugar/DsMeta.hs | 12 ++-- compiler/rename/RnBinds.hs | 20 +++--- compiler/typecheck/TcBinds.hs | 12 ++-- compiler/typecheck/TcCanonical.hs | 4 +- compiler/typecheck/TcErrors.hs | 10 +-- compiler/typecheck/TcFlatten.hs | 4 +- compiler/typecheck/TcHsType.hs | 54 ++++++++-------- compiler/typecheck/TcMType.hs | 74 +++++++++++----------- compiler/typecheck/TcPatSyn.hs | 4 +- compiler/typecheck/TcRnTypes.hs | 2 +- compiler/typecheck/TcSigs.hs | 10 +-- compiler/typecheck/TcSimplify.hs | 12 ++-- compiler/typecheck/TcTyClsDecls.hs | 22 +++---- compiler/typecheck/TcType.hs | 48 ++++++-------- compiler/typecheck/TcUnify.hs | 32 +++++----- .../tests/dependent/should_compile/T14066a.hs | 2 +- .../polykinds/{SigTvKinds.hs => TyVarTvKinds.hs} | 2 +- .../polykinds/{SigTvKinds2.hs => TyVarTvKinds2.hs} | 2 +- .../{SigTvKinds2.stderr => TyVarTvKinds2.stderr} | 2 +- .../polykinds/{SigTvKinds3.hs => TyVarTvKinds3.hs} | 2 +- .../{SigTvKinds3.stderr => TyVarTvKinds3.stderr} | 2 +- testsuite/tests/polykinds/all.T | 6 +- 22 files changed, 165 insertions(+), 173 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 a50244c6a87176a4df8d41e6a1a3f102ba129032 From git at git.haskell.org Fri Aug 17 07:56:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Aug 2018 07:56:57 +0000 (UTC) Subject: [commit: ghc] master: Document default value of +RTS -N in user's guide (23f6f31) Message-ID: <20180817075657.1853C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23f6f31dd66d7c370cb8beec3f1d96a0cb577393/ghc >--------------------------------------------------------------- commit 23f6f31dd66d7c370cb8beec3f1d96a0cb577393 Author: Ömer Sinan Ağacan Date: Fri Aug 17 10:56:28 2018 +0300 Document default value of +RTS -N in user's guide Summary: (This is documented in `+RTS -?` but wasn't documented in the user's guide) Reviewers: simonmar, bgamari, monoidal Reviewed By: monoidal Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5065 >--------------------------------------------------------------- 23f6f31dd66d7c370cb8beec3f1d96a0cb577393 docs/users_guide/using-concurrent.rst | 2 ++ 1 file changed, 2 insertions(+) diff --git a/docs/users_guide/using-concurrent.rst b/docs/users_guide/using-concurrent.rst index e8640dc..da27708 100644 --- a/docs/users_guide/using-concurrent.rst +++ b/docs/users_guide/using-concurrent.rst @@ -133,6 +133,8 @@ use the RTS :rts-flag:`-N ⟨x⟩` options. value of ⟨x⟩ itself based on how many processors are in your machine. + Omitting ``-N⟨x⟩`` entirely means ``-N1``. + With ``-maxN⟨x⟩``, i.e. ``+RTS -maxN3 -RTS``, the runtime will choose at most (x), also limited by the number of processors on the system. Omitting (x) is an error, if you need a default use option ``-N``. From git at git.haskell.org Fri Aug 17 11:44:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Aug 2018 11:44:52 +0000 (UTC) Subject: [commit: ghc] branch 'wip/az-D5036' created Message-ID: <20180817114452.519293A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/az-D5036 Referencing: 6c125148b62aebe00e354421fec1e0524ab92b97 From git at git.haskell.org Fri Aug 17 11:44:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Aug 2018 11:44:55 +0000 (UTC) Subject: [commit: ghc] wip/az-D5036: [TTG: Handling Source Locations] Foundation and Pat (3c34ba1) Message-ID: <20180817114455.5B0DC3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/az-D5036 Link : http://ghc.haskell.org/trac/ghc/changeset/3c34ba1ed61b26e6a7c8f3b76bf262c641f5fdee/ghc >--------------------------------------------------------------- commit 3c34ba1ed61b26e6a7c8f3b76bf262c641f5fdee Author: Shayan-Najd Date: Fri Aug 17 11:56:41 2018 +0200 [TTG: Handling Source Locations] Foundation and Pat Summary: - the class `HasSrcSpan`, and its functions (e.g., `cL` and `dL`), are introduced - some instances of `HasSrcSpan` are introduced - some constructors `L` are replaced with `cL` - some patterns `L` are replaced with `dL` view pattern - `XPat` is renamed to `NewPat` - some type annotation are necessarily updated updated (e.g., `Pat p` --> `Pat (GhcPass p)`) - (there was a bug in an earlier version of this patch related to using functor on `Located` things that is fixed) Test Plan: - GHC and the related code (e.g., Haddock) fully compile on my Linux system - the patch passes the tests and ./Validate Reviewers: bgamari, alanz, simonpj GHC Trac Issues: #15495 Differential Revision: https://phabricator.haskell.org/D5036 >--------------------------------------------------------------- 3c34ba1ed61b26e6a7c8f3b76bf262c641f5fdee compiler/basicTypes/Name.hs | 8 +- compiler/basicTypes/SrcLoc.hs | 80 +++++-- compiler/deSugar/Check.hs | 10 +- compiler/deSugar/DsArrows.hs | 5 +- compiler/deSugar/DsExpr.hs | 2 +- compiler/deSugar/DsListComp.hs | 2 +- compiler/deSugar/DsMeta.hs | 3 +- compiler/deSugar/DsUtils.hs | 45 ++-- compiler/deSugar/ExtractDocs.hs | 5 +- compiler/deSugar/Match.hs | 23 ++- compiler/deSugar/MatchCon.hs | 3 +- compiler/hsSyn/Convert.hs | 107 +++++----- compiler/hsSyn/HsExtension.hs | 4 +- compiler/hsSyn/HsPat.hs | 88 +++++--- compiler/hsSyn/HsPat.hs-boot | 3 +- compiler/hsSyn/HsTypes.hs | 4 +- compiler/hsSyn/HsUtils.hs | 213 ++++++++++--------- compiler/main/DynFlags.hs | 1 + compiler/main/GHC.hs | 4 + compiler/main/HeaderInfo.hs | 75 ++++--- compiler/main/HscStats.hs | 4 +- compiler/main/HscTypes.hs | 3 +- compiler/parser/Lexer.x | 30 +-- compiler/parser/Parser.y | 106 +++++----- compiler/parser/RdrHsSyn.hs | 414 +++++++++++++++++++------------------ compiler/rename/RnBinds.hs | 10 +- compiler/rename/RnExpr.hs | 7 +- compiler/rename/RnPat.hs | 50 ++--- compiler/rename/RnSplice.hs | 14 +- compiler/rename/RnTypes.hs | 9 +- compiler/typecheck/TcBinds.hs | 3 +- compiler/typecheck/TcErrors.hs | 4 +- compiler/typecheck/TcHsSyn.hs | 3 +- compiler/typecheck/TcHsType.hs | 2 +- compiler/typecheck/TcPat.hs | 5 +- compiler/typecheck/TcPatSyn.hs | 15 +- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcRnExports.hs | 4 +- compiler/typecheck/TcRnMonad.hs | 33 ++- compiler/typecheck/TcTyClsDecls.hs | 9 +- compiler/typecheck/TcTyDecls.hs | 19 +- compiler/utils/Binary.hs | 2 +- ghc/GHCi/UI/Info.hs | 7 +- hadrian | 2 +- libraries/Cabal | 2 +- libraries/binary | 2 +- libraries/directory | 2 +- libraries/filepath | 2 +- libraries/haskeline | 2 +- libraries/mtl | 2 +- libraries/parallel | 2 +- libraries/parsec | 2 +- libraries/stm | 2 +- libraries/terminfo | 2 +- libraries/unix | 2 +- libraries/xhtml | 2 +- testsuite/tests/ghc-api/T6145.hs | 7 +- utils/ghctags/Main.hs | 3 +- utils/haddock | 2 +- 59 files changed, 834 insertions(+), 644 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 3c34ba1ed61b26e6a7c8f3b76bf262c641f5fdee From git at git.haskell.org Fri Aug 17 11:44:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Aug 2018 11:44:58 +0000 (UTC) Subject: [commit: ghc] wip/az-D5036: Include submodule versions so it can build. (6c12514) Message-ID: <20180817114458.33C343A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/az-D5036 Link : http://ghc.haskell.org/trac/ghc/changeset/6c125148b62aebe00e354421fec1e0524ab92b97/ghc >--------------------------------------------------------------- commit 6c125148b62aebe00e354421fec1e0524ab92b97 Author: Alan Zimmerman Date: Fri Aug 17 13:42:28 2018 +0200 Include submodule versions so it can build. This is arc patch D5036 against current master (23f6f31dd66d7c370cb8beec3f1d96a0cb577393) and then updating the submodules according to https://phabricator.haskell.org/harbormaster/build/51074/ Still need to track down the required haddock changes. >--------------------------------------------------------------- 6c125148b62aebe00e354421fec1e0524ab92b97 libraries/Cabal | 2 +- libraries/directory | 2 +- libraries/haskeline | 2 +- libraries/mtl | 2 +- libraries/parallel | 2 +- libraries/stm | 2 +- libraries/terminfo | 2 +- libraries/unix | 2 +- libraries/xhtml | 2 +- 9 files changed, 9 insertions(+), 9 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index fe10982..8fbacca 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit fe10982db1f2fa7d828fc5f8ddaa5beedceaddec +Subproject commit 8fbacca029f3ad764576aefb610a0408c4b6aaad diff --git a/libraries/directory b/libraries/directory index e9debc1..9c474f0 160000 --- a/libraries/directory +++ b/libraries/directory @@ -1 +1 @@ -Subproject commit e9debc1d4a9c4b608a32f60bae173ed10f89fdce +Subproject commit 9c474f0d287b143c43dff275db0640d358e323cc diff --git a/libraries/haskeline b/libraries/haskeline index 84a7b2b..19b0be5 160000 --- a/libraries/haskeline +++ b/libraries/haskeline @@ -1 +1 @@ -Subproject commit 84a7b2b0afb9325cfcedc3ca56603539f0e8af3e +Subproject commit 19b0be5687e933494c462a72cd7348c397aa3406 diff --git a/libraries/mtl b/libraries/mtl index c7d3967..bf4af11 160000 --- a/libraries/mtl +++ b/libraries/mtl @@ -1 +1 @@ -Subproject commit c7d396732bd45e409478bd4df1d0ca95d6f39356 +Subproject commit bf4af114ba3d35b2937fc74926aa49e128dd6c1f diff --git a/libraries/parallel b/libraries/parallel index 5015bc7..41279a7 160000 --- a/libraries/parallel +++ b/libraries/parallel @@ -1 +1 @@ -Subproject commit 5015bc74127beac29b4d08dcb3beb230149fed25 +Subproject commit 41279a764acd0758f15801c10650d73343637451 diff --git a/libraries/stm b/libraries/stm index 4c24db6..637013d 160000 --- a/libraries/stm +++ b/libraries/stm @@ -1 +1 @@ -Subproject commit 4c24db6071fc1319232934562f7dbed45d498831 +Subproject commit 637013d3f2596c86adc8c946e2f38e9e1a85fd84 diff --git a/libraries/terminfo b/libraries/terminfo index 27e8275..72a08c5 160000 --- a/libraries/terminfo +++ b/libraries/terminfo @@ -1 +1 @@ -Subproject commit 27e82750fac178fc6e049fe44be6de45f24814ae +Subproject commit 72a08c5435c332bdfd0444dd3ab3fad96e401da1 diff --git a/libraries/unix b/libraries/unix index f4f500d..c9ec0b0 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit f4f500d53b4c73e542a377a5c675309dbbe5774d +Subproject commit c9ec0b00012e5eb447ff021091f86efe31be8abf diff --git a/libraries/xhtml b/libraries/xhtml index 721779a..c5c623e 160000 --- a/libraries/xhtml +++ b/libraries/xhtml @@ -1 +1 @@ -Subproject commit 721779acc35dccd6a43a292b24099b65d93d390c +Subproject commit c5c623e497f13ec187e0d228e0e8a3d9ee39a715 From git at git.haskell.org Fri Aug 17 14:42:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Aug 2018 14:42:03 +0000 (UTC) Subject: [commit: ghc] wip/t-12758_circleci_push_perf_notes: testsuite: Save performance metrics in git notes. (f95c801) Message-ID: <20180817144203.DEF343A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/t-12758_circleci_push_perf_notes Link : http://ghc.haskell.org/trac/ghc/changeset/f95c801e4c18391c8f0a32155d02571612e9ad55/ghc >--------------------------------------------------------------- commit f95c801e4c18391c8f0a32155d02571612e9ad55 Author: David Eichmann Date: Wed Aug 8 11:35:44 2018 +0100 testsuite: Save performance metrics in git notes. Summary: Can now load up git note data into the python test driver. Reviewers: bgamari Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5059 GHC Trac Issues: #12758 >--------------------------------------------------------------- f95c801e4c18391c8f0a32155d02571612e9ad55 .circleci/config.yml | 29 +- libraries/base/tests/all.T | 18 +- testsuite/driver/README.md | 161 ++++ testsuite/driver/perf_notes.py | 262 ++++++ testsuite/driver/runtests.py | 34 +- testsuite/driver/testglobals.py | 13 +- testsuite/driver/testlib.py | 211 +++-- testsuite/driver/testutil.py | 6 + testsuite/mk/test.mk | 8 + testsuite/tests/callarity/perf/all.T | 12 +- testsuite/tests/deriving/perf/all.T | 11 +- testsuite/tests/perf/compiler/all.T | 1051 ++---------------------- testsuite/tests/perf/haddock/all.T | 183 +---- testsuite/tests/perf/join_points/all.T | 16 +- testsuite/tests/perf/should_run/all.T | 355 ++------ testsuite/tests/perf/space_leaks/all.T | 75 +- testsuite/tests/pmcheck/should_compile/all.T | 27 +- testsuite/tests/primops/should_run/all.T | 6 +- testsuite/tests/simplCore/should_compile/all.T | 3 +- testsuite/tests/simplStg/should_run/all.T | 5 +- 20 files changed, 785 insertions(+), 1701 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 f95c801e4c18391c8f0a32155d02571612e9ad55 From git at git.haskell.org Fri Aug 17 15:48:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Aug 2018 15:48:31 +0000 (UTC) Subject: [commit: ghc] master: Be mindful of GADT tyvar order when desugaring record updates (63b6a1d) Message-ID: <20180817154831.B7D453A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/63b6a1d44849c479d2a7cb59211f5c64d133bc62/ghc >--------------------------------------------------------------- commit 63b6a1d44849c479d2a7cb59211f5c64d133bc62 Author: Ryan Scott Date: Fri Aug 17 16:31:27 2018 +0200 Be mindful of GADT tyvar order when desugaring record updates Summary: After commit ef26182e2014b0a2a029ae466a4b121bf235e4e4, the type variable binders in GADT constructor type signatures are now quantified in toposorted order, instead of always having all the universals before all the existentials. Unfortunately, that commit forgot to update some code (which was assuming the latter scenario) in `DsExpr` which desugars record updates. This wound up being the cause of #15499. This patch makes up for lost time by desugaring record updates in a way such that the desugared expression applies type arguments to the right-hand side constructor in the correct order—that is, the order in which they were quantified by the user. Test Plan: make test TEST=T15499 Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, carter GHC Trac Issues: #15499 Differential Revision: https://phabricator.haskell.org/D5060 >--------------------------------------------------------------- 63b6a1d44849c479d2a7cb59211f5c64d133bc62 compiler/deSugar/DsExpr.hs | 25 +++++++++++++++------- testsuite/tests/typecheck/should_compile/T15499.hs | 11 ++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 3 files changed, 29 insertions(+), 8 deletions(-) diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index 954ca9c..7142cfb 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -636,12 +636,18 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields mk_alt upd_fld_env con = do { let (univ_tvs, ex_tvs, eq_spec, prov_theta, _req_theta, arg_tys, _) = conLikeFullSig con - subst = zipTvSubst univ_tvs in_inst_tys + user_tvs = + case con of + RealDataCon data_con -> dataConUserTyVars data_con + PatSynCon _ -> univ_tvs ++ ex_tvs + -- The order here is because of the order in `TcPatSyn`. + in_subst = zipTvSubst univ_tvs in_inst_tys + out_subst = zipTvSubst univ_tvs out_inst_tys -- I'm not bothering to clone the ex_tvs - ; eqs_vars <- mapM newPredVarDs (substTheta subst (eqSpecPreds eq_spec)) - ; theta_vars <- mapM newPredVarDs (substTheta subst prov_theta) - ; arg_ids <- newSysLocalsDs (substTysUnchecked subst arg_tys) + ; eqs_vars <- mapM newPredVarDs (substTheta in_subst (eqSpecPreds eq_spec)) + ; theta_vars <- mapM newPredVarDs (substTheta in_subst prov_theta) + ; arg_ids <- newSysLocalsDs (substTysUnchecked in_subst arg_tys) ; let field_labels = conLikeFieldLabels con val_args = zipWithEqual "dsExpr:RecordUpd" mk_val_arg field_labels arg_ids @@ -650,13 +656,16 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields inst_con = noLoc $ mkHsWrap wrap (HsConLikeOut noExt con) -- Reconstruct with the WrapId so that unpacking happens - -- The order here is because of the order in `TcPatSyn`. wrap = mkWpEvVarApps theta_vars <.> dict_req_wrap <.> - mkWpTyApps (mkTyVarTys ex_tvs) <.> - mkWpTyApps [ ty - | (tv, ty) <- univ_tvs `zip` out_inst_tys + mkWpTyApps [ lookupTyVar out_subst tv + `orElse` mkTyVarTy tv + | tv <- user_tvs , not (tv `elemVarEnv` wrap_subst) ] + -- Be sure to use user_tvs (which may be ordered + -- differently than `univ_tvs ++ ex_tvs) above. + -- See Note [DataCon user type variable binders] + -- in DataCon. rhs = foldl (\a b -> nlHsApp a b) inst_con val_args -- Tediously wrap the application in a cast diff --git a/testsuite/tests/typecheck/should_compile/T15499.hs b/testsuite/tests/typecheck/should_compile/T15499.hs new file mode 100644 index 0000000..653440a --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15499.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE DataKinds, GADTs, KindSignatures #-} +module T15499 () +where + +data ADT (p :: Integer) where + ADT :: + { a :: a + , b :: Integer + } -> ADT p + +foo = undefined {b=undefined} diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index c36eaea..75f9aba 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -648,3 +648,4 @@ test('T15428', normal, compile, ['']) test('T15412', normal, compile, ['']) test('T15141', normal, compile, ['']) test('T15473', expect_broken(15473), compile, ['']) +test('T15499', normal, compile, ['']) From git at git.haskell.org Fri Aug 17 16:12:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Aug 2018 16:12:00 +0000 (UTC) Subject: [commit: ghc] wip/t-12758_circleci_push_perf_notes: testsuite: Save performance metrics in git notes. (82aca57) Message-ID: <20180817161200.DACBE3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/t-12758_circleci_push_perf_notes Link : http://ghc.haskell.org/trac/ghc/changeset/82aca5753d1dc1ac0e06587262f0e750cb8a3d2d/ghc >--------------------------------------------------------------- commit 82aca5753d1dc1ac0e06587262f0e750cb8a3d2d Author: David Eichmann Date: Wed Aug 8 11:35:44 2018 +0100 testsuite: Save performance metrics in git notes. Summary: Can now load up git note data into the python test driver. Reviewers: bgamari Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5059 GHC Trac Issues: #12758 >--------------------------------------------------------------- 82aca5753d1dc1ac0e06587262f0e750cb8a3d2d .circleci/config.yml | 32 +- libraries/base/tests/all.T | 18 +- testsuite/driver/README.md | 161 ++++ testsuite/driver/perf_notes.py | 262 ++++++ testsuite/driver/runtests.py | 34 +- testsuite/driver/testglobals.py | 13 +- testsuite/driver/testlib.py | 211 +++-- testsuite/driver/testutil.py | 6 + testsuite/mk/test.mk | 8 + testsuite/tests/callarity/perf/all.T | 12 +- testsuite/tests/deriving/perf/all.T | 11 +- testsuite/tests/perf/compiler/all.T | 1051 ++---------------------- testsuite/tests/perf/haddock/all.T | 183 +---- testsuite/tests/perf/join_points/all.T | 16 +- testsuite/tests/perf/should_run/all.T | 355 ++------ testsuite/tests/perf/space_leaks/all.T | 75 +- testsuite/tests/pmcheck/should_compile/all.T | 27 +- testsuite/tests/primops/should_run/all.T | 6 +- testsuite/tests/simplCore/should_compile/all.T | 3 +- testsuite/tests/simplStg/should_run/all.T | 5 +- 20 files changed, 788 insertions(+), 1701 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 82aca5753d1dc1ac0e06587262f0e750cb8a3d2d From git at git.haskell.org Fri Aug 17 18:54:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Aug 2018 18:54:05 +0000 (UTC) Subject: [commit: ghc] master: base: rewrite Monoid module docs (ae68f32) Message-ID: <20180817185405.D4D003A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ae68f32ada5e97fa76268119294f12ec5c50e73c/ghc >--------------------------------------------------------------- commit ae68f32ada5e97fa76268119294f12ec5c50e73c Author: Tobias Pflug Date: Wed Aug 8 23:21:02 2018 +0200 base: rewrite Monoid module docs >--------------------------------------------------------------- ae68f32ada5e97fa76268119294f12ec5c50e73c libraries/base/Data/Monoid.hs | 39 +++++++++++++++++++++++++++++++++++++-- 1 file changed, 37 insertions(+), 2 deletions(-) diff --git a/libraries/base/Data/Monoid.hs b/libraries/base/Data/Monoid.hs index 29b5ddb..2fec717 100644 --- a/libraries/base/Data/Monoid.hs +++ b/libraries/base/Data/Monoid.hs @@ -16,8 +16,43 @@ -- Stability : experimental -- Portability : portable -- --- A class for monoids (types with an associative binary operation that --- has an identity) with various general-purpose instances. +-- A type @a@ is a 'Monoid' if it provides an associative function ('<>') +-- that lets you combine any two values of type @a@ into one, and a neutral +-- element (`mempty`) such that +-- +-- > a <> mempty == mempty <> a == a +-- +-- A 'Monoid' is a 'Semigroup' with the added requirement of a neutral element. +-- Thus any 'Monoid' is a 'Semigroup', but not the other way around. +-- +-- ==== __Examples__ +-- +-- The 'Sum' monoid is defined by the numerical addition operator and `0` as neutral element: +-- +-- >>> mempty :: Sum Int +-- Sum 0 +-- >>> Sum 1 <> Sum 2 <> Sum 3 <> Sum 4 :: Sum Int +-- Sum {getSum = 10} +-- +-- We can combine multiple values in a list into a single value using the `mconcat` function. +-- Note that we have to specify the type here since 'Int' is a monoid under several different +-- operations: +-- +-- >>> mconcat [1,2,3,4] :: Sum Int +-- Sum {getSum = 10} +-- >>> mconcat [] :: Sum Int +-- Sum {getSum = 0} +-- +-- Another valid monoid instance of 'Int' is 'Product' It is defined by multiplication +-- and `1` as neutral element: +-- +-- >>> Product 1 <> Product 2 <> Product 3 <> Product 4 :: Product Int +-- Product {getProduct = 24} +-- >>> mconcat [1,2,3,4] :: Product Int +-- Product {getProduct = 24} +-- >>> mconcat [] :: Product Int +-- Product {getProduct = 1} +-- -- ----------------------------------------------------------------------------- From git at git.haskell.org Fri Aug 17 18:54:08 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Aug 2018 18:54:08 +0000 (UTC) Subject: [commit: ghc] master: Make ghci work for stage1 and Hadrian (8154faf) Message-ID: <20180817185408.A81533A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8154faf5a7236f27e0eb3409bb45c3f3c52320e7/ghc >--------------------------------------------------------------- commit 8154faf5a7236f27e0eb3409bb45c3f3c52320e7 Author: Neil Mitchell Date: Thu Aug 9 13:47:20 2018 +0100 Make ghci work for stage1 and Hadrian This allows you to use the ghc-in-ghci script in Make even if you haven't built stage2, and also with Hadrian. Because of the way -I works, it will prefer Make/stage2. >--------------------------------------------------------------- 8154faf5a7236f27e0eb3409bb45c3f3c52320e7 utils/ghc-in-ghci/settings.ghci | 22 +++++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) diff --git a/utils/ghc-in-ghci/settings.ghci b/utils/ghc-in-ghci/settings.ghci index 8f5ba6e..dd914d1 100644 --- a/utils/ghc-in-ghci/settings.ghci +++ b/utils/ghc-in-ghci/settings.ghci @@ -25,9 +25,6 @@ :set -icompiler/vectorise :set -ighc :set -Icompiler -:set -Icompiler/stage2 -:set -Icompiler/stage2/build -:set -icompiler/stage2/build :set -Iincludes :set -Iincludes/dist-derivedconstants/header :set -package=ghc-boot-th @@ -36,6 +33,25 @@ :set -DGHC_LOADED_INTO_GHCI :set -XNoImplicitPrelude +-- make it work for Make stage2 +:set -Icompiler/stage2 +:set -Icompiler/stage2/build +:set -icompiler/stage2/build + +-- make it work for Make stage1 +:set -Icompiler/stage1 +:set -Icompiler/stage1/build +:set -icompiler/stage1/build + +-- make it work for Hadrian stage2 +:set -I_build/generated +:set -I_build/stage2/compiler/build +:set -i_build/stage2/compiler/build + +-- make it work for Hadrian stage1 +:set -I_build/stage1/compiler/build +:set -i_build/stage1/compiler/build + -- -fobject-code is required because bytecode doesn't support unboxed tuples -- https://ghc.haskell.org/trac/ghc/ticket/1257 :set -odir ./.ghci-objects From git at git.haskell.org Fri Aug 17 18:54:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Aug 2018 18:54:12 +0000 (UTC) Subject: [commit: ghc] master: Add test cases for Ticket #12146. (8f4df7f) Message-ID: <20180817185412.0AB8F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8f4df7f769e0e625922d6f63fa20bd038f3c0c3d/ghc >--------------------------------------------------------------- commit 8f4df7f769e0e625922d6f63fa20bd038f3c0c3d Author: Aditya Date: Sat Jul 9 11:41:25 2016 +0530 Add test cases for Ticket #12146. Two tests - a ghci script and a compile fail test have been added. >--------------------------------------------------------------- 8f4df7f769e0e625922d6f63fa20bd038f3c0c3d testsuite/tests/rename/should_fail/T12146.hs | 5 +++++ .../{ghci/scripts/T6106.stderr => rename/should_fail/T12146.stderr} | 2 +- testsuite/tests/rename/should_fail/all.T | 1 + 3 files changed, 7 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/rename/should_fail/T12146.hs b/testsuite/tests/rename/should_fail/T12146.hs new file mode 100644 index 0000000..e44be13 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T12146.hs @@ -0,0 +1,5 @@ +-- Test Trac #12146 + +module T12146 where + +ipmort Data.Char diff --git a/testsuite/tests/ghci/scripts/T6106.stderr b/testsuite/tests/rename/should_fail/T12146.stderr similarity index 85% copy from testsuite/tests/ghci/scripts/T6106.stderr copy to testsuite/tests/rename/should_fail/T12146.stderr index 7023e2f..0dcd154 100644 --- a/testsuite/tests/ghci/scripts/T6106.stderr +++ b/testsuite/tests/rename/should_fail/T12146.stderr @@ -1,4 +1,4 @@ -T6106.hs:1:1: +T12146.hs:5:1: Parse error: module header, import declaration or top-level declaration expected. diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index 413b24f..f2bf30e 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -119,6 +119,7 @@ test('T10781', normal, compile_fail, ['']) test('T11071', normal, compile_fail, ['']) test('T11071a', normal, compile_fail, ['']) test('T11663', normal, compile_fail, ['']) +test('T12146', normal, compile_fail, ['']) test('T12229', normal, compile, ['']) test('T12681', normal, multimod_compile_fail, ['T12681','-v0']) test('T12686', normal, compile_fail, ['']) From git at git.haskell.org Fri Aug 17 18:54:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Aug 2018 18:54:14 +0000 (UTC) Subject: [commit: ghc] master: base: Rewrite semigroup documentation (2748e95) Message-ID: <20180817185414.DCD9D3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2748e9574106b854f56e61fbbbac16bce44eaecb/ghc >--------------------------------------------------------------- commit 2748e9574106b854f56e61fbbbac16bce44eaecb Author: Tobias Pflug Date: Fri Aug 3 22:52:37 2018 +0200 base: Rewrite semigroup documentation >--------------------------------------------------------------- 2748e9574106b854f56e61fbbbac16bce44eaecb libraries/base/Data/Semigroup.hs | 53 ++++++++++++++++++++++++++++++++++------ 1 file changed, 45 insertions(+), 8 deletions(-) diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs index 58a0b92..fad1b206 100644 --- a/libraries/base/Data/Semigroup.hs +++ b/libraries/base/Data/Semigroup.hs @@ -19,15 +19,52 @@ -- Stability : provisional -- Portability : portable -- --- In mathematics, a semigroup is an algebraic structure consisting of a --- set together with an associative binary operation. A semigroup --- generalizes a monoid in that there might not exist an identity --- element. It also (originally) generalized a group (a monoid with all --- inverses) to a type where every element did not have to have an inverse, --- thus the name semigroup. +-- A type @a@ is a 'Semigroup' if it provides an associative function ('<>') +-- that lets you combine any two values of type @a@ into one. Where being +-- associative means that the following must always hold: -- --- The use of @(\<\>)@ in this module conflicts with an operator with the same --- name that is being exported by Data.Monoid. However, this package +-- >>> (a <> b) <> c == a <> (b <> c) +-- +-- ==== __Examples__ +-- +-- The 'Min' 'Semigroup' instance for 'Int' is defined to always pick the smaller +-- number: +-- >>> Min 1 <> Min 2 <> Min 3 <> Min 4 :: Min Int +-- Min {getMin = 1} +-- +-- If we need to combine multiple values we can use the 'sconcat' function +-- to do so. We need to ensure however that we have at least one value to +-- operate on, since otherwise our result would be undefined. It is for this +-- reason that 'sconcat' uses "Data.List.NonEmpty.NonEmpty" - a list that +-- can never be empty: +-- +-- >>> (1 :| []) +-- 1 :| [] -- equivalent to [1] but guaranteed to be non-empty +-- >>> (1 :| [2, 3, 4]) +-- 1 :| [2,3,4] -- equivalent to [1,2,3,4] but guaranteed to be non-empty +-- +-- Equipped with this guaranteed to be non-empty data structure, we can combine +-- values using 'sconcat' and a 'Semigroup' of our choosing. We can try the 'Min' +-- and 'Max' instances of 'Int' which pick the smallest, or largest number +-- respectively: +-- +-- >>> sconcat (1 :| [2, 3, 4]) :: Min Int +-- Min {getMin = 1} +-- >>> sconcat (1 :| [2, 3, 4]) :: Max Int +-- Max {getMax = 4} +-- +-- String concatenation is another example of a 'Semigroup' instance: +-- +-- >>> "foo" <> "bar" +-- "foobar" +-- +-- A 'Semigroup' is a generalization of a 'Monoid'. Yet unlike the 'Semigroup', the 'Monoid' +-- requires the presence of a neutral element ('mempty') in addition to the associative +-- operator. The requirement for a neutral element prevents many types from being a full Monoid, +-- like "Data.List.NonEmpty.NonEmpty". +-- +-- Note that the use of @(\<\>)@ in this module conflicts with an operator with the same +-- name that is being exported by "Data.Monoid". However, this package -- re-exports (most of) the contents of Data.Monoid, so to use semigroups -- and monoids in the same package just -- From git at git.haskell.org Fri Aug 17 18:54:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Aug 2018 18:54:17 +0000 (UTC) Subject: [commit: ghc] master: Add comment explaining change in syntax error suggestion for #12146. (1bbb5fa) Message-ID: <20180817185417.B0FB33A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1bbb5fa2f7c5eeb46afbba3301df68cccc8be6a3/ghc >--------------------------------------------------------------- commit 1bbb5fa2f7c5eeb46afbba3301df68cccc8be6a3 Author: Aditya Date: Sat Jul 9 11:38:38 2016 +0530 Add comment explaining change in syntax error suggestion for #12146. >--------------------------------------------------------------- 1bbb5fa2f7c5eeb46afbba3301df68cccc8be6a3 compiler/rename/RnSource.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index beb7c5b..5968520 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -2206,6 +2206,10 @@ add gp loc (SpliceD _ splice@(SpliceDecl _ _ flag)) ds where badImplicitSplice = text "Parse error: module header, import declaration" $$ text "or top-level declaration expected." + -- The compiler should suggest the above, and not using + -- TemplateHaskell since the former suggestion is more + -- relevant to the larger base of users. + -- See Trac #12146 for discussion. -- Class declarations: pull out the fixity signatures to the top add gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs}) l (TyClD _ d) ds From git at git.haskell.org Sat Aug 18 21:47:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Aug 2018 21:47:21 +0000 (UTC) Subject: [commit: ghc] master: CSE should deal with letrec (#9441) (a08b285) Message-ID: <20180818214721.579FD3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a08b285f74cd49196feb0f819d70ad0508689da3/ghc >--------------------------------------------------------------- commit a08b285f74cd49196feb0f819d70ad0508689da3 Author: roland Date: Sat Aug 18 23:45:31 2018 +0200 CSE should deal with letrec (#9441) Summary: Write tests with fewer lines. See comments of nomeata in https://phabricator.haskell.org/D5038. Test Plan: make test TESTS='T9441a T9441b T9441c' Reviewers: nomeata, dfeuer, bgamari Reviewed By: nomeata Subscribers: rwbarton, carter GHC Trac Issues: #9441 Differential Revision: https://phabricator.haskell.org/D5076 >--------------------------------------------------------------- a08b285f74cd49196feb0f819d70ad0508689da3 testsuite/tests/simplCore/should_compile/Makefile | 13 ------------- .../should_compile/{T9441a.stdout => T9441a.stderr} | 0 .../should_compile/{T9441b.stdout => T9441b.stderr} | 0 .../should_compile/{T9441c.stdout => T9441c.stderr} | 0 testsuite/tests/simplCore/should_compile/all.T | 6 +++--- 5 files changed, 3 insertions(+), 16 deletions(-) diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile index 0fb5dc2..1233b8c 100644 --- a/testsuite/tests/simplCore/should_compile/Makefile +++ b/testsuite/tests/simplCore/should_compile/Makefile @@ -27,19 +27,6 @@ T8848: '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-rule-firings T8848.hs | grep 'SPEC map2' # Should fire twice -T9441a: - $(RM) -f T9941a.o T9941a.hi - '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-all T9441a.hs | grep 'f1 = f2' - # Grep output should show 'f1 = f2' -T9441b: - $(RM) -f T9941b.o T9941b.hi - '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-all T9441b.hs | grep 'Rec {' - # Grep output should show only one recursive Bind 'Rec {' -T9441c: - $(RM) -f T9941c.o T9941c.hi - '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-all T9441c.hs | grep 'Rec {' - # Grep output should show only one recursive Bind 'Rec {' - T9509: $(RM) -f T9509*.o T9509*.hi '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T9509a.hs diff --git a/testsuite/tests/simplCore/should_compile/T9441a.stdout b/testsuite/tests/simplCore/should_compile/T9441a.stderr similarity index 100% rename from testsuite/tests/simplCore/should_compile/T9441a.stdout rename to testsuite/tests/simplCore/should_compile/T9441a.stderr diff --git a/testsuite/tests/simplCore/should_compile/T9441b.stdout b/testsuite/tests/simplCore/should_compile/T9441b.stderr similarity index 100% rename from testsuite/tests/simplCore/should_compile/T9441b.stdout rename to testsuite/tests/simplCore/should_compile/T9441b.stderr diff --git a/testsuite/tests/simplCore/should_compile/T9441c.stdout b/testsuite/tests/simplCore/should_compile/T9441c.stderr similarity index 100% rename from testsuite/tests/simplCore/should_compile/T9441c.stdout rename to testsuite/tests/simplCore/should_compile/T9441c.stderr diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 07b5f0a..595607b 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -196,9 +196,9 @@ test('T8848a', only_ways(['optasm']), compile, ['-ddump-rules']) test('T8331', only_ways(['optasm']), compile, ['-ddump-rules']) test('T6056', only_ways(['optasm']), multimod_compile, ['T6056', '-v0 -ddump-rule-firings']) test('T9400', only_ways(['optasm']), compile, ['-O0 -ddump-simpl -dsuppress-uniques']) -test('T9441a', normal, run_command, ['$MAKE -s --no-print-directory T9441a']) -test('T9441b', normal, run_command, ['$MAKE -s --no-print-directory T9441b']) -test('T9441c', normal, run_command, ['$MAKE -s --no-print-directory T9441c']) +test('T9441a', [only_ways(['optasm']), check_errmsg(r'f1 = f2') ], compile, ['-ddump-simpl']) +test('T9441b', [only_ways(['optasm']), check_errmsg(r'Rec {') ], compile, ['-ddump-simpl']) +test('T9441c', [only_ways(['optasm']), check_errmsg(r'Rec {') ], compile, ['-ddump-simpl']) test('T9583', only_ways(['optasm']), compile, ['']) test('T9565', only_ways(['optasm']), compile, ['']) test('T5821', only_ways(['optasm']), compile, ['']) From git at git.haskell.org Mon Aug 20 09:07:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Aug 2018 09:07:49 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T13064' created Message-ID: <20180820090749.472213A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T13064 Referencing: c599fb49f255a0f382a61689f9478b65d5cd2edf From git at git.haskell.org Mon Aug 20 09:07:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Aug 2018 09:07:52 +0000 (UTC) Subject: [commit: ghc] wip/T13064: Comments only (cf79c32) Message-ID: <20180820090752.1B9EF3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13064 Link : http://ghc.haskell.org/trac/ghc/changeset/cf79c32de51ab037df57b7b63e09734fc14c51db/ghc >--------------------------------------------------------------- commit cf79c32de51ab037df57b7b63e09734fc14c51db Author: Simon Peyton Jones Date: Mon Aug 20 09:50:31 2018 +0100 Comments only >--------------------------------------------------------------- cf79c32de51ab037df57b7b63e09734fc14c51db compiler/typecheck/TcType.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 898a0f2..ac3bbf2 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -2072,7 +2072,7 @@ mkMinimalBySCs :: forall a. (a -> PredType) -> [a] -> [a] -- - can be deduced from another by superclasses, -- -- - are a reflexive equality (e.g * ~ *) --- (see Note [Remove redundant provided dicts] in PatSyn) +-- (see Note [Remove redundant provided dicts] in TcPatSyn) -- -- The result is a subset of the input. -- The 'a' is just paired up with the PredType; @@ -2094,7 +2094,8 @@ mkMinimalBySCs get_pred xs = go preds_with_scs [] -- order as the input, which is generally saner go (work_item@(p,_,_) : work_list) min_preds | EqPred _ t1 t2 <- classifyPredType p - , t1 `tcEqType` t2 -- See Note [Discard reflexive equalities] + , t1 `tcEqType` t2 -- See TcPatSyn + -- Note [Remove redundant provided dicts] = go work_list min_preds | p `in_cloud` work_list || p `in_cloud` min_preds = go work_list min_preds From git at git.haskell.org Mon Aug 20 09:07:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Aug 2018 09:07:55 +0000 (UTC) Subject: [commit: ghc] wip/T13064: Fix unused-import warnings (9bcc2ba) Message-ID: <20180820090755.E1BDA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13064 Link : http://ghc.haskell.org/trac/ghc/changeset/9bcc2bab3d84a77dc544acac6000d7f4e8b68033/ghc >--------------------------------------------------------------- commit 9bcc2bab3d84a77dc544acac6000d7f4e8b68033 Author: Simon Peyton Jones Date: Mon Aug 20 09:48:41 2018 +0100 Fix unused-import warnings This patch fixes a fairly long-standing bug (dating back to 2015) in RdrName.bestImport, namely commit 9376249b6b78610db055a10d05f6592d6bbbea2f Author: Simon Peyton Jones Date: Wed Oct 28 17:16:55 2015 +0000 Fix unused-import stuff in a better way In that patch got the sense of the comparison back to front, and thereby failed to implement the unused-import rules described in Note [Choosing the best import declaration] in RdrName This led to Trac #13064 and #15393 Fixing this bug revealed a bunch of unused imports in libraries; the ones in the GHC repo are part of this commit. The two important changes are * Fix the bug in bestImport * Modified the rules by adding (a) in Note [Choosing the best import declaration] in RdrName Reason: the previosu rules made Trac #5211 go bad again. And the new rule (a) makes sense to me. In unravalling this I also ended up doing a few other things * Refactor RnNames.ImportDeclUsage to use a [GlobalRdrElt] for the things that are used, rather than [AvailInfo]. This is simpler and more direct. * Rename greParentName to greParent_maybe, to follow GHC naming conventions * Delete dead code RdrName.greUsedRdrName * Slightly change the spec of the unused function HsImpExpr.ieLWrappedName, and use it in RnNames.findImportUsage >--------------------------------------------------------------- 9bcc2bab3d84a77dc544acac6000d7f4e8b68033 compiler/basicTypes/RdrName.hs | 102 ++++++--- compiler/hsSyn/HsImpExp.hs | 4 +- compiler/main/Ar.hs | 1 - compiler/main/DynamicLoading.hs | 5 +- compiler/main/GHC.hs | 2 - compiler/main/HscMain.hs | 1 - compiler/parser/RdrHsSyn.hs | 1 - compiler/rename/RnEnv.hs | 19 +- compiler/rename/RnNames.hs | 231 +++++++++++---------- compiler/typecheck/ClsInst.hs | 1 - compiler/typecheck/TcDeriv.hs | 2 +- compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 3 +- compiler/typecheck/TcSMonad.hs | 1 - libraries/base/Data/Functor/Classes.hs | 1 - libraries/base/Data/Functor/Compose.hs | 2 - libraries/base/Data/Functor/Contravariant.hs | 1 - libraries/base/Data/Functor/Product.hs | 3 - libraries/base/Data/Functor/Sum.hs | 2 - libraries/base/Data/Semigroup.hs | 3 - libraries/base/GHC/Event/PSQ.hs | 1 - libraries/base/GHC/Generics.hs | 2 +- libraries/base/GHC/Show.hs | 1 - libraries/base/GHC/StaticPtr.hs | 1 - libraries/ghc-prim/GHC/Magic.hs | 2 +- testsuite/tests/module/mod177.stderr | 2 +- .../ghci/duplicaterecfldsghci01.stdout | 18 +- testsuite/tests/rename/should_compile/T13064.hs | 8 + .../tests/rename/should_compile/T13064.stderr | 3 + testsuite/tests/rename/should_compile/T4239.stdout | 2 +- testsuite/tests/rename/should_compile/all.T | 1 + .../tests/rename/should_fail/rnfail044.stderr | 9 +- 32 files changed, 247 insertions(+), 190 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 9bcc2bab3d84a77dc544acac6000d7f4e8b68033 From git at git.haskell.org Mon Aug 20 09:07:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Aug 2018 09:07:59 +0000 (UTC) Subject: [commit: ghc] wip/T13064: Improve ambiguous-occurrence error message (c599fb4) Message-ID: <20180820090759.A00EA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13064 Link : http://ghc.haskell.org/trac/ghc/changeset/c599fb49f255a0f382a61689f9478b65d5cd2edf/ghc >--------------------------------------------------------------- commit c599fb49f255a0f382a61689f9478b65d5cd2edf Author: Simon Peyton Jones Date: Mon Aug 20 10:01:16 2018 +0100 Improve ambiguous-occurrence error message Trac #15487 correctly reported that the qualification of a Name in an ambiguous-occurrence error message was wrong. This patch fixes it. It's easily done, in RnUtils.addNameClashErrRn The problem was that in complaining about M.x we must enusre that 'M' part is the same as that used in pprNameProvenance. >--------------------------------------------------------------- c599fb49f255a0f382a61689f9478b65d5cd2edf compiler/rename/RnUtils.hs | 40 +++++++++++++++++++----- testsuite/tests/rename/should_fail/T15487.hs | 7 +++++ testsuite/tests/rename/should_fail/T15487.stderr | 8 +++++ testsuite/tests/rename/should_fail/T15487a.hs | 1 + testsuite/tests/rename/should_fail/all.T | 1 + 5 files changed, 49 insertions(+), 8 deletions(-) diff --git a/compiler/rename/RnUtils.hs b/compiler/rename/RnUtils.hs index 99272c2..0451e28 100644 --- a/compiler/rename/RnUtils.hs +++ b/compiler/rename/RnUtils.hs @@ -295,16 +295,40 @@ addNameClashErrRn rdr_name gres -- If there are two or more *local* defns, we'll have reported = return () -- that already, and we don't want an error cascade | otherwise - = addErr (vcat [text "Ambiguous occurrence" <+> quotes (ppr rdr_name), - text "It could refer to" <+> vcat (msg1 : msgs)]) + = addErr (vcat [ text "Ambiguous occurrence" <+> quotes (ppr rdr_name) + , text "It could refer to" + , nest 3 (vcat (msg1 : msgs)) ]) where (np1:nps) = gres - msg1 = ptext (sLit "either") <+> mk_ref np1 - msgs = [text " or" <+> mk_ref np | np <- nps] - mk_ref gre = sep [nom <> comma, pprNameProvenance gre] - where nom = case gre_par gre of - FldParent { par_lbl = Just lbl } -> text "the field" <+> quotes (ppr lbl) - _ -> quotes (ppr (gre_name gre)) + msg1 = text "either" <+> ppr_gre np1 + msgs = [text " or" <+> ppr_gre np | np <- nps] + ppr_gre gre = sep [ pp_gre_name gre <> comma + , pprNameProvenance gre] + + -- When printing the name, take care to qualify it in the same + -- way as the provenance reported by pprNameProvenance, namely + -- the head of 'gre_imp'. Otherwise we get confusing reports like + -- Ambiguous occurrence ‘null’ + -- It could refer to either ‘T15487a.null’, + -- imported from ‘Prelude’ at T15487.hs:1:8-13 + -- or ... + -- See Trac #15487 + pp_gre_name gre@(GRE { gre_name = name, gre_par = parent + , gre_lcl = lcl, gre_imp = iss }) + | FldParent { par_lbl = Just lbl } <- parent + = text "the field" <+> quotes (ppr lbl) + | otherwise + = quotes (pp_qual <> dot <> ppr (nameOccName name)) + where + pp_qual | lcl + = ppr (nameModule name) + | imp : _ <- iss -- This 'imp' is the one that + -- pprNameProvenance chooses + , ImpDeclSpec { is_as = mod } <- is_decl imp + = ppr mod + | otherwise + = pprPanic "addNameClassErrRn" (ppr gre $$ ppr iss) + -- Invariant: either 'lcl' is True or 'iss' is non-empty shadowedNameWarn :: OccName -> [SDoc] -> SDoc shadowedNameWarn occ shadowed_locs diff --git a/testsuite/tests/rename/should_fail/T15487.hs b/testsuite/tests/rename/should_fail/T15487.hs new file mode 100644 index 0000000..62e69e3 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15487.hs @@ -0,0 +1,7 @@ +module T15487 where + +import qualified T15487a + +null = 42 + +foo x = null diff --git a/testsuite/tests/rename/should_fail/T15487.stderr b/testsuite/tests/rename/should_fail/T15487.stderr new file mode 100644 index 0000000..bb25939 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15487.stderr @@ -0,0 +1,8 @@ + +T15487.hs:7:9: error: + Ambiguous occurrence ‘null’ + It could refer to + either ‘Prelude.null’, + imported from ‘Prelude’ at T15487.hs:1:8-13 + (and originally defined in ‘Data.Foldable’) + or ‘T15487.null’, defined at T15487.hs:5:1 diff --git a/testsuite/tests/rename/should_fail/T15487a.hs b/testsuite/tests/rename/should_fail/T15487a.hs new file mode 100644 index 0000000..e8687ee --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15487a.hs @@ -0,0 +1 @@ +module T15487a (null) where diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index 413b24f..2da8689 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -131,3 +131,4 @@ test('T13847', normal, multimod_compile_fail, ['T13847','-v0']) test('T14307', normal, compile_fail, ['']) test('T14591', normal, compile_fail, ['']) test('T15214', normal, compile_fail, ['']) +test('T15487', normal, multimod_compile_fail, ['T15487','-v0']) From git at git.haskell.org Mon Aug 20 09:51:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Aug 2018 09:51:13 +0000 (UTC) Subject: [commit: ghc] wip/t-12758_circleci_push_perf_notes: testsuite: Save performance metrics in git notes. (1bc1ad5) Message-ID: <20180820095113.358293A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/t-12758_circleci_push_perf_notes Link : http://ghc.haskell.org/trac/ghc/changeset/1bc1ad50891a5ec6983c16f531aff2b8c1ed04fa/ghc >--------------------------------------------------------------- commit 1bc1ad50891a5ec6983c16f531aff2b8c1ed04fa Author: David Eichmann Date: Wed Aug 8 11:35:44 2018 +0100 testsuite: Save performance metrics in git notes. Summary: Can now load up git note data into the python test driver. Reviewers: bgamari Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5059 GHC Trac Issues: #12758 >--------------------------------------------------------------- 1bc1ad50891a5ec6983c16f531aff2b8c1ed04fa .circleci/config.yml | 45 +- libraries/base/tests/all.T | 18 +- testsuite/driver/README.md | 161 ++++ testsuite/driver/perf_notes.py | 262 ++++++ testsuite/driver/runtests.py | 34 +- testsuite/driver/testglobals.py | 13 +- testsuite/driver/testlib.py | 211 +++-- testsuite/driver/testutil.py | 6 + testsuite/mk/test.mk | 8 + testsuite/tests/callarity/perf/all.T | 12 +- testsuite/tests/deriving/perf/all.T | 11 +- testsuite/tests/perf/compiler/all.T | 1051 ++---------------------- testsuite/tests/perf/haddock/all.T | 183 +---- testsuite/tests/perf/join_points/all.T | 16 +- testsuite/tests/perf/should_run/all.T | 355 ++------ testsuite/tests/perf/space_leaks/all.T | 75 +- testsuite/tests/pmcheck/should_compile/all.T | 27 +- testsuite/tests/primops/should_run/all.T | 6 +- testsuite/tests/simplCore/should_compile/all.T | 3 +- testsuite/tests/simplStg/should_run/all.T | 5 +- 20 files changed, 801 insertions(+), 1701 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 1bc1ad50891a5ec6983c16f531aff2b8c1ed04fa From git at git.haskell.org Mon Aug 20 13:22:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Aug 2018 13:22:21 +0000 (UTC) Subject: [commit: ghc] wip/T13064: Fix unused-import warnings (2dcebe6) Message-ID: <20180820132221.7EF153A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13064 Link : http://ghc.haskell.org/trac/ghc/changeset/2dcebe69f07f9b4328bc3dc2131ccf2953ffa21b/ghc >--------------------------------------------------------------- commit 2dcebe69f07f9b4328bc3dc2131ccf2953ffa21b Author: Simon Peyton Jones Date: Mon Aug 20 09:48:41 2018 +0100 Fix unused-import warnings This patch fixes a fairly long-standing bug (dating back to 2015) in RdrName.bestImport, namely commit 9376249b6b78610db055a10d05f6592d6bbbea2f Author: Simon Peyton Jones Date: Wed Oct 28 17:16:55 2015 +0000 Fix unused-import stuff in a better way In that patch got the sense of the comparison back to front, and thereby failed to implement the unused-import rules described in Note [Choosing the best import declaration] in RdrName This led to Trac #13064 and #15393 Fixing this bug revealed a bunch of unused imports in libraries; the ones in the GHC repo are part of this commit. The two important changes are * Fix the bug in bestImport * Modified the rules by adding (a) in Note [Choosing the best import declaration] in RdrName Reason: the previosu rules made Trac #5211 go bad again. And the new rule (a) makes sense to me. In unravalling this I also ended up doing a few other things * Refactor RnNames.ImportDeclUsage to use a [GlobalRdrElt] for the things that are used, rather than [AvailInfo]. This is simpler and more direct. * Rename greParentName to greParent_maybe, to follow GHC naming conventions * Delete dead code RdrName.greUsedRdrName * Slightly change the spec of the unused function HsImpExpr.ieLWrappedName, and use it in RnNames.findImportUsage >--------------------------------------------------------------- 2dcebe69f07f9b4328bc3dc2131ccf2953ffa21b compiler/basicTypes/RdrName.hs | 102 ++++++--- compiler/cmm/CmmSink.hs | 1 - compiler/codeGen/StgCmmProf.hs | 1 - compiler/ghci/ByteCodeLink.hs | 1 - compiler/ghci/RtClosureInspect.hs | 1 - compiler/hsSyn/Convert.hs | 1 - compiler/hsSyn/HsBinds.hs | 1 - compiler/hsSyn/HsImpExp.hs | 4 +- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 1 - compiler/main/Ar.hs | 1 - compiler/main/DynFlags.hs | 2 + compiler/main/DynamicLoading.hs | 5 +- compiler/main/GHC.hs | 2 - compiler/main/HscMain.hs | 1 - compiler/main/Packages.hs | 1 - compiler/parser/RdrHsSyn.hs | 1 - compiler/rename/RnEnv.hs | 19 +- compiler/rename/RnExpr.hs-boot | 1 - compiler/rename/RnNames.hs | 231 +++++++++++---------- compiler/specialise/Specialise.hs | 1 - compiler/typecheck/ClsInst.hs | 2 - compiler/typecheck/TcDeriv.hs | 2 +- compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 1 - compiler/typecheck/TcInstDcls.hs-boot | 1 - compiler/typecheck/TcInteract.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 3 +- compiler/typecheck/TcRnTypes.hs | 3 +- compiler/typecheck/TcSMonad.hs | 1 - compiler/typecheck/TcTypeable.hs | 1 - compiler/types/TyCon.hs | 3 +- compiler/utils/OrdList.hs | 1 - compiler/utils/Outputable.hs | 1 - ghc/GHCi/Leak.hs | 2 +- libraries/base/Data/Functor/Classes.hs | 1 - libraries/base/Data/Functor/Compose.hs | 2 - libraries/base/Data/Functor/Contravariant.hs | 1 - libraries/base/Data/Functor/Product.hs | 3 - libraries/base/Data/Functor/Sum.hs | 2 - libraries/base/Data/Semigroup.hs | 3 - libraries/base/GHC/Event/PSQ.hs | 1 - libraries/base/GHC/Generics.hs | 2 +- libraries/base/GHC/Show.hs | 1 - libraries/base/GHC/StaticPtr.hs | 1 - libraries/ghc-prim/GHC/Magic.hs | 2 +- testsuite/tests/module/mod177.stderr | 2 +- .../ghci/duplicaterecfldsghci01.stdout | 18 +- testsuite/tests/rename/should_compile/T13064.hs | 8 + .../tests/rename/should_compile/T13064.stderr | 3 + testsuite/tests/rename/should_compile/T4239.stdout | 2 +- testsuite/tests/rename/should_compile/all.T | 1 + .../tests/rename/should_fail/rnfail044.stderr | 9 +- 52 files changed, 253 insertions(+), 212 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2dcebe69f07f9b4328bc3dc2131ccf2953ffa21b From git at git.haskell.org Mon Aug 20 13:22:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Aug 2018 13:22:24 +0000 (UTC) Subject: [commit: ghc] wip/T13064: Comments only (43c87f6) Message-ID: <20180820132224.5CAC93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13064 Link : http://ghc.haskell.org/trac/ghc/changeset/43c87f61854ef553cc22f642c39d1d51ce51239f/ghc >--------------------------------------------------------------- commit 43c87f61854ef553cc22f642c39d1d51ce51239f Author: Simon Peyton Jones Date: Mon Aug 20 09:50:31 2018 +0100 Comments only >--------------------------------------------------------------- 43c87f61854ef553cc22f642c39d1d51ce51239f compiler/typecheck/TcType.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 898a0f2..ac3bbf2 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -2072,7 +2072,7 @@ mkMinimalBySCs :: forall a. (a -> PredType) -> [a] -> [a] -- - can be deduced from another by superclasses, -- -- - are a reflexive equality (e.g * ~ *) --- (see Note [Remove redundant provided dicts] in PatSyn) +-- (see Note [Remove redundant provided dicts] in TcPatSyn) -- -- The result is a subset of the input. -- The 'a' is just paired up with the PredType; @@ -2094,7 +2094,8 @@ mkMinimalBySCs get_pred xs = go preds_with_scs [] -- order as the input, which is generally saner go (work_item@(p,_,_) : work_list) min_preds | EqPred _ t1 t2 <- classifyPredType p - , t1 `tcEqType` t2 -- See Note [Discard reflexive equalities] + , t1 `tcEqType` t2 -- See TcPatSyn + -- Note [Remove redundant provided dicts] = go work_list min_preds | p `in_cloud` work_list || p `in_cloud` min_preds = go work_list min_preds From git at git.haskell.org Mon Aug 20 13:22:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Aug 2018 13:22:28 +0000 (UTC) Subject: [commit: ghc] wip/T13064: Improve ambiguous-occurrence error message (69e3700) Message-ID: <20180820132228.242A73A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13064 Link : http://ghc.haskell.org/trac/ghc/changeset/69e370049a3cde1a9c635142601b949d2a3c7062/ghc >--------------------------------------------------------------- commit 69e370049a3cde1a9c635142601b949d2a3c7062 Author: Simon Peyton Jones Date: Mon Aug 20 10:01:16 2018 +0100 Improve ambiguous-occurrence error message Trac #15487 correctly reported that the qualification of a Name in an ambiguous-occurrence error message was wrong. This patch fixes it. It's easily done, in RnUtils.addNameClashErrRn The problem was that in complaining about M.x we must enusre that 'M' part is the same as that used in pprNameProvenance. >--------------------------------------------------------------- 69e370049a3cde1a9c635142601b949d2a3c7062 compiler/rename/RnUtils.hs | 40 +++++++++++++++++++----- testsuite/tests/rename/should_fail/T15487.hs | 7 +++++ testsuite/tests/rename/should_fail/T15487.stderr | 8 +++++ testsuite/tests/rename/should_fail/T15487a.hs | 1 + testsuite/tests/rename/should_fail/all.T | 1 + 5 files changed, 49 insertions(+), 8 deletions(-) diff --git a/compiler/rename/RnUtils.hs b/compiler/rename/RnUtils.hs index 99272c2..0451e28 100644 --- a/compiler/rename/RnUtils.hs +++ b/compiler/rename/RnUtils.hs @@ -295,16 +295,40 @@ addNameClashErrRn rdr_name gres -- If there are two or more *local* defns, we'll have reported = return () -- that already, and we don't want an error cascade | otherwise - = addErr (vcat [text "Ambiguous occurrence" <+> quotes (ppr rdr_name), - text "It could refer to" <+> vcat (msg1 : msgs)]) + = addErr (vcat [ text "Ambiguous occurrence" <+> quotes (ppr rdr_name) + , text "It could refer to" + , nest 3 (vcat (msg1 : msgs)) ]) where (np1:nps) = gres - msg1 = ptext (sLit "either") <+> mk_ref np1 - msgs = [text " or" <+> mk_ref np | np <- nps] - mk_ref gre = sep [nom <> comma, pprNameProvenance gre] - where nom = case gre_par gre of - FldParent { par_lbl = Just lbl } -> text "the field" <+> quotes (ppr lbl) - _ -> quotes (ppr (gre_name gre)) + msg1 = text "either" <+> ppr_gre np1 + msgs = [text " or" <+> ppr_gre np | np <- nps] + ppr_gre gre = sep [ pp_gre_name gre <> comma + , pprNameProvenance gre] + + -- When printing the name, take care to qualify it in the same + -- way as the provenance reported by pprNameProvenance, namely + -- the head of 'gre_imp'. Otherwise we get confusing reports like + -- Ambiguous occurrence ‘null’ + -- It could refer to either ‘T15487a.null’, + -- imported from ‘Prelude’ at T15487.hs:1:8-13 + -- or ... + -- See Trac #15487 + pp_gre_name gre@(GRE { gre_name = name, gre_par = parent + , gre_lcl = lcl, gre_imp = iss }) + | FldParent { par_lbl = Just lbl } <- parent + = text "the field" <+> quotes (ppr lbl) + | otherwise + = quotes (pp_qual <> dot <> ppr (nameOccName name)) + where + pp_qual | lcl + = ppr (nameModule name) + | imp : _ <- iss -- This 'imp' is the one that + -- pprNameProvenance chooses + , ImpDeclSpec { is_as = mod } <- is_decl imp + = ppr mod + | otherwise + = pprPanic "addNameClassErrRn" (ppr gre $$ ppr iss) + -- Invariant: either 'lcl' is True or 'iss' is non-empty shadowedNameWarn :: OccName -> [SDoc] -> SDoc shadowedNameWarn occ shadowed_locs diff --git a/testsuite/tests/rename/should_fail/T15487.hs b/testsuite/tests/rename/should_fail/T15487.hs new file mode 100644 index 0000000..62e69e3 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15487.hs @@ -0,0 +1,7 @@ +module T15487 where + +import qualified T15487a + +null = 42 + +foo x = null diff --git a/testsuite/tests/rename/should_fail/T15487.stderr b/testsuite/tests/rename/should_fail/T15487.stderr new file mode 100644 index 0000000..bb25939 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15487.stderr @@ -0,0 +1,8 @@ + +T15487.hs:7:9: error: + Ambiguous occurrence ‘null’ + It could refer to + either ‘Prelude.null’, + imported from ‘Prelude’ at T15487.hs:1:8-13 + (and originally defined in ‘Data.Foldable’) + or ‘T15487.null’, defined at T15487.hs:5:1 diff --git a/testsuite/tests/rename/should_fail/T15487a.hs b/testsuite/tests/rename/should_fail/T15487a.hs new file mode 100644 index 0000000..e8687ee --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15487a.hs @@ -0,0 +1 @@ +module T15487a (null) where diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index f2bf30e..2a4a093 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -132,3 +132,4 @@ test('T13847', normal, multimod_compile_fail, ['T13847','-v0']) test('T14307', normal, compile_fail, ['']) test('T14591', normal, compile_fail, ['']) test('T15214', normal, compile_fail, ['']) +test('T15487', normal, multimod_compile_fail, ['T15487','-v0']) From git at git.haskell.org Mon Aug 20 13:22:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Aug 2018 13:22:30 +0000 (UTC) Subject: [commit: ghc] wip/T13064's head updated: Improve ambiguous-occurrence error message (69e3700) Message-ID: <20180820132230.3A1263A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T13064' now includes: 63b6a1d Be mindful of GADT tyvar order when desugaring record updates ae68f32 base: rewrite Monoid module docs 2748e95 base: Rewrite semigroup documentation 8154faf Make ghci work for stage1 and Hadrian 1bbb5fa Add comment explaining change in syntax error suggestion for #12146. 8f4df7f Add test cases for Ticket #12146. a08b285 CSE should deal with letrec (#9441) 2dcebe6 Fix unused-import warnings 43c87f6 Comments only 69e3700 Improve ambiguous-occurrence error message From git at git.haskell.org Mon Aug 20 14:56:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Aug 2018 14:56:04 +0000 (UTC) Subject: [commit: ghc] master: Initialise cec_suppress properly (ecc0ddf) Message-ID: <20180820145604.135B53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ecc0ddf65b1e2700f83f643fffdd41e966013332/ghc >--------------------------------------------------------------- commit ecc0ddf65b1e2700f83f643fffdd41e966013332 Author: Simon Peyton Jones Date: Mon Aug 20 15:54:14 2018 +0100 Initialise cec_suppress properly In TcErrors, cec_suppress is used to suppress low-priority errors in favour of truly insoluble ones. But I was failing to initialise it correcly at top level, which resulted in Trac #15539. Easy to fix. A few regression tests have fewer errors reported, but that seems to be an improvement. >--------------------------------------------------------------- ecc0ddf65b1e2700f83f643fffdd41e966013332 compiler/typecheck/TcErrors.hs | 7 ++++- testsuite/tests/ghci/scripts/Defer02.stderr | 31 ---------------------- testsuite/tests/rename/should_fail/T15539.hs | 17 ++++++++++++ testsuite/tests/rename/should_fail/T15539.stderr | 4 +++ testsuite/tests/rename/should_fail/all.T | 1 + .../should_compile/valid_hole_fits.stderr | 30 --------------------- .../tests/typecheck/should_fail/tcfail078.stderr | 13 --------- 7 files changed, 28 insertions(+), 75 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ecc0ddf65b1e2700f83f643fffdd41e966013332 From git at git.haskell.org Mon Aug 20 18:40:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Aug 2018 18:40:31 +0000 (UTC) Subject: [commit: ghc] master: Update .mailmap [skip ci] (d04a152) Message-ID: <20180820184031.9B3743A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d04a152cc5f5ef4bfdc25d1df96013082f5bc497/ghc >--------------------------------------------------------------- commit d04a152cc5f5ef4bfdc25d1df96013082f5bc497 Author: Thomas Miedema Date: Fri Aug 17 22:25:05 2018 +0200 Update .mailmap [skip ci] >--------------------------------------------------------------- d04a152cc5f5ef4bfdc25d1df96013082f5bc497 .mailmap | 73 ++++++++++++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 57 insertions(+), 16 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 d04a152cc5f5ef4bfdc25d1df96013082f5bc497 From git at git.haskell.org Mon Aug 20 19:40:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Aug 2018 19:40:02 +0000 (UTC) Subject: [commit: ghc] master: Bump stm submodule (2671ec5) Message-ID: <20180820194002.EBD133A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2671ec595b8a68d0dcb432834daa330cf21a68b9/ghc >--------------------------------------------------------------- commit 2671ec595b8a68d0dcb432834daa330cf21a68b9 Author: Ben Gamari Date: Mon Aug 20 15:07:12 2018 -0400 Bump stm submodule >--------------------------------------------------------------- 2671ec595b8a68d0dcb432834daa330cf21a68b9 libraries/stm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/stm b/libraries/stm index 4c24db6..4a1deb9 160000 --- a/libraries/stm +++ b/libraries/stm @@ -1 +1 @@ -Subproject commit 4c24db6071fc1319232934562f7dbed45d498831 +Subproject commit 4a1deb98fc95e55d8a6762a7dfec1a7dfa8b49b2 From git at git.haskell.org Tue Aug 21 00:09:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 00:09:42 +0000 (UTC) Subject: [commit: ghc] master: Expose the StableName constructor (9c4e6c6) Message-ID: <20180821000942.189B53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9c4e6c6b1affd410604f8f76ecf56abfcc5cccb6/ghc >--------------------------------------------------------------- commit 9c4e6c6b1affd410604f8f76ecf56abfcc5cccb6 Author: David Feuer Date: Mon Aug 20 20:08:14 2018 -0400 Expose the StableName constructor * Move the definition of `StableName` from `System.Mem.StableName` to a new `GHC.StableName` module. * Expose the `StableName` data constructor from `GHC.StableName`. Once we have `UnliftedArray#`, this will enable `StableName`s to be stored in `UnliftedArray`s (from `primitive`) without unsafe coercions. Reviewers: hvr, bgamari, andrewthad, osa1 Reviewed By: osa1 Subscribers: osa1, rwbarton, carter GHC Trac Issues: #15535 Differential Revision: https://phabricator.haskell.org/D5078 >--------------------------------------------------------------- 9c4e6c6b1affd410604f8f76ecf56abfcc5cccb6 libraries/base/{System/Mem => GHC}/StableName.hs | 4 +- libraries/base/System/Mem/StableName.hs | 75 +----------------------- libraries/base/base.cabal | 1 + 3 files changed, 5 insertions(+), 75 deletions(-) diff --git a/libraries/base/System/Mem/StableName.hs b/libraries/base/GHC/StableName.hs similarity index 98% copy from libraries/base/System/Mem/StableName.hs copy to libraries/base/GHC/StableName.hs index dcd5273..7369f41 100644 --- a/libraries/base/System/Mem/StableName.hs +++ b/libraries/base/GHC/StableName.hs @@ -27,9 +27,9 @@ -- ------------------------------------------------------------------------------- -module System.Mem.StableName ( +module GHC.StableName ( -- * Stable Names - StableName, + StableName (..), makeStableName, hashStableName, eqStableName diff --git a/libraries/base/System/Mem/StableName.hs b/libraries/base/System/Mem/StableName.hs index dcd5273..064d928 100644 --- a/libraries/base/System/Mem/StableName.hs +++ b/libraries/base/System/Mem/StableName.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | @@ -35,72 +32,4 @@ module System.Mem.StableName ( eqStableName ) where -import GHC.IO ( IO(..) ) -import GHC.Base ( Int(..), StableName#, makeStableName# - , eqStableName#, stableNameToInt# ) - ------------------------------------------------------------------------------ --- Stable Names - -{-| - An abstract name for an object, that supports equality and hashing. - - Stable names have the following property: - - * If @sn1 :: StableName@ and @sn2 :: StableName@ and @sn1 == sn2@ - then @sn1@ and @sn2@ were created by calls to @makeStableName@ on - the same object. - - The reverse is not necessarily true: if two stable names are not - equal, then the objects they name may still be equal. Note in particular - that `makeStableName` may return a different `StableName` after an - object is evaluated. - - Stable Names are similar to Stable Pointers ("Foreign.StablePtr"), - but differ in the following ways: - - * There is no @freeStableName@ operation, unlike "Foreign.StablePtr"s. - Stable names are reclaimed by the runtime system when they are no - longer needed. - - * There is no @deRefStableName@ operation. You can\'t get back from - a stable name to the original Haskell object. The reason for - this is that the existence of a stable name for an object does not - guarantee the existence of the object itself; it can still be garbage - collected. --} - -data StableName a = StableName (StableName# a) - --- | Makes a 'StableName' for an arbitrary object. The object passed as --- the first argument is not evaluated by 'makeStableName'. -makeStableName :: a -> IO (StableName a) -makeStableName a = IO $ \ s -> - case makeStableName# a s of (# s', sn #) -> (# s', StableName sn #) - --- | Convert a 'StableName' to an 'Int'. The 'Int' returned is not --- necessarily unique; several 'StableName's may map to the same 'Int' --- (in practice however, the chances of this are small, so the result --- of 'hashStableName' makes a good hash key). -hashStableName :: StableName a -> Int -hashStableName (StableName sn) = I# (stableNameToInt# sn) - --- | @since 2.01 -instance Eq (StableName a) where - (StableName sn1) == (StableName sn2) = - case eqStableName# sn1 sn2 of - 0# -> False - _ -> True - --- | Equality on 'StableName' that does not require that the types of --- the arguments match. --- --- @since 4.7.0.0 -eqStableName :: StableName a -> StableName b -> Bool -eqStableName (StableName sn1) (StableName sn2) = - case eqStableName# sn1 sn2 of - 0# -> False - _ -> True - -- Requested by Emil Axelsson on glasgow-haskell-users, who wants to - -- use it for implementing observable sharing. - +import GHC.StableName diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index dbeec33..f02ff08 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -278,6 +278,7 @@ Library GHC.STRef GHC.Show GHC.Stable + GHC.StableName GHC.Stack GHC.Stack.CCS GHC.Stack.Types From git at git.haskell.org Tue Aug 21 05:39:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 05:39:44 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T15548' created Message-ID: <20180821053944.E3D293A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T15548 Referencing: bee827178f3825356e958adcc9ffbaf5896ef1bd From git at git.haskell.org Tue Aug 21 05:39:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 05:39:47 +0000 (UTC) Subject: [commit: ghc] wip/T15548: Use the same UnitId `integer` for `integer-gmp` and `integer-simple` (b7f19d2) Message-ID: <20180821053947.BD4763A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15548 Link : http://ghc.haskell.org/trac/ghc/changeset/b7f19d21f7946c936c238887d91ece17c95b097a/ghc >--------------------------------------------------------------- commit b7f19d21f7946c936c238887d91ece17c95b097a Author: Joachim Breitner Date: Mon Aug 20 14:44:23 2018 -0700 Use the same UnitId `integer` for `integer-gmp` and `integer-simple` this makes more code in GHC independent of the choice of the integer library, which is beneficial for API users, and is a first step towards fixing #13477. >--------------------------------------------------------------- b7f19d21f7946c936c238887d91ece17c95b097a compiler/basicTypes/Module.hs | 6 +----- compiler/prelude/PrelNames.hs | 18 +++++------------- libraries/integer-gmp/integer-gmp.cabal | 2 +- libraries/integer-simple/integer-simple.cabal | 4 ++-- 4 files changed, 9 insertions(+), 21 deletions(-) diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs index 1851496..9809bc6 100644 --- a/compiler/basicTypes/Module.hs +++ b/compiler/basicTypes/Module.hs @@ -1067,11 +1067,7 @@ integerUnitId, primUnitId, baseUnitId, rtsUnitId, thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId primUnitId = fsToUnitId (fsLit "ghc-prim") -integerUnitId = fsToUnitId (fsLit n) - where - n = case cIntegerLibraryType of - IntegerGMP -> "integer-gmp" - IntegerSimple -> "integer-simple" +integerUnitId = fsToUnitId (fsLit "integer") baseUnitId = fsToUnitId (fsLit "base") rtsUnitId = fsToUnitId (fsLit "rts") thUnitId = fsToUnitId (fsLit "template-haskell") diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 90f1f44..77afca1 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -136,7 +136,6 @@ import Unique import Name import SrcLoc import FastString -import Config ( cIntegerLibraryType, IntegerLibrary(..) ) import Panic ( panic ) {- @@ -355,6 +354,7 @@ basicKnownKeyNames gcdIntegerName, lcmIntegerName, andIntegerName, orIntegerName, xorIntegerName, complementIntegerName, shiftLIntegerName, shiftRIntegerName, bitIntegerName, + integerSDataConName,naturalSDataConName, -- Natural naturalTyConName, @@ -433,9 +433,7 @@ basicKnownKeyNames , typeErrorVAppendDataConName , typeErrorShowTypeDataConName - ] ++ case cIntegerLibraryType of - IntegerGMP -> [integerSDataConName,naturalSDataConName] - IntegerSimple -> [] + ] genericTyConNames :: [Name] genericTyConNames = [ @@ -1117,11 +1115,8 @@ integerTyConName, mkIntegerName, integerSDataConName, gcdIntegerName, lcmIntegerName, andIntegerName, orIntegerName, xorIntegerName, complementIntegerName, shiftLIntegerName, shiftRIntegerName, bitIntegerName :: Name -integerTyConName = tcQual gHC_INTEGER_TYPE (fsLit "Integer") integerTyConKey -integerSDataConName = dcQual gHC_INTEGER_TYPE (fsLit n) integerSDataConKey - where n = case cIntegerLibraryType of - IntegerGMP -> "S#" - IntegerSimple -> panic "integerSDataConName evaluated for integer-simple" +integerTyConName = tcQual gHC_INTEGER_TYPE (fsLit "Integer") integerTyConKey +integerSDataConName = dcQual gHC_INTEGER_TYPE (fsLit "S#") integerSDataConKey mkIntegerName = varQual gHC_INTEGER_TYPE (fsLit "mkInteger") mkIntegerIdKey integerToWord64Name = varQual gHC_INTEGER_TYPE (fsLit "integerToWord64") integerToWord64IdKey integerToInt64Name = varQual gHC_INTEGER_TYPE (fsLit "integerToInt64") integerToInt64IdKey @@ -1168,10 +1163,7 @@ bitIntegerName = varQual gHC_INTEGER_TYPE (fsLit "bitInteger") bit -- GHC.Natural types naturalTyConName, naturalSDataConName :: Name naturalTyConName = tcQual gHC_NATURAL (fsLit "Natural") naturalTyConKey -naturalSDataConName = dcQual gHC_NATURAL (fsLit n) naturalSDataConKey - where n = case cIntegerLibraryType of - IntegerGMP -> "NatS#" - IntegerSimple -> panic "naturalSDataConName evaluated for integer-simple" +naturalSDataConName = dcQual gHC_NATURAL (fsLit "NatS#") naturalSDataConKey naturalFromIntegerName :: Name naturalFromIntegerName = varQual gHC_NATURAL (fsLit "naturalFromInteger") naturalFromIntegerIdKey diff --git a/libraries/integer-gmp/integer-gmp.cabal b/libraries/integer-gmp/integer-gmp.cabal index 5d2f890..e4ecc7a 100644 --- a/libraries/integer-gmp/integer-gmp.cabal +++ b/libraries/integer-gmp/integer-gmp.cabal @@ -60,7 +60,7 @@ library UnliftedFFITypes build-depends: ghc-prim ^>= 0.5.1.0 hs-source-dirs: src/ - ghc-options: -this-unit-id integer-gmp -Wall + ghc-options: -this-unit-id integer -Wall cc-options: -std=c99 -Wall include-dirs: include diff --git a/libraries/integer-simple/integer-simple.cabal b/libraries/integer-simple/integer-simple.cabal index 231619c..e6c83da 100644 --- a/libraries/integer-simple/integer-simple.cabal +++ b/libraries/integer-simple/integer-simple.cabal @@ -26,6 +26,6 @@ Library other-modules: GHC.Integer.Type default-extensions: CPP, MagicHash, BangPatterns, UnboxedTuples, UnliftedFFITypes, NoImplicitPrelude - -- We need to set the unit ID to integer-simple + -- We need to set the unit ID to integer -- (without a version number) as it's magic. - ghc-options: -this-unit-id integer-simple -Wall + ghc-options: -this-unit-id integer -Wall From git at git.haskell.org Tue Aug 21 05:39:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 05:39:50 +0000 (UTC) Subject: [commit: ghc] wip/T15548: Introduce `integerLibrary :: DynFlags -> IntegerLibrary` (db82a5d) Message-ID: <20180821053950.991C13A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15548 Link : http://ghc.haskell.org/trac/ghc/changeset/db82a5dc9e33d3ed94d1328211b33bad65e19e5e/ghc >--------------------------------------------------------------- commit db82a5dc9e33d3ed94d1328211b33bad65e19e5e Author: Joachim Breitner Date: Mon Aug 20 14:51:44 2018 -0700 Introduce `integerLibrary :: DynFlags -> IntegerLibrary` which is initialized via `cIntegerLibraryType`, but can be overriden by an API user. The only place where this is used is in `CorePrep`, to decide whether to use the `S#` constructor. Also removes the unused `cIntegerLibrary`. >--------------------------------------------------------------- db82a5dc9e33d3ed94d1328211b33bad65e19e5e compiler/coreSyn/CorePrep.hs | 4 ++-- compiler/ghc.mk | 2 -- compiler/main/DynFlags.hs | 4 ++++ 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 9c2954d..0349c8c 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -1538,13 +1538,13 @@ lookupMkNaturalName dflags hsc_env lookupGlobal hsc_env mkNaturalName lookupIntegerSDataConName :: DynFlags -> HscEnv -> IO (Maybe DataCon) -lookupIntegerSDataConName dflags hsc_env = case cIntegerLibraryType of +lookupIntegerSDataConName dflags hsc_env = case integerLibrary dflags of IntegerGMP -> guardIntegerUse dflags $ liftM (Just . tyThingDataCon) $ lookupGlobal hsc_env integerSDataConName IntegerSimple -> return Nothing lookupNaturalSDataConName :: DynFlags -> HscEnv -> IO (Maybe DataCon) -lookupNaturalSDataConName dflags hsc_env = case cIntegerLibraryType of +lookupNaturalSDataConName dflags hsc_env = case integerLibrary dflags of IntegerGMP -> guardNaturalUse dflags $ liftM (Just . tyThingDataCon) $ lookupGlobal hsc_env naturalSDataConName IntegerSimple -> return Nothing diff --git a/compiler/ghc.mk b/compiler/ghc.mk index 9bc6b3f..8a4cc43 100644 --- a/compiler/ghc.mk +++ b/compiler/ghc.mk @@ -84,8 +84,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/. @echo 'cBooterVersion = "$(GhcVersion)"' >> $@ @echo 'cStage :: String' >> $@ @echo 'cStage = show (STAGE :: Int)' >> $@ - @echo 'cIntegerLibrary :: String' >> $@ - @echo 'cIntegerLibrary = "$(INTEGER_LIBRARY)"' >> $@ @echo 'cIntegerLibraryType :: IntegerLibrary' >> $@ ifeq "$(INTEGER_LIBRARY)" "integer-gmp" @echo 'cIntegerLibraryType = IntegerGMP' >> $@ diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 66c67c3..61838a0 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -848,6 +848,9 @@ data DynFlags = DynFlags { ghcLink :: GhcLink, hscTarget :: HscTarget, settings :: Settings, + integerLibrary :: IntegerLibrary, + -- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overriden + -- by GHC-API users llvmTargets :: LlvmTargets, llvmPasses :: LlvmPasses, verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] @@ -1753,6 +1756,7 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) = ghcMode = CompManager, ghcLink = LinkBinary, hscTarget = defaultHscTarget (sTargetPlatform mySettings), + integerLibrary = cIntegerLibraryType, verbosity = 0, optLevel = 0, debugLevel = 0, From git at git.haskell.org Tue Aug 21 05:39:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 05:39:53 +0000 (UTC) Subject: [commit: ghc] wip/T15548: Find the `integer` package (either `integer-gmp` or `integer-simple`) (71cff20) Message-ID: <20180821053953.6E8333A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15548 Link : http://ghc.haskell.org/trac/ghc/changeset/71cff209728c3808b754117963645805b75af5f4/ghc >--------------------------------------------------------------- commit 71cff209728c3808b754117963645805b75af5f4 Author: Joachim Breitner Date: Mon Aug 20 16:00:15 2018 -0700 Find the `integer` package (either `integer-gmp` or `integer-simple`) >--------------------------------------------------------------- 71cff209728c3808b754117963645805b75af5f4 compiler/main/Packages.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 71354b1..9fa5a95 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -975,6 +975,8 @@ findWiredInPackages dflags prec_map pkgs vis_map = do -- let matches :: PackageConfig -> String -> Bool + pc `matches` "integer" + = packageNameString pc `elem` ["integer-gmp", "integer-simple"] pc `matches` pid = packageNameString pc == pid -- find which package corresponds to each wired-in package From git at git.haskell.org Tue Aug 21 05:39:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 05:39:56 +0000 (UTC) Subject: [commit: ghc] wip/T15548: Update findWiredInPackages to handle new integer unit name (6c3076c) Message-ID: <20180821053956.418AA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15548 Link : http://ghc.haskell.org/trac/ghc/changeset/6c3076c5e53c2744af9592ca8734f3931c306105/ghc >--------------------------------------------------------------- commit 6c3076c5e53c2744af9592ca8734f3931c306105 Author: Joachim Breitner Date: Mon Aug 20 16:33:34 2018 -0700 Update findWiredInPackages to handle new integer unit name The code is more robust now; previously it was assuming in multiple spots that the wired-in unit name is always equal to the package name; now this assumption only made in the `matches` function, with special-case for `integer`. >--------------------------------------------------------------- 6c3076c5e53c2744af9592ca8734f3931c306105 compiler/main/Packages.hs | 33 ++++++++++++++++----------------- 1 file changed, 16 insertions(+), 17 deletions(-) diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 9fa5a95..20f3700 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -954,11 +954,12 @@ pprTrustFlag flag = case flag of -- ----------------------------------------------------------------------------- -- Wired-in packages -wired_in_pkgids :: [String] -wired_in_pkgids = map unitIdString wiredInUnitIds - +type WiredInUnitId = String type WiredPackagesMap = Map WiredUnitId WiredUnitId +wired_in_pkgids :: [WiredInUnitId] +wired_in_pkgids = map unitIdString wiredInUnitIds + findWiredInPackages :: DynFlags -> PackagePrecedenceIndex @@ -974,7 +975,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do -- their canonical names (eg. base-1.0 ==> base). -- let - matches :: PackageConfig -> String -> Bool + matches :: PackageConfig -> WiredInUnitId -> Bool pc `matches` "integer" = packageNameString pc `elem` ["integer-gmp", "integer-simple"] pc `matches` pid = packageNameString pc == pid @@ -996,8 +997,8 @@ findWiredInPackages dflags prec_map pkgs vis_map = do -- this works even when there is no exposed wired in package -- available. -- - findWiredInPackage :: [PackageConfig] -> String - -> IO (Maybe PackageConfig) + findWiredInPackage :: [PackageConfig] -> WiredInUnitId + -> IO (Maybe (WiredInUnitId, PackageConfig)) findWiredInPackage pkgs wired_pkg = let all_ps = [ p | p <- pkgs, p `matches` wired_pkg ] all_exposed_ps = @@ -1016,20 +1017,19 @@ findWiredInPackages dflags prec_map pkgs vis_map = do <> text " not found." return Nothing pick :: PackageConfig - -> IO (Maybe PackageConfig) + -> IO (Maybe (WiredInUnitId, PackageConfig)) pick pkg = do debugTraceMsg dflags 2 $ text "wired-in package " <> text wired_pkg <> text " mapped to " <> ppr (unitId pkg) - return (Just pkg) + return (Just (wired_pkg, pkg)) mb_wired_in_pkgs <- mapM (findWiredInPackage pkgs) wired_in_pkgids let wired_in_pkgs = catMaybes mb_wired_in_pkgs - wired_in_ids = mapMaybe definitePackageConfigId wired_in_pkgs -- this is old: we used to assume that if there were -- multiple versions of wired-in packages installed that @@ -1045,18 +1045,17 @@ findWiredInPackages dflags prec_map pkgs vis_map = do -} wiredInMap :: Map WiredUnitId WiredUnitId - wiredInMap = foldl' add_mapping Map.empty pkgs - where add_mapping m pkg - | Just key <- definitePackageConfigId pkg - , key `elem` wired_in_ids - = Map.insert key (DefUnitId (stringToInstalledUnitId (packageNameString pkg))) m - | otherwise = m + wiredInMap = Map.fromList + [ (key, DefUnitId (stringToInstalledUnitId wiredInUnitId)) + | (wiredInUnitId, pkg) <- wired_in_pkgs + , Just key <- pure $ definitePackageConfigId pkg + ] updateWiredInDependencies pkgs = map (upd_deps . upd_pkg) pkgs where upd_pkg pkg | Just def_uid <- definitePackageConfigId pkg - , def_uid `elem` wired_in_ids - = let PackageName fs = packageName pkg + , Just wiredInUnitId <- Map.lookup def_uid wiredInMap + = let fs = installedUnitIdFS (unDefUnitId wiredInUnitId) in pkg { unitId = fsToInstalledUnitId fs, componentId = ComponentId fs From git at git.haskell.org Tue Aug 21 05:39:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 05:39:59 +0000 (UTC) Subject: [commit: ghc] wip/T15548: Unused import (2eca3a4) Message-ID: <20180821053959.17DCA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15548 Link : http://ghc.haskell.org/trac/ghc/changeset/2eca3a40d0a72cace6fdbba2fa59c83f1591d917/ghc >--------------------------------------------------------------- commit 2eca3a40d0a72cace6fdbba2fa59c83f1591d917 Author: Joachim Breitner Date: Mon Aug 20 17:28:49 2018 -0700 Unused import >--------------------------------------------------------------- 2eca3a40d0a72cace6fdbba2fa59c83f1591d917 compiler/basicTypes/Module.hs | 1 - compiler/prelude/PrelNames.hs | 1 - 2 files changed, 2 deletions(-) diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs index 9809bc6..44f841d 100644 --- a/compiler/basicTypes/Module.hs +++ b/compiler/basicTypes/Module.hs @@ -137,7 +137,6 @@ module Module import GhcPrelude -import Config import Outputable import Unique import UniqFM diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 77afca1..be468c0 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -136,7 +136,6 @@ import Unique import Name import SrcLoc import FastString -import Panic ( panic ) {- ************************************************************************ From git at git.haskell.org Tue Aug 21 05:40:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 05:40:01 +0000 (UTC) Subject: [commit: ghc] wip/T15548: Make tablesNextToCode a proper dynamic flag (#15548) (bee8271) Message-ID: <20180821054001.F06853A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15548 Link : http://ghc.haskell.org/trac/ghc/changeset/bee827178f3825356e958adcc9ffbaf5896ef1bd/ghc >--------------------------------------------------------------- commit bee827178f3825356e958adcc9ffbaf5896ef1bd Author: Joachim Breitner Date: Mon Aug 20 21:29:42 2018 -0700 Make tablesNextToCode a proper dynamic flag (#15548) There is no more use of the TABLES_NEXT_TO_CODE CPP macro in `compiler/`. The default value of `tablesNextToCode` is calculated as before, but now users of the GHCI API can modify this flag. >--------------------------------------------------------------- bee827178f3825356e958adcc9ffbaf5896ef1bd compiler/ghc.mk | 8 -------- compiler/ghci/ByteCodeItbls.hs | 4 +++- compiler/main/DynFlags.hs | 8 +++----- compiler/utils/Util.hs | 8 -------- libraries/ghci/GHCi/InfoTable.hsc | 30 ++++++++++++------------------ libraries/ghci/GHCi/Message.hs | 7 ++++--- libraries/ghci/GHCi/Run.hs | 4 ++-- 7 files changed, 24 insertions(+), 45 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 bee827178f3825356e958adcc9ffbaf5896ef1bd From git at git.haskell.org Tue Aug 21 06:27:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 06:27:51 +0000 (UTC) Subject: [commit: ghc] wip/T15548: Actually make it compile (4d8fd08) Message-ID: <20180821062751.8E25C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15548 Link : http://ghc.haskell.org/trac/ghc/changeset/4d8fd08625c9af458f66e033fbc808c942d37633/ghc >--------------------------------------------------------------- commit 4d8fd08625c9af458f66e033fbc808c942d37633 Author: Joachim Breitner Date: Mon Aug 20 23:22:16 2018 -0700 Actually make it compile >--------------------------------------------------------------- 4d8fd08625c9af458f66e033fbc808c942d37633 compiler/ghci/ByteCodeItbls.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/ghci/ByteCodeItbls.hs b/compiler/ghci/ByteCodeItbls.hs index 0aff25f..c17f213 100644 --- a/compiler/ghci/ByteCodeItbls.hs +++ b/compiler/ghci/ByteCodeItbls.hs @@ -73,6 +73,6 @@ make_constr_itbls hsc_env cons = tables_next_to_code = tablesNextToCode dflags - r <- iservCmd hsc_env (MkConInfoTable tablesNextToCode ptrs' nptrs_really + r <- iservCmd hsc_env (MkConInfoTable tables_next_to_code ptrs' nptrs_really conNo (tagForCon dflags dcon) descr) return (getName dcon, ItblPtr r) From git at git.haskell.org Tue Aug 21 16:12:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 16:12:15 +0000 (UTC) Subject: [commit: ghc] master: Set strictness correctly for JoinIds (ce6ce78) Message-ID: <20180821161215.C838E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ce6ce788251b6102f5c1b878ffec53ba7ad678b5/ghc >--------------------------------------------------------------- commit ce6ce788251b6102f5c1b878ffec53ba7ad678b5 Author: Simon Peyton Jones Date: Tue Aug 21 09:56:39 2018 +0100 Set strictness correctly for JoinIds We were failing to keep correct strictness info when eta-expanding join points; Trac #15517. The situation was something like \q v eta -> let j x = error "blah -- STR Lx bottoming! in case y of A -> j x eta B -> blah C -> j x eta So we spot j as a join point and eta-expand it. But we must also adjust the stricness info, else it vlaimes to bottom after one arg is applied but now it has become two. I fixed this in two places: - In CoreOpt.joinPointBinding_maybe, adjust strictness info - In SimplUtils.tryEtaExpandRhs, return consistent values for arity and bottom-ness >--------------------------------------------------------------- ce6ce788251b6102f5c1b878ffec53ba7ad678b5 compiler/basicTypes/Demand.hs | 21 ++++- compiler/coreSyn/CoreOpt.hs | 28 ++++++- compiler/simplCore/SimplUtils.hs | 9 +- testsuite/tests/simplCore/should_compile/T15517.hs | 10 +++ .../tests/simplCore/should_compile/T15517a.hs | 96 ++++++++++++++++++++++ testsuite/tests/simplCore/should_compile/all.T | 4 +- 6 files changed, 160 insertions(+), 8 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 ce6ce788251b6102f5c1b878ffec53ba7ad678b5 From git at git.haskell.org Tue Aug 21 16:12:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 16:12:19 +0000 (UTC) Subject: [commit: ghc] master: Improve ambiguous-occurrence error message (18c302c) Message-ID: <20180821161219.84A3E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/18c302cb3802e485e0837538d7d09e1ac21c3ee2/ghc >--------------------------------------------------------------- commit 18c302cb3802e485e0837538d7d09e1ac21c3ee2 Author: Simon Peyton Jones Date: Mon Aug 20 10:01:16 2018 +0100 Improve ambiguous-occurrence error message Trac #15487 correctly reported that the qualification of a Name in an ambiguous-occurrence error message was wrong. This patch fixes it. It's easily done, in RnUtils.addNameClashErrRn The problem was that in complaining about M.x we must enusre that 'M' part is the same as that used in pprNameProvenance. >--------------------------------------------------------------- 18c302cb3802e485e0837538d7d09e1ac21c3ee2 compiler/rename/RnUtils.hs | 40 +++++++++++++++++----- .../ghci/duplicaterecfldsghci01.stdout | 18 +++++----- testsuite/tests/rename/should_fail/T15487.hs | 7 ++++ testsuite/tests/rename/should_fail/T15487.stderr | 8 +++++ testsuite/tests/rename/should_fail/T15487a.hs | 1 + testsuite/tests/rename/should_fail/all.T | 2 ++ .../tests/rename/should_fail/rnfail044.stderr | 9 ++--- 7 files changed, 64 insertions(+), 21 deletions(-) diff --git a/compiler/rename/RnUtils.hs b/compiler/rename/RnUtils.hs index 99272c2..0451e28 100644 --- a/compiler/rename/RnUtils.hs +++ b/compiler/rename/RnUtils.hs @@ -295,16 +295,40 @@ addNameClashErrRn rdr_name gres -- If there are two or more *local* defns, we'll have reported = return () -- that already, and we don't want an error cascade | otherwise - = addErr (vcat [text "Ambiguous occurrence" <+> quotes (ppr rdr_name), - text "It could refer to" <+> vcat (msg1 : msgs)]) + = addErr (vcat [ text "Ambiguous occurrence" <+> quotes (ppr rdr_name) + , text "It could refer to" + , nest 3 (vcat (msg1 : msgs)) ]) where (np1:nps) = gres - msg1 = ptext (sLit "either") <+> mk_ref np1 - msgs = [text " or" <+> mk_ref np | np <- nps] - mk_ref gre = sep [nom <> comma, pprNameProvenance gre] - where nom = case gre_par gre of - FldParent { par_lbl = Just lbl } -> text "the field" <+> quotes (ppr lbl) - _ -> quotes (ppr (gre_name gre)) + msg1 = text "either" <+> ppr_gre np1 + msgs = [text " or" <+> ppr_gre np | np <- nps] + ppr_gre gre = sep [ pp_gre_name gre <> comma + , pprNameProvenance gre] + + -- When printing the name, take care to qualify it in the same + -- way as the provenance reported by pprNameProvenance, namely + -- the head of 'gre_imp'. Otherwise we get confusing reports like + -- Ambiguous occurrence ‘null’ + -- It could refer to either ‘T15487a.null’, + -- imported from ‘Prelude’ at T15487.hs:1:8-13 + -- or ... + -- See Trac #15487 + pp_gre_name gre@(GRE { gre_name = name, gre_par = parent + , gre_lcl = lcl, gre_imp = iss }) + | FldParent { par_lbl = Just lbl } <- parent + = text "the field" <+> quotes (ppr lbl) + | otherwise + = quotes (pp_qual <> dot <> ppr (nameOccName name)) + where + pp_qual | lcl + = ppr (nameModule name) + | imp : _ <- iss -- This 'imp' is the one that + -- pprNameProvenance chooses + , ImpDeclSpec { is_as = mod } <- is_decl imp + = ppr mod + | otherwise + = pprPanic "addNameClassErrRn" (ppr gre $$ ppr iss) + -- Invariant: either 'lcl' is True or 'iss' is non-empty shadowedNameWarn :: OccName -> [SDoc] -> SDoc shadowedNameWarn occ shadowed_locs diff --git a/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout b/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout index 3270089..cfed45f 100644 --- a/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout +++ b/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout @@ -6,21 +6,21 @@ data T a = MkT {Ghci2.foo :: Bool, ...} :1:1: error: Ambiguous occurrence ‘foo’ - It could refer to either the field ‘foo’, - defined at :3:16 - or the field ‘foo’, defined at :4:18 + It could refer to + either the field ‘foo’, defined at :3:16 + or the field ‘foo’, defined at :4:18 :9:1: error: Ambiguous occurrence ‘foo’ - It could refer to either the field ‘foo’, - defined at :3:16 - or the field ‘foo’, defined at :4:18 + It could refer to + either the field ‘foo’, defined at :3:16 + or the field ‘foo’, defined at :4:18 True :1:1: error: Ambiguous occurrence ‘foo’ - It could refer to either the field ‘foo’, - defined at :3:16 - or the field ‘foo’, defined at :4:18 + It could refer to + either the field ‘foo’, defined at :3:16 + or the field ‘foo’, defined at :4:18 foo :: U -> Int 42 diff --git a/testsuite/tests/rename/should_fail/T15487.hs b/testsuite/tests/rename/should_fail/T15487.hs new file mode 100644 index 0000000..62e69e3 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15487.hs @@ -0,0 +1,7 @@ +module T15487 where + +import qualified T15487a + +null = 42 + +foo x = null diff --git a/testsuite/tests/rename/should_fail/T15487.stderr b/testsuite/tests/rename/should_fail/T15487.stderr new file mode 100644 index 0000000..bb25939 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15487.stderr @@ -0,0 +1,8 @@ + +T15487.hs:7:9: error: + Ambiguous occurrence ‘null’ + It could refer to + either ‘Prelude.null’, + imported from ‘Prelude’ at T15487.hs:1:8-13 + (and originally defined in ‘Data.Foldable’) + or ‘T15487.null’, defined at T15487.hs:5:1 diff --git a/testsuite/tests/rename/should_fail/T15487a.hs b/testsuite/tests/rename/should_fail/T15487a.hs new file mode 100644 index 0000000..e8687ee --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15487a.hs @@ -0,0 +1 @@ +module T15487a (null) where diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index 2eef29f..c69efb9 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -133,3 +133,5 @@ test('T14307', normal, compile_fail, ['']) test('T14591', normal, compile_fail, ['']) test('T15214', normal, compile_fail, ['']) test('T15539', normal, compile_fail, ['']) +test('T15487', normal, multimod_compile_fail, ['T15487','-v0']) + diff --git a/testsuite/tests/rename/should_fail/rnfail044.stderr b/testsuite/tests/rename/should_fail/rnfail044.stderr index 6dcf2ca..39f7b77 100644 --- a/testsuite/tests/rename/should_fail/rnfail044.stderr +++ b/testsuite/tests/rename/should_fail/rnfail044.stderr @@ -1,7 +1,8 @@ rnfail044.hs:5:12: error: Ambiguous occurrence ‘splitAt’ - It could refer to either ‘Data.List.splitAt’, - imported from ‘Prelude’ at rnfail044.hs:5:8 - (and originally defined in ‘GHC.List’) - or ‘A.splitAt’, defined at rnfail044.hs:8:3 + It could refer to + either ‘Prelude.splitAt’, + imported from ‘Prelude’ at rnfail044.hs:5:8 + (and originally defined in ‘GHC.List’) + or ‘A.splitAt’, defined at rnfail044.hs:8:3 From git at git.haskell.org Tue Aug 21 16:12:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 16:12:22 +0000 (UTC) Subject: [commit: ghc] master: Add a solveEqualities to tcClassDecl1 (43b08cf) Message-ID: <20180821161222.667403A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/43b08cfbac5ce7ad6fc245651329094896de06e0/ghc >--------------------------------------------------------------- commit 43b08cfbac5ce7ad6fc245651329094896de06e0 Author: Simon Peyton Jones Date: Tue Aug 21 15:57:56 2018 +0100 Add a solveEqualities to tcClassDecl1 Trac #15505 showed that, when we have a type error, we could have an unfilled-in coercion hole. We don't want an assertion error in that case. The underlying cause is that tcClassDecl1 should call solveEqualities to fully solve all top-level equalities (or fail in the attempt). I also refactored the ClassDecl case for tcTyClDecl1 into a new function tcClassDecl1. That makes it symmetrical with the others. >--------------------------------------------------------------- 43b08cfbac5ce7ad6fc245651329094896de06e0 compiler/deSugar/DsMeta.hs | 4 +- compiler/hsSyn/Convert.hs | 2 +- compiler/hsSyn/HsDecls.hs | 7 +- compiler/parser/RdrHsSyn.hs | 3 +- compiler/rename/RnSource.hs | 3 +- compiler/typecheck/TcHsType.hs | 10 +- compiler/typecheck/TcTyClsDecls.hs | 395 +++++++++++++++++++------------------ 7 files changed, 222 insertions(+), 202 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 43b08cfbac5ce7ad6fc245651329094896de06e0 From git at git.haskell.org Tue Aug 21 16:12:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 16:12:25 +0000 (UTC) Subject: [commit: ghc] master: Comments only (828e949) Message-ID: <20180821161225.357C63A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/828e949318399752630f80f1fbefbbea08c55995/ghc >--------------------------------------------------------------- commit 828e949318399752630f80f1fbefbbea08c55995 Author: Simon Peyton Jones Date: Mon Aug 20 09:50:31 2018 +0100 Comments only >--------------------------------------------------------------- 828e949318399752630f80f1fbefbbea08c55995 compiler/typecheck/TcType.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 898a0f2..ac3bbf2 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -2072,7 +2072,7 @@ mkMinimalBySCs :: forall a. (a -> PredType) -> [a] -> [a] -- - can be deduced from another by superclasses, -- -- - are a reflexive equality (e.g * ~ *) --- (see Note [Remove redundant provided dicts] in PatSyn) +-- (see Note [Remove redundant provided dicts] in TcPatSyn) -- -- The result is a subset of the input. -- The 'a' is just paired up with the PredType; @@ -2094,7 +2094,8 @@ mkMinimalBySCs get_pred xs = go preds_with_scs [] -- order as the input, which is generally saner go (work_item@(p,_,_) : work_list) min_preds | EqPred _ t1 t2 <- classifyPredType p - , t1 `tcEqType` t2 -- See Note [Discard reflexive equalities] + , t1 `tcEqType` t2 -- See TcPatSyn + -- Note [Remove redundant provided dicts] = go work_list min_preds | p `in_cloud` work_list || p `in_cloud` min_preds = go work_list min_preds From git at git.haskell.org Tue Aug 21 16:58:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 16:58:51 +0000 (UTC) Subject: [commit: ghc] wip/D4889: rts: Specialize hashing at call site rather than in struct. (fd49675) Message-ID: <20180821165851.D2D4A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/D4889 Link : http://ghc.haskell.org/trac/ghc/changeset/fd4967573cdc43aaa73447324ec30519aa81b236/ghc >--------------------------------------------------------------- commit fd4967573cdc43aaa73447324ec30519aa81b236 Author: Crazycolorz5 Date: Tue Aug 21 12:58:26 2018 -0400 rts: Specialize hashing at call site rather than in struct. Separate word and string hash tables on the type level, and do not store the hashing function. Thus when a different hash function is desire it is provided upon accessing the table. This is worst case the same as before the change, and in the majority of cases is better. Also mark the functions for aggressive inlining to improve performance. {F1686506} Reviewers: bgamari, erikd, simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #13165 Differential Revision: https://phabricator.haskell.org/D4889 >--------------------------------------------------------------- fd4967573cdc43aaa73447324ec30519aa81b236 rts/FileLock.c | 12 ++--- rts/Hash.c | 124 +++++++++++++++++++++++++++++++++++--------------- rts/Hash.h | 46 +++++++++++++------ rts/Hpc.c | 12 ++--- rts/Linker.c | 12 ++--- rts/LinkerInternals.h | 8 ++-- rts/RtsSymbolInfo.c | 6 +-- rts/StaticPtrTable.c | 14 +++--- 8 files changed, 152 insertions(+), 82 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 fd4967573cdc43aaa73447324ec30519aa81b236 From git at git.haskell.org Tue Aug 21 16:58:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 16:58:54 +0000 (UTC) Subject: [commit: ghc] wip/D4889's head updated: rts: Specialize hashing at call site rather than in struct. (fd49675) Message-ID: <20180821165854.45F8E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/D4889' now includes: 653dc5f Bump Cabal submodule 8d04822 Bump binary submodule 7535fd6 Bump filepath submodule 8801642 testsuite: Bump T3064 expected allocations 47e54a0 Bump hadrian submodule 73683f1 Refactor printMinimalImports (#15439) 0095cde Fix typos f355b72 circleci: Don't build validate-x86_64-linux-debug unregisterised 4d91cab Allow scoped type variables refer to types d7bc05e Create 8.8.1 release notes b14040d Move 8.8.1-notes.rst to the right directory f811685 Mention #15050 in the release notes for 8.8.1 e94cc29 Use -fobject-code in the GHCi script for loading GHC 29dfb63 Strip ../ from testdir (fixes #15469) 36a4c19 Testsuite driver: fix encoding issue when calling ghc-pkg 4fc6524 Stop the linker panic ff06176 Improve error message for flags with missing required arguments (#12625) c6cc93b rts: Ensure that the_gc_thread is aligned 8b357c6 Add since annotation to GHC.ByteOrder ce9b459 docs: Fix wrong module name in hsig example 672f177 Unhide GHC.List for haddock 24b76d1 [docs] Add missed specialisations warnings to list of those not enabled by -Wall e28bb01 fix timeout related i686 validation issues 7d77198 Support typechecking of type literals in backpack 2604d9b Bump binary submodule to 0.8.6.0 f22baa4 users-guide: Enlarge title underlines in 8.8 release notes aab8656 Turn on MonadFail desugaring by default e5b128c Bump Cabal submodule 5487f30 testsuite: Add (broken) test for #15473 e2db2d5 Yet another Cabal submodule bump 4d6dfc3 Allow arbitrary options to be passed to tar compression e2b5c54 Revert "rts: Ensure that the_gc_thread is aligned" 9f93714 circleci: Fix documentation building 5be646f circleci: Reduce build verbosity 60e12f2 circleci: Reduce compression effort to 3 396aac4 Add FreeBSD amd64 LLVM target ce47a9c base: improve Functor documentation 342f27f Bump unix submodule b44e747 testsuite: Bump for unix 2.7 b324c56 Filter plugin dylib locations f27d714 Simplify testsuite driver 97596a4 Simplify testsuite driver, part 2 ec49b42 CSE should deal with letrec 193eeee use *test instead of *slowtest for llvm validation on Circle CI d42eef3 --show-iface: Qualify all non-local names f7f9820 Check if files are same in combineSrcSpans c552fee Suppress redundant givens during error reporting bd48a88 Bump parsec submodule 32008a9 Properly designate LambdaCase alts as CaseAlt in TH 2908899 primops: Drop support for WORD_SIZE_IN_BITS < 32 9f932d8 Add a test for Trac #15523 1e741fe Cosmetics in GraphColor 7a63f75 primops: Drop documentation for WORD_SIZE_IN_BITS < 32 5238f20 Fix #15527 by pretty-printing an RdrName prefixly a50244c Rename SigTv to TyVarTv (#15480) 23f6f31 Document default value of +RTS -N in user's guide 63b6a1d Be mindful of GADT tyvar order when desugaring record updates ae68f32 base: rewrite Monoid module docs 2748e95 base: Rewrite semigroup documentation 8154faf Make ghci work for stage1 and Hadrian 1bbb5fa Add comment explaining change in syntax error suggestion for #12146. 8f4df7f Add test cases for Ticket #12146. a08b285 CSE should deal with letrec (#9441) ecc0ddf Initialise cec_suppress properly d04a152 Update .mailmap [skip ci] 2671ec5 Bump stm submodule 9c4e6c6 Expose the StableName constructor ce6ce78 Set strictness correctly for JoinIds 18c302c Improve ambiguous-occurrence error message 828e949 Comments only 43b08cf Add a solveEqualities to tcClassDecl1 fd49675 rts: Specialize hashing at call site rather than in struct. From git at git.haskell.org Tue Aug 21 19:10:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 19:10:47 +0000 (UTC) Subject: [commit: ghc] master: driver: unconditionally disable relaxation when linking partially (1cc9061) Message-ID: <20180821191047.F02EC3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1cc9061fce4270739677d475190fd6e890e8b1f9/ghc >--------------------------------------------------------------- commit 1cc9061fce4270739677d475190fd6e890e8b1f9 Author: Sergei Trofimovich Date: Tue Aug 21 20:08:42 2018 +0100 driver: unconditionally disable relaxation when linking partially In https://github.com/gentoo-haskell/gentoo-haskell/issues/704 user explicitly uses -Wl,--relax for most built binaries. Most of the time this works fine except for capi haskell code similar to the following: ```haskell {-# LANGUAGE CApiFFI #-} module Z where import Foreign.C foreign import capi "unistd.h close" c_close :: CInt -> IO CInt ``` In this case compilation fails as: ``` $ inplace/bin/ghc-stage2 -c Z.hs -optl-Wl,--relax -fforce-recomp ld: --relax and -r may not be used together ``` GHC's driver already disables relaxation on sparc as there relaxation is already a default mode. This change disables relaxation on partial linking for all platforms where linker is binutils linker. Reported-by: wmyrda Bug: https://github.com/gentoo-haskell/gentoo-haskell/issues/704 Signed-off-by: Sergei Trofimovich Test Plan: pass -optl-Wl,--relax in test above Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4888 >--------------------------------------------------------------- 1cc9061fce4270739677d475190fd6e890e8b1f9 compiler/main/DriverPipeline.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 94a0a31..68f69fc 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -2169,12 +2169,11 @@ joinObjectFiles dflags o_files output_fn = do ++ (if osInfo == OSFreeBSD then [SysTools.Option "-L/usr/lib"] else []) - -- gcc on sparc sets -Wl,--relax implicitly, but - -- -r and --relax are incompatible for ld, so + -- gcc on sparc sets -Wl,--relax implicitly (another + -- use case is when use passes -optl-Wl,--relax) + -- but -r and --relax are incompatible for ld, so -- disable --relax explicitly. - ++ (if platformArch (targetPlatform dflags) - `elem` [ArchSPARC, ArchSPARC64] - && ldIsGnuLd + ++ (if ldIsGnuLd then [SysTools.Option "-Wl,-no-relax"] else []) ++ map SysTools.Option ld_build_id From git at git.haskell.org Tue Aug 21 21:11:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 21:11:44 +0000 (UTC) Subject: [commit: ghc] wip/T15548: Add a Note and and use integer-wired-in for the unit name (2046835) Message-ID: <20180821211144.E1B9E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15548 Link : http://ghc.haskell.org/trac/ghc/changeset/2046835af7d49d4331424a9af1388d212c4d887c/ghc >--------------------------------------------------------------- commit 2046835af7d49d4331424a9af1388d212c4d887c Author: Joachim Breitner Date: Tue Aug 21 09:36:18 2018 -0700 Add a Note and and use integer-wired-in for the unit name to signpost more clearly that there is something weird going on, and that people should not look for a package `integer` somewhere. Also, make sure the name is set only once. >--------------------------------------------------------------- 2046835af7d49d4331424a9af1388d212c4d887c compiler/basicTypes/Module.hs | 3 ++- compiler/coreSyn/CorePrep.hs | 1 + compiler/main/Packages.hs | 4 +++- compiler/prelude/PrelNames.hs | 30 +++++++++++++++++++++++++++ libraries/integer-gmp/integer-gmp.cabal | 5 ++++- libraries/integer-simple/integer-simple.cabal | 5 +++-- 6 files changed, 43 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs index 44f841d..7307a83 100644 --- a/compiler/basicTypes/Module.hs +++ b/compiler/basicTypes/Module.hs @@ -1066,7 +1066,8 @@ integerUnitId, primUnitId, baseUnitId, rtsUnitId, thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId primUnitId = fsToUnitId (fsLit "ghc-prim") -integerUnitId = fsToUnitId (fsLit "integer") +integerUnitId = fsToUnitId (fsLit "integer-wired-in") + -- See Note [The integer library] in PrelNames baseUnitId = fsToUnitId (fsLit "base") rtsUnitId = fsToUnitId (fsLit "rts") thUnitId = fsToUnitId (fsLit "template-haskell") diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 0349c8c..26706b1 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -1537,6 +1537,7 @@ lookupMkNaturalName dflags hsc_env = guardNaturalUse dflags $ liftM tyThingId $ lookupGlobal hsc_env mkNaturalName +-- See Note [The integer library] in PrelNames lookupIntegerSDataConName :: DynFlags -> HscEnv -> IO (Maybe DataCon) lookupIntegerSDataConName dflags hsc_env = case integerLibrary dflags of IntegerGMP -> guardIntegerUse dflags $ liftM (Just . tyThingDataCon) $ diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 20f3700..13bac88 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -976,7 +976,9 @@ findWiredInPackages dflags prec_map pkgs vis_map = do -- let matches :: PackageConfig -> WiredInUnitId -> Bool - pc `matches` "integer" + pc `matches` pid + -- See Note [The integer library] in PrelNames + | pid == unitIdString integerUnitId = packageNameString pc `elem` ["integer-gmp", "integer-simple"] pc `matches` pid = packageNameString pc == pid diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index be468c0..3a5bb00 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -110,6 +110,36 @@ by the user. For those things that *can* appear in source programs, original-name cache. See also Note [Built-in syntax and the OrigNameCache] + + +Note [The integer library] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Clearly, we need to know the names of various definitions of the integer +library, e.g. the type itself, `mkInteger` etc. But there are two possible +implementations of the integer library: + + * integer-gmp (fast, but uses libgmp, which may not be available on all + targets and is GPL licensed) + * integer-simple (slow, but pure Haskell and BSD-licensed) + +We want the compiler to work with eitherone. The way we achieve this is: + + * When compiling the integer-{gmp,simple} library, we pass + -this-unit-id integer-wired-in + to GHC (see the cabal file libraries/integer-{gmp,simple}. + * This way, GHC can use just his UnitID (see Module.integerUnitId) when + generating code, and the linker will succeed. + +Unfortuately, the abstraction is not complete: When using integer-gmp, we +really want to use the S# constructor directly. This is controlled by +the `integerLibrary` field of `DynFlags`: If it is IntegerGMP, we use +this constructor directly (see CorePrep.lookupIntegerSDataConName) + +When we read the package data base, we have to rewrite it to use +`integer-wired-in` instead of the actual UnitId (which includes the version +number); just like for `base` and other packages. This is done in +Packages.findWiredInPackages. -} {-# LANGUAGE CPP #-} diff --git a/libraries/integer-gmp/integer-gmp.cabal b/libraries/integer-gmp/integer-gmp.cabal index e4ecc7a..52834bb 100644 --- a/libraries/integer-gmp/integer-gmp.cabal +++ b/libraries/integer-gmp/integer-gmp.cabal @@ -60,7 +60,10 @@ library UnliftedFFITypes build-depends: ghc-prim ^>= 0.5.1.0 hs-source-dirs: src/ - ghc-options: -this-unit-id integer -Wall + -- We need to set the unit ID to integer-wired-in + -- (without a version number) as it's magic. + -- See Note [The integer library] in PrelNames + ghc-options: -this-unit-id integer-wired-in -Wall cc-options: -std=c99 -Wall include-dirs: include diff --git a/libraries/integer-simple/integer-simple.cabal b/libraries/integer-simple/integer-simple.cabal index e6c83da..96c2e23 100644 --- a/libraries/integer-simple/integer-simple.cabal +++ b/libraries/integer-simple/integer-simple.cabal @@ -26,6 +26,7 @@ Library other-modules: GHC.Integer.Type default-extensions: CPP, MagicHash, BangPatterns, UnboxedTuples, UnliftedFFITypes, NoImplicitPrelude - -- We need to set the unit ID to integer + -- We need to set the unit ID to integer-wired-in -- (without a version number) as it's magic. - ghc-options: -this-unit-id integer -Wall + -- See Note [The integer library] in PrelNames + ghc-options: -this-unit-id integer-wired-in -Wall From git at git.haskell.org Tue Aug 21 21:11:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 21:11:47 +0000 (UTC) Subject: [commit: ghc] wip/T15548: More note references (1658bea) Message-ID: <20180821211147.B260F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15548 Link : http://ghc.haskell.org/trac/ghc/changeset/1658bea60d528c270047441b3087b9025517a38c/ghc >--------------------------------------------------------------- commit 1658bea60d528c270047441b3087b9025517a38c Author: Joachim Breitner Date: Tue Aug 21 09:48:33 2018 -0700 More note references >--------------------------------------------------------------- 1658bea60d528c270047441b3087b9025517a38c compiler/main/DynFlags.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 61838a0..400f8d9 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -850,7 +850,7 @@ data DynFlags = DynFlags { settings :: Settings, integerLibrary :: IntegerLibrary, -- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overriden - -- by GHC-API users + -- by GHC-API users. See Note [The integer library] in PrelNames llvmTargets :: LlvmTargets, llvmPasses :: LlvmPasses, verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] From git at git.haskell.org Tue Aug 21 21:11:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 21:11:50 +0000 (UTC) Subject: [commit: ghc] wip/T15548: Make tablesNextToCode a proper dynamic flag (#15548) (0993a26) Message-ID: <20180821211150.8EEFC3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15548 Link : http://ghc.haskell.org/trac/ghc/changeset/0993a26241e079e6d8333ef81c206e87f1f6f2c3/ghc >--------------------------------------------------------------- commit 0993a26241e079e6d8333ef81c206e87f1f6f2c3 Author: Joachim Breitner Date: Mon Aug 20 21:29:42 2018 -0700 Make tablesNextToCode a proper dynamic flag (#15548) There is no more use of the TABLES_NEXT_TO_CODE CPP macro in `compiler/`. The default value of `tablesNextToCode` is calculated as before, but now users of the GHCI API can modify this flag. >--------------------------------------------------------------- 0993a26241e079e6d8333ef81c206e87f1f6f2c3 compiler/ghc.mk | 8 -------- compiler/ghci/ByteCodeItbls.hs | 4 +++- compiler/main/DynFlags.hs | 8 +++----- compiler/utils/Util.hs | 8 -------- libraries/ghci/GHCi/InfoTable.hsc | 30 ++++++++++++------------------ libraries/ghci/GHCi/Message.hs | 7 ++++--- libraries/ghci/GHCi/Run.hs | 4 ++-- 7 files changed, 24 insertions(+), 45 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 0993a26241e079e6d8333ef81c206e87f1f6f2c3 From git at git.haskell.org Tue Aug 21 21:11:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 21:11:53 +0000 (UTC) Subject: [commit: ghc] wip/T15548: Found a few more ifdefs in the GHCi code (bd277ef) Message-ID: <20180821211153.6EBF23A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15548 Link : http://ghc.haskell.org/trac/ghc/changeset/bd277ef6e49dc12159776e1d7b16bfdb18bddcf3/ghc >--------------------------------------------------------------- commit bd277ef6e49dc12159776e1d7b16bfdb18bddcf3 Author: Joachim Breitner Date: Tue Aug 21 11:36:24 2018 -0700 Found a few more ifdefs in the GHCi code >--------------------------------------------------------------- bd277ef6e49dc12159776e1d7b16bfdb18bddcf3 libraries/ghci/GHCi/InfoTable.hsc | 36 +++++++++++++++++------------------- 1 file changed, 17 insertions(+), 19 deletions(-) diff --git a/libraries/ghci/GHCi/InfoTable.hsc b/libraries/ghci/GHCi/InfoTable.hsc index 848b04d..f495d56 100644 --- a/libraries/ghci/GHCi/InfoTable.hsc +++ b/libraries/ghci/GHCi/InfoTable.hsc @@ -312,20 +312,20 @@ data StgConInfoTable = StgConInfoTable { pokeConItbl - :: Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable + :: Bool -> Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable -> IO () -pokeConItbl wr_ptr _ex_ptr itbl = do -#if defined(TABLES_NEXT_TO_CODE) - -- Write the offset to the con_desc from the end of the standard InfoTable - -- at the first byte. - let con_desc_offset = conDesc itbl `minusPtr` (_ex_ptr `plusPtr` conInfoTableSizeB) - (#poke StgConInfoTable, con_desc) wr_ptr con_desc_offset -#else - -- Write the con_desc address after the end of the info table. - -- Use itblSize because CPP will not pick up PROFILING when calculating - -- the offset. - pokeByteOff wr_ptr itblSize (conDesc itbl) -#endif +pokeConItbl tables_next_to_code wr_ptr _ex_ptr itbl = do + if tables_next_to_code + then do + -- Write the offset to the con_desc from the end of the standard InfoTable + -- at the first byte. + let con_desc_offset = conDesc itbl `minusPtr` (_ex_ptr `plusPtr` conInfoTableSizeB) + (#poke StgConInfoTable, con_desc) wr_ptr con_desc_offset + else do + -- Write the con_desc address after the end of the info table. + -- Use itblSize because CPP will not pick up PROFILING when calculating + -- the offset. + pokeByteOff wr_ptr itblSize (conDesc itbl) pokeItbl (wr_ptr `plusPtr` (#offset StgConInfoTable, i)) (infoTable itbl) sizeOfEntryCode :: Bool -> Int @@ -352,14 +352,12 @@ newExecConItbl tables_next_to_code obj con_desc ex_ptr <- peek pcode let cinfo = StgConInfoTable { conDesc = ex_ptr `plusPtr` fromIntegral sz , infoTable = obj } - pokeConItbl wr_ptr ex_ptr cinfo + pokeConItbl tables_next_to_code wr_ptr ex_ptr cinfo pokeArray0 0 (castPtr wr_ptr `plusPtr` fromIntegral sz) con_desc _flushExec sz ex_ptr -- Cache flush (if needed) -#if defined(TABLES_NEXT_TO_CODE) - return (castPtrToFunPtr (ex_ptr `plusPtr` conInfoTableSizeB)) -#else - return (castPtrToFunPtr ex_ptr) -#endif + if tables_next_to_code + then return (castPtrToFunPtr (ex_ptr `plusPtr` conInfoTableSizeB)) + else return (castPtrToFunPtr ex_ptr) foreign import ccall unsafe "allocateExec" _allocateExec :: CUInt -> Ptr (Ptr a) -> IO (Ptr a) From git at git.haskell.org Tue Aug 21 22:56:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:56:30 +0000 (UTC) Subject: [commit: ghc] master: Fix redundant imports of Class (966aa78) Message-ID: <20180821225630.253973A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/966aa7818222a8637b56ca32b3892901de1bf5d4/ghc >--------------------------------------------------------------- commit 966aa7818222a8637b56ca32b3892901de1bf5d4 Author: Ben Gamari Date: Tue Aug 21 17:18:14 2018 -0400 Fix redundant imports of Class >--------------------------------------------------------------- 966aa7818222a8637b56ca32b3892901de1bf5d4 compiler/deSugar/DsMeta.hs | 1 - compiler/hsSyn/Convert.hs | 1 - compiler/rename/RnSource.hs | 1 - 3 files changed, 3 deletions(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 085cfc5..785eb84 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -30,7 +30,6 @@ import DsMonad import qualified Language.Haskell.TH as TH import HsSyn -import Class import PrelNames -- To avoid clashes with DsMeta.varName we must make a local alias for -- OccName.varName we do this by removing varName from the import of diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 66a2681..24b0b20 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -17,7 +17,6 @@ module Convert( convertToHsExpr, convertToPat, convertToHsDecls, import GhcPrelude import HsSyn as Hs -import qualified Class import PrelNames import RdrName import qualified Name diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index 987ed17..00fc335 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -38,7 +38,6 @@ import TcRnMonad import ForeignCall ( CCallTarget(..) ) import Module import HscTypes ( Warnings(..), plusWarns ) -import Class ( FunDep ) import PrelNames ( applicativeClassName, pureAName, thenAName , monadClassName, returnMName, thenMName , monadFailClassName, failMName, failMName_preMFP From git at git.haskell.org Tue Aug 21 22:56:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:56:34 +0000 (UTC) Subject: [commit: ghc] master: Fix #line pragmas in nested comments (02518f9) Message-ID: <20180821225634.109033A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/02518f9d99c2d038384263f9e039efcb09bc96ff/ghc >--------------------------------------------------------------- commit 02518f9d99c2d038384263f9e039efcb09bc96ff Author: Ben Sklaroff Date: Tue Aug 21 12:03:24 2018 -0400 Fix #line pragmas in nested comments When parsing a nested comment or nested doc comment in the lexer, if we see a line starting with '#' we attempt to parse a #line pragma. This fixes how ghc handles output of the C preproccesor (-cpp flag) when the original source has C comments or pragmas inside haskell comments. Updates haddock submodule. Test Plan: ./validate Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #314 Differential Revision: https://phabricator.haskell.org/D4934 >--------------------------------------------------------------- 02518f9d99c2d038384263f9e039efcb09bc96ff compiler/parser/Lexer.x | 166 +++++++++++++++------ testsuite/tests/parser/should_fail/all.T | 3 +- testsuite/tests/parser/should_fail/readFail032.hs | 19 ++- .../tests/parser/should_fail/readFail032.stderr | 13 +- testsuite/tests/parser/should_fail/readFail048.hs | 25 ++++ .../tests/parser/should_fail/readFail048.stderr | 11 ++ utils/haddock | 2 +- 7 files changed, 180 insertions(+), 59 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 02518f9d99c2d038384263f9e039efcb09bc96ff From git at git.haskell.org Tue Aug 21 22:56:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:56:37 +0000 (UTC) Subject: [commit: ghc] master: Introduce flag -keep-hscpp-files (ebcbfba) Message-ID: <20180821225637.750E03A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ebcbfba7bbf07fa9fbb78b46951892997795bcb8/ghc >--------------------------------------------------------------- commit ebcbfba7bbf07fa9fbb78b46951892997795bcb8 Author: roland Date: Tue Aug 21 12:18:26 2018 -0400 Introduce flag -keep-hscpp-files Test Plan: `make test=T10869` Reviewers: mpickering, thomie, ezyang, bgamari Reviewed By: thomie, bgamari Subscribers: rwbarton, carter GHC Trac Issues: #10869 Differential Revision: https://phabricator.haskell.org/D4861 >--------------------------------------------------------------- ebcbfba7bbf07fa9fbb78b46951892997795bcb8 compiler/main/DriverPipeline.hs | 2 ++ compiler/main/DynFlags.hs | 5 +++++ docs/users_guide/8.8.1-notes.rst | 1 + docs/users_guide/separate_compilation.rst | 13 +++++++++++++ testsuite/tests/driver/Makefile | 8 ++++++++ testsuite/tests/driver/T10869.hs | 9 +++++++++ testsuite/tests/driver/T10869A.hs | 7 +++++++ testsuite/tests/driver/all.T | 2 ++ 8 files changed, 47 insertions(+) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 68f69fc..eff542a 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -762,6 +762,7 @@ getOutputFilename stop_phase output basename dflags next_phase maybe_location odir = objectDir dflags osuf = objectSuf dflags keep_hc = gopt Opt_KeepHcFiles dflags + keep_hscpp = gopt Opt_KeepHscppFiles dflags keep_s = gopt Opt_KeepSFiles dflags keep_bc = gopt Opt_KeepLlvmFiles dflags @@ -778,6 +779,7 @@ getOutputFilename stop_phase output basename dflags next_phase maybe_location As _ | keep_s -> True LlvmOpt | keep_bc -> True HCc | keep_hc -> True + HsPp _ | keep_hscpp -> True -- See Trac #10869 _other -> False suffix = myPhaseInputExt next_phase diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index ff4766f..be14879 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -618,6 +618,7 @@ data GeneralFlag | Opt_ImplicitImportQualified -- keeping stuff + | Opt_KeepHscppFiles | Opt_KeepHiDiffs | Opt_KeepHcFiles | Opt_KeepSFiles @@ -2961,6 +2962,10 @@ dynamic_flags_deps = [ (NoArg (setGeneralFlag Opt_KeepHcFiles)) , make_ord_flag defGhcFlag "keep-hc-files" (NoArg (setGeneralFlag Opt_KeepHcFiles)) + , make_ord_flag defGhcFlag "keep-hscpp-file" + (NoArg (setGeneralFlag Opt_KeepHscppFiles)) + , make_ord_flag defGhcFlag "keep-hscpp-files" + (NoArg (setGeneralFlag Opt_KeepHscppFiles)) , make_ord_flag defGhcFlag "keep-s-file" (NoArg (setGeneralFlag Opt_KeepSFiles)) , make_ord_flag defGhcFlag "keep-s-files" diff --git a/docs/users_guide/8.8.1-notes.rst b/docs/users_guide/8.8.1-notes.rst index 2661b33..7ea2c87 100644 --- a/docs/users_guide/8.8.1-notes.rst +++ b/docs/users_guide/8.8.1-notes.rst @@ -30,6 +30,7 @@ Language Compiler ~~~~~~~~ +- New :ghc-flag:`-keep-hscpp-files` to keep the output of the CPP pre-processor. Runtime system ~~~~~~~~~~~~~~ diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst index 613e4de..d17ed21 100644 --- a/docs/users_guide/separate_compilation.rst +++ b/docs/users_guide/separate_compilation.rst @@ -397,6 +397,19 @@ compilation: Keep intermediate ``.hi`` files. This is the default. You may use ``-no-keep-hi-files`` if you are not interested in the ``.hi`` files. +.. ghc-flag:: -keep-hscpp-file + -keep-hscpp-files + :shortdesc: Retain intermediate ``.hscpp`` files. + :type: dynamic + :category: keep-intermediates + + .. index:: + single: temporary files; keeping + + Keep the output of the ``CPP`` pre-processor phase as ``.hscpp`` files. + A ``.hscpp`` file is only created, if a module gets compiled and uses the + C pre-processor. + .. ghc-flag:: -keep-llvm-file -keep-llvm-files :shortdesc: Retain intermediate LLVM ``.ll`` files. diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile index 727cc44..540f158 100644 --- a/testsuite/tests/driver/Makefile +++ b/testsuite/tests/driver/Makefile @@ -619,6 +619,14 @@ T10320: "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -fforce-recomp -ddump-to-file -ddump-rule-rewrites T10320.hs [ -f T10320.dump-rule-rewrites ] && [ ! -s T10320.dump-rule-rewrites ] +.PHONY: T10869 +T10869: + $(RM) -rf T10869.hi T10869.o T10869.hspp T10869 + $(RM) -rf T10869A.hi T10869A.o T10869A.hspp + "$(TEST_HC)" $(TEST_HC_OPTS) -c -keep-hscpp-files T10869A.hs T10869.hs + test -f T10869.hscpp + test -f T10869A.hscpp + .PHONY: T12135 T12135: $(RM) -rf T12135.o T12135.hi T12135 T12135a T12135b diff --git a/testsuite/tests/driver/T10869.hs b/testsuite/tests/driver/T10869.hs new file mode 100644 index 0000000..e151854 --- /dev/null +++ b/testsuite/tests/driver/T10869.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE CPP #-} + +module T10869 where +import T10869A + +main :: IO() +#if defined(__GLASGOW_HASKELL__) +main = writeMsg +#endif diff --git a/testsuite/tests/driver/T10869A.hs b/testsuite/tests/driver/T10869A.hs new file mode 100644 index 0000000..14e5777 --- /dev/null +++ b/testsuite/tests/driver/T10869A.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE CPP #-} +module T10869A (writeMsg) where + +writeMsg :: IO () +#if defined(__GLASGOW_HASKELL__) +writeMsg = putStrLn "Hello HSPP File" +#endif diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 07dc3bf..be91a26 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -234,6 +234,8 @@ test('T10220', normal, run_command, test('T10182', [], run_command, ['$MAKE -s --no-print-directory T10182']) +test('T10869', [], run_command, ['$MAKE -s --no-print-directory T10869']) + test('T365', [pre_cmd('touch test_preprocessor.txt'), unless(opsys('mingw32'), skip)], compile_fail, ['']) From git at git.haskell.org Tue Aug 21 22:56:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:56:40 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Deduplicate source in wcompat-warnings test (92db10b) Message-ID: <20180821225640.CDF593A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/92db10bc061e0054d0a7504de420b5ad7f72a0a0/ghc >--------------------------------------------------------------- commit 92db10bc061e0054d0a7504de420b5ad7f72a0a0 Author: Ben Gamari Date: Tue Aug 21 12:48:34 2018 -0400 testsuite: Deduplicate source in wcompat-warnings test >--------------------------------------------------------------- 92db10bc061e0054d0a7504de420b5ad7f72a0a0 .../{WCompatWarningsOnOff.hs => Template.hs} | 5 +---- .../tests/wcompat-warnings/WCompatWarningsNotOn.hs | 25 ++------------------- .../tests/wcompat-warnings/WCompatWarningsOff.hs | 26 +++------------------- .../tests/wcompat-warnings/WCompatWarningsOn.hs | 26 +++------------------- .../wcompat-warnings/WCompatWarningsOn.stderr | 10 ++++----- .../tests/wcompat-warnings/WCompatWarningsOnOff.hs | 26 +++------------------- testsuite/tests/wcompat-warnings/all.T | 9 ++++---- 7 files changed, 22 insertions(+), 105 deletions(-) diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs b/testsuite/tests/wcompat-warnings/Template.hs similarity index 74% copy from testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs copy to testsuite/tests/wcompat-warnings/Template.hs index 81df757..e3423c8 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs +++ b/testsuite/tests/wcompat-warnings/Template.hs @@ -1,8 +1,4 @@ --- Test purpose: --- Ensure that -Wno-compat disables a previously set -Wcompat {-# LANGUAGE NoMonadFailDesugaring #-} -{-# OPTIONS_GHC -Wcompat #-} -{-# OPTIONS_GHC -Wno-compat #-} module WCompatWarningsOnOff where @@ -24,3 +20,4 @@ instance Semi.Semigroup S where instance Monoid S where S a `mappend` S b = S (a+b) mempty = S 0 + diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsNotOn.hs b/testsuite/tests/wcompat-warnings/WCompatWarningsNotOn.hs index a26c565..7cd6a42 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsNotOn.hs +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsNotOn.hs @@ -1,26 +1,5 @@ -- Test purpose: -- Ensure that not using -Wcompat does not enable its warnings -{-# LANGUAGE NoMonadFailDesugaring #-} --- {-# OPTIONS_GHC -Wcompat #-} --- {-# OPTIONS_GHC -Wno-compat #-} -module WCompatWarningsNotOn where - -import qualified Data.Semigroup as Semi - -monadFail :: Monad m => m a -monadFail = do - Just _ <- undefined - undefined - -(<>) = undefined -- Semigroup warnings - --- -fwarn-noncanonical-monoid-instances -newtype S = S Int - -instance Semi.Semigroup S where - (<>) = mappend - -instance Monoid S where - S a `mappend` S b = S (a+b) - mempty = S 0 +{-# LANGUAGE CPP #-} +#include "Template.hs" diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOff.hs b/testsuite/tests/wcompat-warnings/WCompatWarningsOff.hs index 33c26cc..637fbb3 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOff.hs +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOff.hs @@ -1,26 +1,6 @@ -- Test purpose: -- Ensure that using -Wno-compat does not switch on warnings -{-# LANGUAGE NoMonadFailDesugaring #-} --- {-# OPTIONS_GHC -Wcompat #-} -{-# OPTIONS_GHC -Wno-compat #-} - -module WCompatWarningsOff where - -import qualified Data.Semigroup as Semi - -monadFail :: Monad m => m a -monadFail = do - Just _ <- undefined - undefined -(<>) = undefined -- Semigroup warnings - --- -fwarn-noncanonical-monoid-instances -newtype S = S Int - -instance Semi.Semigroup S where - (<>) = mappend - -instance Monoid S where - S a `mappend` S b = S (a+b) - mempty = S 0 +{-# OPTIONS_GHC -Wno-compat #-} +{-# LANGUAGE CPP #-} +#include "Template.hs" diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.hs b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.hs index 7d9e7de..9c75982 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.hs +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.hs @@ -1,26 +1,6 @@ -- Test purpose: -- Ensure that -Wcompat switches on the right warnings -{-# LANGUAGE NoMonadFailDesugaring #-} -{-# OPTIONS_GHC -Wcompat #-} --- {-# OPTIONS_GHC -Wno-compat #-} - -module WCompatWarningsOn where - -import qualified Data.Semigroup as Semi - -monadFail :: Monad m => m a -monadFail = do - Just _ <- undefined - undefined -(<>) = undefined -- Semigroup warnings - --- -fwarn-noncanonical-monoid-instances -newtype S = S Int - -instance Semi.Semigroup S where - (<>) = mappend - -instance Monoid S where - S a `mappend` S b = S (a+b) - mempty = S 0 +{-# OPTIONS_GHC -Wcompat #-} +{-# LANGUAGE CPP #-} +#include "Template.hs" diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr index c62780f..5c2d9c5 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr @@ -1,12 +1,12 @@ -WCompatWarningsOn.hs:13:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] +Template.hs:9:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] • Could not deduce (Control.Monad.Fail.MonadFail m) arising from the failable pattern ‘Just _’ (this will become an error in a future GHC release) from the context: Monad m bound by the type signature for: monadFail :: forall (m :: * -> *) a. Monad m => m a - at WCompatWarningsOn.hs:11:1-27 + at Template.hs:7:1-27 Possible fix: add (Control.Monad.Fail.MonadFail m) to the context of the type signature for: @@ -20,16 +20,16 @@ WCompatWarningsOn.hs:13:5: warning: [-Wmissing-monadfail-instances (in -Wcompat) = do Just _ <- undefined undefined -WCompatWarningsOn.hs:16:1: warning: [-Wsemigroup (in -Wcompat)] +Template.hs:12:1: warning: [-Wsemigroup (in -Wcompat)] Local definition of ‘<>’ clashes with a future Prelude name. This will become an error in a future release. -WCompatWarningsOn.hs:22:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] +Template.hs:18:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] Noncanonical ‘(<>) = mappend’ definition detected in the instance declaration for ‘Semigroup S’. Move definition from ‘mappend’ to ‘(<>)’ -WCompatWarningsOn.hs:25:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] +Template.hs:21:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] Noncanonical ‘mappend’ definition detected in the instance declaration for ‘Monoid S’. Define as ‘mappend = (<>)’ diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs b/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs index 81df757..d644568 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs @@ -1,26 +1,6 @@ -- Test purpose: -- Ensure that -Wno-compat disables a previously set -Wcompat -{-# LANGUAGE NoMonadFailDesugaring #-} -{-# OPTIONS_GHC -Wcompat #-} -{-# OPTIONS_GHC -Wno-compat #-} -module WCompatWarningsOnOff where - -import qualified Data.Semigroup as Semi - -monadFail :: Monad m => m a -monadFail = do - Just _ <- undefined - undefined - -(<>) = undefined -- Semigroup warnings - --- -fwarn-noncanonical-monoid-instances -newtype S = S Int - -instance Semi.Semigroup S where - (<>) = mappend - -instance Monoid S where - S a `mappend` S b = S (a+b) - mempty = S 0 +{-# OPTIONS_GHC -Wcompat -Wno-compat #-} +{-# LANGUAGE CPP #-} +#include "Template.hs" diff --git a/testsuite/tests/wcompat-warnings/all.T b/testsuite/tests/wcompat-warnings/all.T index 4447f99..5d62466 100644 --- a/testsuite/tests/wcompat-warnings/all.T +++ b/testsuite/tests/wcompat-warnings/all.T @@ -1,4 +1,5 @@ -test('WCompatWarningsOn', normal, compile, ['']) -test('WCompatWarningsOff', normal, compile, ['']) -test('WCompatWarningsNotOn', normal, compile, ['']) -test('WCompatWarningsOnOff', normal, compile, ['']) +# N.B. the source files are all stubs; edit Template.hs +test('WCompatWarningsOn', extra_files(['Template.hs']), compile, ['']) +test('WCompatWarningsOff', extra_files(['Template.hs']), compile, ['']) +test('WCompatWarningsNotOn', extra_files(['Template.hs']), compile, ['']) +test('WCompatWarningsOnOff', extra_files(['Template.hs']), compile, ['']) From git at git.haskell.org Tue Aug 21 22:56:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:56:43 +0000 (UTC) Subject: [commit: ghc] master: Simplify callSiteInline a little (8a05836) Message-ID: <20180821225643.9F9DE3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8a05836a6cb58274e41aec9e44ea2fa732b2f840/ghc >--------------------------------------------------------------- commit 8a05836a6cb58274e41aec9e44ea2fa732b2f840 Author: Simon Peyton Jones Date: Fri May 4 15:47:31 2018 +0100 Simplify callSiteInline a little This patch has virtually no effect on anything (according to a nofib run). But it simplifies the definition of interesting_call by being a bit less gung-ho about inlining nested function bindings. See Note [Nested functions] ----------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem ----------------------------------------------------------------------- anna +0.2% -0.0% 0.163 0.163 0.0% binary-trees +0.1% +0.0% -4.5% -4.5% 0.0% cacheprof -0.1% +0.1% -4.7% -4.8% +2.7% fasta +0.2% 0.0% +2.6% +3.0% 0.0% fluid -0.0% -0.6% 0.011 0.011 0.0% gamteb -0.1% -0.0% 0.069 0.070 0.0% hpg +0.1% +0.0% +0.7% +0.7% 0.0% infer +0.3% +0.2% 0.097 0.098 0.0% lambda -0.1% -0.0% +2.0% +2.0% 0.0% n-body +0.1% -0.1% -0.1% -0.1% 0.0% simple -0.2% -0.2% +0.6% +0.6% 0.0% spectral-norm +0.1% -0.0% -0.1% -0.1% 0.0% tak -0.0% -0.1% 0.024 0.024 0.0% -------------------------------------------------------------------------------- Min -0.4% -0.6% -5.3% -5.3% 0.0% Max +0.3% +0.2% +3.3% +3.3% +15.0% Geometric Mean -0.0% -0.0% -0.3% -0.3% +0.2% (cherry picked from commit 33de71fa06d03e6da396a7c0a314fea3b492ab91) (This reverts the previous reversion in commit 9dbf66d74e65309d02c9d700094e363f59c94096) >--------------------------------------------------------------- 8a05836a6cb58274e41aec9e44ea2fa732b2f840 compiler/coreSyn/CoreUnfold.hs | 33 ++++++++++++++++----------------- 1 file changed, 16 insertions(+), 17 deletions(-) diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index 7bd512d..68e7290 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -1153,11 +1153,11 @@ callSiteInline dflags id active_unfolding lone_variable arg_infos cont_info -- idUnfolding checks for loop-breakers, returning NoUnfolding -- Things with an INLINE pragma may have an unfolding *and* -- be a loop breaker (maybe the knot is not yet untied) - CoreUnfolding { uf_tmpl = unf_template, uf_is_top = is_top + CoreUnfolding { uf_tmpl = unf_template , uf_is_work_free = is_wf , uf_guidance = guidance, uf_expandable = is_exp } | active_unfolding -> tryUnfolding dflags id lone_variable - arg_infos cont_info unf_template is_top + arg_infos cont_info unf_template is_wf is_exp guidance | otherwise -> traceInline dflags id "Inactive unfolding:" (ppr id) Nothing NoUnfolding -> Nothing @@ -1177,10 +1177,10 @@ traceInline dflags inline_id str doc result = result tryUnfolding :: DynFlags -> Id -> Bool -> [ArgSummary] -> CallCtxt - -> CoreExpr -> Bool -> Bool -> Bool -> UnfoldingGuidance + -> CoreExpr -> Bool -> Bool -> UnfoldingGuidance -> Maybe CoreExpr tryUnfolding dflags id lone_variable - arg_infos cont_info unf_template is_top + arg_infos cont_info unf_template is_wf is_exp guidance = case guidance of UnfNever -> traceInline dflags id str (text "UnfNever") Nothing @@ -1252,10 +1252,10 @@ tryUnfolding dflags id lone_variable CaseCtxt -> not (lone_variable && is_exp) -- Note [Lone variables] ValAppCtxt -> True -- Note [Cast then apply] RuleArgCtxt -> uf_arity > 0 -- See Note [Unfold info lazy contexts] - DiscArgCtxt -> uf_arity > 0 -- + DiscArgCtxt -> uf_arity > 0 -- Note [Inlining in ArgCtxt] RhsCtxt -> uf_arity > 0 -- - _ -> not is_top && uf_arity > 0 -- Note [Nested functions] - -- Note [Inlining in ArgCtxt] + _other -> False -- See Note [Nested functions] + {- Note [Unfold into lazy contexts], Note [RHS of lets] @@ -1325,18 +1325,17 @@ However for worker/wrapper it may be worth inlining even if the arity is not satisfied (as we do in the CoreUnfolding case) so we don't require saturation. - Note [Nested functions] ~~~~~~~~~~~~~~~~~~~~~~~ -If a function has a nested defn we also record some-benefit, on the -grounds that we are often able to eliminate the binding, and hence the -allocation, for the function altogether; this is good for join points. -But this only makes sense for *functions*; inlining a constructor -doesn't help allocation unless the result is scrutinised. UNLESS the -constructor occurs just once, albeit possibly in multiple case -branches. Then inlining it doesn't increase allocation, but it does -increase the chance that the constructor won't be allocated at all in -the branches that don't use it. +At one time we treated a call of a non-top-level function as +"interesting" (regardless of how boring the context) in the hope +that inlining it would eliminate the binding, and its allocation. +Specifically, in the default case of interesting_call we had + _other -> not is_top && uf_arity > 0 + +But actually postInlineUnconditionally does some of this and overall +it makes virtually no difference to nofib. So I simplified away this +special case Note [Cast then apply] ~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Tue Aug 21 22:56:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:56:46 +0000 (UTC) Subject: [commit: ghc] master: function-section: enable on windows (23774c9) Message-ID: <20180821225646.7E9C83A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23774c98f1368b41515cbd5223b87ea6dbf644e1/ghc >--------------------------------------------------------------- commit 23774c98f1368b41515cbd5223b87ea6dbf644e1 Author: Tamar Christina Date: Tue Aug 21 12:13:06 2018 -0400 function-section: enable on windows gc-sections was onced observed to be slow on Windows, which is the only reason it's not enabled yet. However, it seems to be better now. Test Plan: ./validate Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15051 Differential Revision: https://phabricator.haskell.org/D4916 >--------------------------------------------------------------- 23774c98f1368b41515cbd5223b87ea6dbf644e1 mk/config.mk.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mk/config.mk.in b/mk/config.mk.in index 1105012..e4a79a1 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -365,7 +365,7 @@ SplitObjs = $(if $(and $(filter YES,$(SupportsSplitObjs)),\ # This is not supported on Darwin (where you can use subsections-via-symbols # instead) and Windows is disabled until we figure the linking performance # issues related to BFD out. (See #11445, #12913 and related tickets.) -OsSupportsSplitSections=$(if $(filter $(TargetOS_CPP),mingw32 darwin),NO,YES) +OsSupportsSplitSections=$(if $(filter $(TargetOS_CPP),darwin),NO,YES) SupportsSplitSections=$(if $(and $(filter YES,$(OsSupportsSplitSections)),\ $(filter YES,$(LdIsGNULd))),YES,NO) SplitSections ?= $(SupportsSplitSections) From git at git.haskell.org Tue Aug 21 22:56:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:56:49 +0000 (UTC) Subject: [commit: ghc] master: Replace most occurences of foldl with foldl'. (09c1d5a) Message-ID: <20180821225649.8F2783A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/09c1d5afba655a2427a448a9933bebe7d13b696b/ghc >--------------------------------------------------------------- commit 09c1d5afba655a2427a448a9933bebe7d13b696b Author: klebinger.andreas at gmx.at Date: Tue Aug 21 12:10:38 2018 -0400 Replace most occurences of foldl with foldl'. This patch adds foldl' to GhcPrelude and changes must occurences of foldl to foldl'. This leads to better performance especially for quick builds where GHC does not perform strictness analysis. It does change strictness behaviour when we use foldl' to turn a argument list into function applications. But this is only a drawback if code looks ONLY at the last argument but not at the first. And as the benchmarks show leads to fewer allocations in practice at O2. Compiler performance for Nofib: O2 Allocations: -1 s.d. ----- -0.0% +1 s.d. ----- -0.0% Average ----- -0.0% O2 Compile Time: -1 s.d. ----- -2.8% +1 s.d. ----- +1.3% Average ----- -0.8% O0 Allocations: -1 s.d. ----- -0.2% +1 s.d. ----- -0.1% Average ----- -0.2% Test Plan: ci Reviewers: goldfire, bgamari, simonmar, tdammers, monoidal Reviewed By: bgamari, monoidal Subscribers: tdammers, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4929 >--------------------------------------------------------------- 09c1d5afba655a2427a448a9933bebe7d13b696b compiler/basicTypes/Avail.hs | 2 +- compiler/basicTypes/NameCache.hs | 2 +- compiler/basicTypes/NameSet.hs | 2 +- compiler/basicTypes/OccName.hs | 2 +- compiler/basicTypes/RdrName.hs | 4 ++-- compiler/basicTypes/VarEnv.hs | 2 +- compiler/cmm/CmmContFlowOpt.hs | 1 - compiler/cmm/CmmExpr.hs | 1 - compiler/cmm/CmmSink.hs | 1 - compiler/cmm/Hoopl/Dataflow.hs | 1 - compiler/codeGen/StgCmmMonad.hs | 2 +- compiler/coreSyn/CoreArity.hs | 2 +- compiler/coreSyn/CoreMap.hs | 4 ++-- compiler/coreSyn/CoreOpt.hs | 4 ++-- compiler/coreSyn/CoreSyn.hs | 8 ++++---- compiler/deSugar/DsExpr.hs | 2 +- compiler/deSugar/DsForeign.hs | 2 +- compiler/deSugar/DsMeta.hs | 2 +- compiler/deSugar/DsUtils.hs | 2 +- compiler/deSugar/Match.hs | 4 ++-- compiler/hsSyn/HsTypes.hs | 3 ++- compiler/hsSyn/HsUtils.hs | 14 +++++++------- compiler/iface/MkIface.hs | 2 +- compiler/iface/TcIface.hs | 1 - compiler/iface/ToIface.hs | 2 +- compiler/main/Ar.hs | 2 +- compiler/main/DynFlags.hs | 2 +- compiler/main/GhcMake.hs | 2 +- compiler/main/HscTypes.hs | 5 ++--- compiler/main/Packages.hs | 4 ++-- compiler/nativeGen/AsmCodeGen.hs | 4 ++-- compiler/nativeGen/RegAlloc/Graph/Coalesce.hs | 2 -- compiler/nativeGen/RegAlloc/Graph/Main.hs | 1 - compiler/nativeGen/RegAlloc/Graph/Stats.hs | 3 --- compiler/nativeGen/RegAlloc/Linear/Stats.hs | 1 - compiler/prelude/PrelInfo.hs | 4 ++-- compiler/rename/RnNames.hs | 2 +- compiler/simplCore/CallArity.hs | 2 +- compiler/simplCore/FloatIn.hs | 4 ++-- compiler/simplCore/OccurAnal.hs | 2 +- compiler/simplCore/SetLevels.hs | 18 +++++++++--------- compiler/simplCore/Simplify.hs | 4 ++-- compiler/specialise/Rules.hs | 4 ++-- compiler/specialise/Specialise.hs | 2 +- compiler/stranal/DmdAnal.hs | 4 ++-- compiler/typecheck/FunDeps.hs | 2 +- compiler/typecheck/TcEvidence.hs | 2 +- compiler/typecheck/TcExpr.hs | 2 +- compiler/typecheck/TcGenDeriv.hs | 4 ++-- compiler/typecheck/TcGenFunctor.hs | 2 +- compiler/typecheck/TcInstDcls.hs | 4 ++-- compiler/typecheck/TcPatSyn.hs | 6 +++--- compiler/typecheck/TcRnTypes.hs | 2 +- compiler/typecheck/TcSigs.hs | 2 +- compiler/typecheck/TcSplice.hs | 2 +- compiler/typecheck/TcType.hs | 6 +++--- compiler/typecheck/TcValidity.hs | 2 +- compiler/types/Coercion.hs | 8 ++++---- compiler/types/FamInstEnv.hs | 2 +- compiler/types/InstEnv.hs | 2 +- compiler/types/Type.hs | 4 ++-- compiler/types/Unify.hs | 2 +- compiler/utils/FiniteMap.hs | 6 +++--- compiler/utils/GhcPrelude.hs | 2 ++ compiler/utils/ListSetOps.hs | 2 +- compiler/utils/UnVarGraph.hs | 1 - compiler/utils/UniqDFM.hs | 12 ++++++------ compiler/utils/UniqDSet.hs | 4 ++-- compiler/utils/UniqFM.hs | 18 ++++++++---------- 69 files changed, 115 insertions(+), 128 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 09c1d5afba655a2427a448a9933bebe7d13b696b From git at git.haskell.org Tue Aug 21 22:56:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:56:52 +0000 (UTC) Subject: [commit: ghc] master: Explicitly tell 'getNameToInstances' mods to load (c971e11) Message-ID: <20180821225652.602533A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c971e1193fa44bb507d1806d5bb61768670dc912/ghc >--------------------------------------------------------------- commit c971e1193fa44bb507d1806d5bb61768670dc912 Author: Alec Theriault Date: Tue Aug 21 16:03:40 2018 -0400 Explicitly tell 'getNameToInstances' mods to load Calculating which modules to load based on the InteractiveContext means maintaining a potentially very large GblRdrEnv. In Haddock's case, it is much cheaper (from a memory perspective) to just keep track of which modules interfaces we want loaded then hand these off explicitly to 'getNameToInstancesIndex'. Bumps haddock submodule. Reviewers: alexbiehl, bgamari Reviewed By: alexbiehl Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5003 >--------------------------------------------------------------- c971e1193fa44bb507d1806d5bb61768670dc912 compiler/main/GHC.hs | 18 +++++++++++++----- utils/haddock | 2 +- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 0e20e21..29921de 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -300,7 +300,8 @@ import HscMain import GhcMake import DriverPipeline ( compileOne' ) import GhcMonad -import TcRnMonad ( finalSafeMode, fixSafeInstances ) +import TcRnMonad ( finalSafeMode, fixSafeInstances, initIfaceTcRn ) +import LoadIface ( loadSysInterface ) import TcRnTypes import Packages import NameSet @@ -1247,13 +1248,20 @@ getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env) -- by 'Name'. Each name's lists will contain every instance in which that name -- is mentioned in the instance head. getNameToInstancesIndex :: GhcMonad m - => [Module] -- ^ visible modules. An orphan instance will be returned if and - -- only it is visible from at least one module in the list. + => [Module] -- ^ visible modules. An orphan instance will be returned + -- if it is visible from at least one module in the list. + -> Maybe [Module] -- ^ modules to load. If this is not specified, we load + -- modules for everything that is in scope unqualified. -> m (Messages, Maybe (NameEnv ([ClsInst], [FamInst]))) -getNameToInstancesIndex visible_mods = do +getNameToInstancesIndex visible_mods mods_to_load = do hsc_env <- getSession liftIO $ runTcInteractive hsc_env $ - do { loadUnqualIfaces hsc_env (hsc_IC hsc_env) + do { case mods_to_load of + Nothing -> loadUnqualIfaces hsc_env (hsc_IC hsc_env) + Just mods -> + let doc = text "Need interface for reporting instances in scope" + in initIfaceTcRn $ mapM_ (loadSysInterface doc) mods + ; InstEnvs {ie_global, ie_local} <- tcGetInstEnvs ; let visible_mods' = mkModuleSet visible_mods ; (pkg_fie, home_fie) <- tcGetFamInstEnvs diff --git a/utils/haddock b/utils/haddock index 488aa22..9ef12f3 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 488aa22f393c0addb4c0e0b63cfe0aaea32b85d7 +Subproject commit 9ef12f3c2f0ef2948e6f4bd38fdfa002c416ab09 From git at git.haskell.org Tue Aug 21 22:56:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:56:55 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Filter plugin dylib locations (13105a1) Message-ID: <20180821225655.547A63A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/13105a1ae870da6936a27cdd1d6a4bd25a661368/ghc >--------------------------------------------------------------- commit 13105a1ae870da6936a27cdd1d6a4bd25a661368 Author: Christiaan Baaij Date: Sat Aug 11 18:56:34 2018 +0200 Filter plugin dylib locations Summary: Previously we just created a cartesian product of the library paths of the plugin package and the libraries of the package. Of course, some of these combinations result in a filepath of a file doesn't exists, leading to #15475. Instead of making `haskFile` return Nothing in case a file doesn't exist (which would hide errors), we look at all the possible dylib locations and ensure that at least one of those locations is an existing file. If the list turns out to be empty however, we panic. Reviewers: mpickering, bgamari Reviewed By: mpickering Subscribers: monoidal, rwbarton, carter GHC Trac Issues: #15475 Differential Revision: https://phabricator.haskell.org/D5048 (cherry picked from commit b324c5624432f2c3d5b0a689fdff75a1ccc563f5) >--------------------------------------------------------------- 13105a1ae870da6936a27cdd1d6a4bd25a661368 compiler/deSugar/DsUsage.hs | 35 +++++++++++++++++----- testsuite/tests/plugins/Makefile | 9 ++++++ testsuite/tests/plugins/all.T | 7 +++++ ...nge.stderr => plugin-recomp-change-prof.stderr} | 6 ++++ testsuite/tests/plugins/plugin-recomp/Makefile | 4 ++- 5 files changed, 53 insertions(+), 8 deletions(-) diff --git a/compiler/deSugar/DsUsage.hs b/compiler/deSugar/DsUsage.hs index 45d4dcf..58c31ee 100644 --- a/compiler/deSugar/DsUsage.hs +++ b/compiler/deSugar/DsUsage.hs @@ -25,6 +25,7 @@ import Maybes import Packages import Finder +import Control.Monad (filterM) import Data.List import Data.IORef import Data.Map (Map) @@ -166,14 +167,19 @@ mkPluginUsage hsc_env pluginModule = case lookupPluginModuleWithSuggestions dflags pNm Nothing of -- The plug is from an external package, we just look up the dylib that -- contains the plugin - LookupFound _ pkg -> + LookupFound _ pkg -> do let searchPaths = collectLibraryPaths dflags [pkg] libs = packageHsLibs dflags pkg - dynlibs = [ searchPath mkHsSOName platform lib + dynlibLocs = [ searchPath mkHsSOName platform lib | searchPath <- searchPaths , lib <- libs ] - in mapM hashFile (nub dynlibs) + dynlibs <- filterM doesFileExist dynlibLocs + case dynlibs of + [] -> pprPanic + ("mkPluginUsage: no dylibs, tried:\n" ++ unlines dynlibLocs) + (ppr pNm) + _ -> mapM hashFile (nub dynlibs) _ -> do foundM <- findPluginModule hsc_env pNm case foundM of @@ -186,10 +192,25 @@ mkPluginUsage hsc_env pluginModule return (nub (pluginObject : depObjects)) _ -> pprPanic "mkPluginUsage: no object or dylib" (ppr pNm) where - -- plugins are shared libraries, so add WayDyn to the dflags in order to get - -- the correct filenames and library paths; just in case the object that is - -- currently being build is not going to be linked dynamically - dflags = addWay' WayDyn (hsc_dflags hsc_env) + -- plugins are shared libraries, so WayDyn should be part of the dflags in + -- order to get the correct filenames and library paths. + -- + -- We can distinguish two scenarios: + -- + -- 1. The dflags do not contain WayDyn, in this case we need to remove + -- all other ways and only add WayDyn. Why? Because other ways change + -- the library tags, i.e. WayProf adds `_p`, and we would end up looking + -- for a profiled plugin which might not be installed. See #15492 + -- + -- 2. The dflags do contain WayDyn, in this case we can leave the ways as + -- is, because the plugin must be compiled with the same ways as the + -- module that is currently being build, e.g., if the module is + -- build with WayDyn and WayProf, then the plugin that was used + -- would've also had to been build with WayProf (and WayDyn). + dflags1 = hsc_dflags hsc_env + dflags = if WayDyn `elem` ways dflags1 + then dflags1 + else updateWays (addWay' WayDyn (dflags1 {ways = []})) platform = targetPlatform dflags pNm = moduleName (mi_module pluginModule) pPkg = moduleUnitId (mi_module pluginModule) diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile index 688ac04..8a6af5b 100644 --- a/testsuite/tests/plugins/Makefile +++ b/testsuite/tests/plugins/Makefile @@ -112,3 +112,12 @@ plugin-recomp-change: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin "$(MAKE)" -s --no-print-directory -C plugin-recomp package.plugins01 TOP=$(TOP) RUN=-DRUN2 "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + +# Should recompile the module because the plugin changed, test for 15492 +.PHONY: plugin-recomp-change-prof +plugin-recomp-change-prof: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + "$(TEST_HC)" $(TEST_HC_OPTS) -prof -osuf p_o -hisuf p_hi -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + "$(MAKE)" -s --no-print-directory -C plugin-recomp package.plugins01 TOP=$(TOP) RUN=-DRUN2 + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + "$(TEST_HC)" $(TEST_HC_OPTS) -prof -osuf p_o -hisuf p_hi -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index 22aba75..f366d49 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -134,3 +134,10 @@ test('plugin-recomp-change', pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}') ], run_command, ['$MAKE -s --no-print-directory plugin-recomp-change']) + +test('plugin-recomp-change-prof', + [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']), + pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}'), + when(not config.have_profiling,skip) + ], + run_command, ['$MAKE -s --no-print-directory plugin-recomp-change-prof']) diff --git a/testsuite/tests/plugins/plugin-recomp-change.stderr b/testsuite/tests/plugins/plugin-recomp-change-prof.stderr similarity index 50% copy from testsuite/tests/plugins/plugin-recomp-change.stderr copy to testsuite/tests/plugins/plugin-recomp-change-prof.stderr index 91747c8..b801805 100644 --- a/testsuite/tests/plugins/plugin-recomp-change.stderr +++ b/testsuite/tests/plugins/plugin-recomp-change-prof.stderr @@ -3,4 +3,10 @@ Got options: Simple Plugin Pass Run Simple Plugin Passes Queried Got options: +Simple Plugin Pass Run +Simple Plugin Passes Queried +Got options: +Simple Plugin Pass Run 2 +Simple Plugin Passes Queried +Got options: Simple Plugin Pass Run 2 diff --git a/testsuite/tests/plugins/plugin-recomp/Makefile b/testsuite/tests/plugins/plugin-recomp/Makefile index db2df8d..9ee7737 100644 --- a/testsuite/tests/plugins/plugin-recomp/Makefile +++ b/testsuite/tests/plugins/plugin-recomp/Makefile @@ -16,6 +16,8 @@ package.%: "$(GHC_PKG)" init pkg.$*/local.package.conf - pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --ghc-option="$(RUN)" --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) + # The bogus extra-lib-dirs ensures the package is registered with multiple + # dynamic-library-directories which tests that the fix for #15475 works + pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --ghc-option="$(RUN)" --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --extra-lib-dirs="$(HERE)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) pkg.$*/setup build --distdir pkg.$*/dist -v0 pkg.$*/setup install --distdir pkg.$*/dist -v0 From git at git.haskell.org Tue Aug 21 22:56:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:56:55 +0000 (UTC) Subject: [commit: ghc] master: base: Mark `findIndices` as INLINABLE instead of INLINE (fixes #15426) (1481762) Message-ID: <20180821225655.B437F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/14817621aae2d45f8272a36b171b9ccce8763bba/ghc >--------------------------------------------------------------- commit 14817621aae2d45f8272a36b171b9ccce8763bba Author: Kevin Buhr Date: Tue Aug 21 16:04:59 2018 -0400 base: Mark `findIndices` as INLINABLE instead of INLINE (fixes #15426) If `findIndices` is marked INLINE in `Data.OldList`, then the unfolded versions of `elemIndex` and `findIndex` included in the interface file are unfusible (even though `findIndices` itself remains fusible). By marking it INLINABLE instead, elemIndex` and `findIndex` will fuse properly. Test Plan: make TEST=T15426 Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, carter GHC Trac Issues: #15426 Differential Revision: https://phabricator.haskell.org/D5063 >--------------------------------------------------------------- 14817621aae2d45f8272a36b171b9ccce8763bba libraries/base/Data/OldList.hs | 4 +++- testsuite/tests/perf/should_run/T15426.hs | 13 +++++++++++++ testsuite/tests/perf/should_run/all.T | 9 +++++++++ 3 files changed, 25 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/OldList.hs b/libraries/base/Data/OldList.hs index c4c38d4..ee2dfac 100644 --- a/libraries/base/Data/OldList.hs +++ b/libraries/base/Data/OldList.hs @@ -310,7 +310,9 @@ findIndices :: (a -> Bool) -> [a] -> [Int] findIndices p xs = [ i | (x,i) <- zip xs [0..], p x] #else -- Efficient definition, adapted from Data.Sequence -{-# INLINE findIndices #-} +-- (Note that making this INLINABLE instead of INLINE allows +-- 'findIndex' to fuse, fixing #15426.) +{-# INLINABLE findIndices #-} findIndices p ls = build $ \c n -> let go x r k | p x = I# k `c` r (k +# 1#) | otherwise = r (k +# 1#) diff --git a/testsuite/tests/perf/should_run/T15426.hs b/testsuite/tests/perf/should_run/T15426.hs new file mode 100644 index 0000000..de88c28 --- /dev/null +++ b/testsuite/tests/perf/should_run/T15426.hs @@ -0,0 +1,13 @@ +import Control.Exception (evaluate) +import Data.List + +-- The following will fuse with minimal heap usage provided +-- `findIndices` is marked `INLINABLE` instead of `INLINE`. + +unsafeFindIndex p = head . findIndices p + +main = do evaluate $ elemIndex 999999 [(1::Int)..1000000] + evaluate $ elemIndices 999999 [(1::Int)..1000000] + evaluate $ findIndex (>=999999) [(1::Int)..1000000] + evaluate $ findIndices (>=999999) [(1::Int)..1000000] + evaluate $ unsafeFindIndex (>=999999) [(1::Int)..1000000] diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 9705a08..6a7bcf0 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -595,3 +595,12 @@ test('T15226a', only_ways(['normal'])], compile_and_run, ['-O']) + +test('T15426', + [stats_num_field('bytes allocated', + [ (wordsize(64), 41272, 20) ]), + # 2018-08-10 41272 Change findIndices from INLINE to INLINABLE + # initial 160041176 + only_ways(['normal'])], + compile_and_run, + ['-O2']) From git at git.haskell.org Tue Aug 21 22:56:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:56:58 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix #15527 by pretty-printing an RdrName prefixly (fb8b2cb) Message-ID: <20180821225658.A9E5C3ABB2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/fb8b2cb11023dd453b22ba49b7535b6ae8a8b506/ghc >--------------------------------------------------------------- commit fb8b2cb11023dd453b22ba49b7535b6ae8a8b506 Author: Ryan Scott Date: Thu Aug 16 11:53:33 2018 +0200 Fix #15527 by pretty-printing an RdrName prefixly Summary: When `(.) @Int` is used without enabling `TypeApplications`, the resulting error message will pretty-print the (symbolic) `RdrName` `(.)`. However, it does so without parenthesizing it, which causes the pretty-printed expression to appear as `. at Int`. Yuck. Since the expression in a type application will always be prefix, we can fix this issue by using `pprPrefixOcc` instead of plain ol' `ppr`. Test Plan: make test TEST=T15527 Reviewers: bgamari, monoidal, simonpj Reviewed By: monoidal, simonpj Subscribers: rwbarton, carter GHC Trac Issues: #15527 Differential Revision: https://phabricator.haskell.org/D5071 (cherry picked from commit 5238f204482ac7f05f4e2d2e92576288cc00d42d) >--------------------------------------------------------------- fb8b2cb11023dd453b22ba49b7535b6ae8a8b506 compiler/hsSyn/HsExpr.hs | 2 +- docs/users_guide/8.6.1-notes.rst | 4 ++++ testsuite/tests/typecheck/should_fail/T15527.hs | 4 ++++ testsuite/tests/typecheck/should_fail/T15527.stderr | 4 ++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 5 files changed, 14 insertions(+), 1 deletion(-) diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index a5c65fb..6ca37e0 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -1087,7 +1087,7 @@ ppr_expr (ArithSeq _ _ info) = brackets (ppr info) ppr_expr (EWildPat _) = char '_' ppr_expr (ELazyPat _ e) = char '~' <> ppr e -ppr_expr (EAsPat _ v e) = ppr v <> char '@' <> ppr e +ppr_expr (EAsPat _ (L _ v) e) = pprPrefixOcc v <> char '@' <> ppr e ppr_expr (EViewPat _ p e) = ppr p <+> text "->" <+> ppr e ppr_expr (HsSCC _ st (StringLiteral stl lbl) expr) diff --git a/docs/users_guide/8.6.1-notes.rst b/docs/users_guide/8.6.1-notes.rst index 0cd1dd7..fccc0d1 100644 --- a/docs/users_guide/8.6.1-notes.rst +++ b/docs/users_guide/8.6.1-notes.rst @@ -162,6 +162,10 @@ Compiler `__ in a future release. +- The :ghc-flag:`-package-env ⟨file⟩|⟨name⟩` flag and ``GHC_ENVIRONMENT`` + environment variable now accept the ``-`` value, which instructs GHC to ignore + any package environment files. + Plugins ~~~~~~~ diff --git a/testsuite/tests/typecheck/should_fail/T15527.hs b/testsuite/tests/typecheck/should_fail/T15527.hs new file mode 100644 index 0000000..b65c26c --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15527.hs @@ -0,0 +1,4 @@ +module T15527 where + +f :: (Int -> Int) -> (Int -> Int) -> (Int -> Int) +f = (.) @Int diff --git a/testsuite/tests/typecheck/should_fail/T15527.stderr b/testsuite/tests/typecheck/should_fail/T15527.stderr new file mode 100644 index 0000000..dd03a0a --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15527.stderr @@ -0,0 +1,4 @@ + +T15527.hs:4:6: error: + Pattern syntax in expression context: (.)@Int + Did you mean to enable TypeApplications? diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 6a00127..e2d6b71 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -474,3 +474,4 @@ test('T14884', normal, compile_fail, ['']) test('T14904a', normal, compile_fail, ['']) test('T14904b', normal, compile_fail, ['']) test('T15067', normal, compile_fail, ['']) +test('T15527', normal, compile_fail, ['']) From git at git.haskell.org Tue Aug 21 22:56:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:56:58 +0000 (UTC) Subject: [commit: ghc] master: Fix ambiguous/out-of-scope Haddock identifiers (ddffa0c) Message-ID: <20180821225658.9CDEA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ddffa0cd8da568c97011007fc6470c61cd4447e5/ghc >--------------------------------------------------------------- commit ddffa0cd8da568c97011007fc6470c61cd4447e5 Author: Alec Theriault Date: Tue Aug 21 16:05:16 2018 -0400 Fix ambiguous/out-of-scope Haddock identifiers This drastically cuts down on the number of Haddock warnings when making docs for `base`. Plus this means more actual links end up in the docs! Also fixed other small mostly markup issues in the documentation along the way. This is a docs-only change. Reviewers: hvr, bgamari, thomie Reviewed By: thomie Subscribers: thomie, rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5055 >--------------------------------------------------------------- ddffa0cd8da568c97011007fc6470c61cd4447e5 libraries/base/Control/Arrow.hs | 4 +-- libraries/base/Control/Concurrent/Chan.hs | 4 +-- libraries/base/Control/Concurrent/MVar.hs | 8 ++--- libraries/base/Control/Exception.hs | 19 ++++++----- libraries/base/Control/Monad.hs | 4 +-- libraries/base/Control/Monad/Fail.hs | 4 +-- libraries/base/Control/Monad/Fix.hs | 2 +- libraries/base/Control/Monad/ST/Imp.hs | 2 +- libraries/base/Data/Bifoldable.hs | 2 +- libraries/base/Data/Bitraversable.hs | 30 +++++------------ libraries/base/Data/Either.hs | 2 +- libraries/base/Data/Foldable.hs | 4 +-- libraries/base/Data/Function.hs | 8 +++-- libraries/base/Data/Functor.hs | 31 +++++++++-------- libraries/base/Data/Functor/Const.hs | 4 +-- libraries/base/Data/Functor/Contravariant.hs | 2 +- libraries/base/Data/List.hs | 4 +-- libraries/base/Data/List/NonEmpty.hs | 2 +- libraries/base/Data/Maybe.hs | 6 ++-- libraries/base/Data/Monoid.hs | 14 ++++---- libraries/base/Data/Traversable.hs | 4 +-- libraries/base/Debug/Trace.hs | 5 +-- libraries/base/Foreign/C/Types.hs | 11 +++--- libraries/base/Foreign/Concurrent.hs | 23 +++++++------ libraries/base/GHC/Arr.hs | 8 ++--- libraries/base/GHC/Base.hs | 24 ++++++------- libraries/base/GHC/Conc/IO.hs | 4 +-- libraries/base/GHC/Conc/Sync.hs | 11 +++--- libraries/base/GHC/Environment.hs | 8 ++--- libraries/base/GHC/Event/Internal.hs | 2 +- libraries/base/GHC/Event/Thread.hs | 8 ++--- libraries/base/GHC/Float.hs | 2 +- libraries/base/GHC/Foreign.hs | 3 +- libraries/base/GHC/ForeignPtr.hs | 11 +++--- libraries/base/GHC/Generics.hs | 50 +++++++++++++--------------- libraries/base/GHC/IO/BufferedIO.hs | 4 +-- libraries/base/GHC/IO/Device.hs | 4 +-- libraries/base/GHC/IO/Encoding.hs | 7 ++-- libraries/base/GHC/IO/Encoding/Failure.hs | 4 +-- libraries/base/GHC/IO/Encoding/Types.hs | 4 +-- libraries/base/GHC/IO/Exception.hs | 3 +- libraries/base/GHC/IO/Handle.hs | 44 ++++++++++++------------ libraries/base/GHC/IO/Handle/FD.hs | 10 +++--- libraries/base/GHC/IO/Handle/Text.hs | 16 ++++----- libraries/base/GHC/IO/Unsafe.hs | 3 +- libraries/base/GHC/Maybe.hs | 2 +- libraries/base/GHC/Natural.hs | 22 ++++++------ libraries/base/GHC/Num.hs | 4 +-- libraries/base/GHC/RTS/Flags.hsc | 32 +++++++++--------- libraries/base/GHC/Real.hs | 2 +- libraries/base/GHC/ResponseFile.hs | 2 +- libraries/base/GHC/Stable.hs | 2 +- libraries/base/GHC/StaticPtr.hs | 4 +-- libraries/base/GHC/TypeLits.hs | 2 +- libraries/base/GHC/Unicode.hs | 2 +- libraries/base/System/Exit.hs | 2 +- libraries/base/System/IO.hs | 9 ++--- libraries/base/Type/Reflection.hs | 2 +- 58 files changed, 262 insertions(+), 254 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ddffa0cd8da568c97011007fc6470c61cd4447e5 From git at git.haskell.org Tue Aug 21 22:57:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:01 +0000 (UTC) Subject: [commit: ghc] master: rts/RetainerProfile: Dump closure type if pop() fails (2bacf6f) Message-ID: <20180821225701.85FE83A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2bacf6f8842d8e1288917e358ed41e4c61b7948e/ghc >--------------------------------------------------------------- commit 2bacf6f8842d8e1288917e358ed41e4c61b7948e Author: Ryan Scott Date: Tue Aug 21 16:04:45 2018 -0400 rts/RetainerProfile: Dump closure type if pop() fails While investigating #15529, I noticed that the `barf`ed error message in `pop()` doesn't print out the closure type that causes it to crash. Let's do so. Reviewers: bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, carter GHC Trac Issues: #15529 Differential Revision: https://phabricator.haskell.org/D5072 >--------------------------------------------------------------- 2bacf6f8842d8e1288917e358ed41e4c61b7948e rts/RetainerProfile.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index 6a0af21..9458b13 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -897,7 +897,7 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) case IND: case INVALID_OBJECT: default: - barf("Invalid object *c in pop()"); + barf("Invalid object *c in pop(): %d", get_itbl(se->c)->type); return; } } while (true); From git at git.haskell.org Tue Aug 21 22:57:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:02 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Check if files are same in combineSrcSpans (033d6ac) Message-ID: <20180821225702.426573A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/033d6ac775fad0aee9335169a41d19f54eee1486/ghc >--------------------------------------------------------------- commit 033d6ac775fad0aee9335169a41d19f54eee1486 Author: Zubin Duggal Date: Sun Aug 12 15:51:29 2018 +0200 Check if files are same in combineSrcSpans Summary: If this is not checked, SrcSpans are sometimes mangled by CPP. Test Plan: ./validate Reviewers: bgamari, dfeuer Reviewed By: bgamari Subscribers: dfeuer, rwbarton, thomie, carter GHC Trac Issues: #15279 Differential Revision: https://phabricator.haskell.org/D4866 (cherry picked from commit f7f9820e8f5601e9a072e504f3d772fd78df6700) >--------------------------------------------------------------- 033d6ac775fad0aee9335169a41d19f54eee1486 compiler/basicTypes/SrcLoc.hs | 6 ++++-- testsuite/tests/parser/should_compile/T15279.hs | 7 +++++++ testsuite/tests/parser/should_compile/T15279.hs-incl | 2 ++ testsuite/tests/parser/should_compile/T15279.stderr | 3 +++ testsuite/tests/parser/should_compile/all.T | 13 +++++++++++++ 5 files changed, 29 insertions(+), 2 deletions(-) diff --git a/compiler/basicTypes/SrcLoc.hs b/compiler/basicTypes/SrcLoc.hs index eeba3d7..3276f41 100644 --- a/compiler/basicTypes/SrcLoc.hs +++ b/compiler/basicTypes/SrcLoc.hs @@ -307,12 +307,14 @@ mkSrcSpan (RealSrcLoc loc1) (RealSrcLoc loc2) = RealSrcSpan (mkRealSrcSpan loc1 loc2) -- | Combines two 'SrcSpan' into one that spans at least all the characters --- within both spans. Assumes the "file" part is the same in both inputs +-- within both spans. Returns UnhelpfulSpan if the files differ. combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful combineSrcSpans l (UnhelpfulSpan _) = l combineSrcSpans (RealSrcSpan span1) (RealSrcSpan span2) - = RealSrcSpan (combineRealSrcSpans span1 span2) + | srcSpanFile span1 == srcSpanFile span2 + = RealSrcSpan (combineRealSrcSpans span1 span2) + | otherwise = UnhelpfulSpan (fsLit "") -- | Combines two 'SrcSpan' into one that spans at least all the characters -- within both spans. Assumes the "file" part is the same in both inputs diff --git a/testsuite/tests/parser/should_compile/T15279.hs b/testsuite/tests/parser/should_compile/T15279.hs new file mode 100644 index 0000000..b80bd32 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15279.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -ddump-parsed-ast #-} +module T15279 where + +foo :: Char -> Char +#include "T15279.hs-incl" +foo _ = 'a' diff --git a/testsuite/tests/parser/should_compile/T15279.hs-incl b/testsuite/tests/parser/should_compile/T15279.hs-incl new file mode 100644 index 0000000..d6385f2 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15279.hs-incl @@ -0,0 +1,2 @@ +foo 'a' = 'b' +foo 'b' = 'c' diff --git a/testsuite/tests/parser/should_compile/T15279.stderr b/testsuite/tests/parser/should_compile/T15279.stderr new file mode 100644 index 0000000..ff215a7 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15279.stderr @@ -0,0 +1,3 @@ +(MG +(NoExt) +({ } diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T index 1fd8c69..d949f2b 100644 --- a/testsuite/tests/parser/should_compile/all.T +++ b/testsuite/tests/parser/should_compile/all.T @@ -117,3 +117,16 @@ test('T13986', normal, compile, ['']) test('T10855', normal, compile, ['']) test('T15139', normal, compile, ['-Wincomplete-patterns -fdiagnostics-show-caret']) test('T15323', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast']) + +def only_MG_loc(x): + """ + Only compares the location embedded inside the MatchGroup, which has the form + (MG + (NoExt) + ({ + """ + ls = x.split("\n") + mgLocs = (loc.strip() for (mg,loc) in zip(ls,ls[2:]) + if mg.strip().startswith("(MG")) + return '\n'.join(mgLocs) +test('T15279', normalise_errmsg_fun(only_MG_loc), compile, ['']) From git at git.haskell.org Tue Aug 21 22:57:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:04 +0000 (UTC) Subject: [commit: ghc] master: rts: Align the_gc_thread to 64 bytes (68a1fc2) Message-ID: <20180821225704.569913A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/68a1fc29b4bb3eae54e4d96c9aec20e700040f34/ghc >--------------------------------------------------------------- commit 68a1fc29b4bb3eae54e4d96c9aec20e700040f34 Author: Ben Gamari Date: Tue Aug 21 16:06:12 2018 -0400 rts: Align the_gc_thread to 64 bytes In a previous attempt (c6cc93bca69abc258513af8cf2370b14e70fd8fb) I had tried aligning to 8 bytes under the assumption that the problem was that the_gc_thread, a StgWord8[], wasn't being aligned to 8-bytes as the gc_thread struct would expect. However, we actually need even stronger alignment due to the alignment attribute attached to gen_workspace, which claims it should be aligned to a 64-byte boundary. This fixes #15482. Reviewers: erikd, simonmar Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15482 Differential Revision: https://phabricator.haskell.org/D5052 >--------------------------------------------------------------- 68a1fc29b4bb3eae54e4d96c9aec20e700040f34 rts/sm/GC.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 742ae36..90857ab 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -128,7 +128,9 @@ uint32_t mutlist_MUTVARS, gc_thread **gc_threads = NULL; #if !defined(THREADED_RTS) -StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)]; +// Must be aligned to 64-bytes to meet stated 64-byte alignment of gen_workspace +StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)] + ATTRIBUTE_ALIGNED(64); #endif // Number of threads running in *this* GC. Affects how many From git at git.haskell.org Tue Aug 21 22:57:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:05 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump stm submodule (beca642) Message-ID: <20180821225705.0F89B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/beca6421efb0e9c0c3d34e535a83191256b83320/ghc >--------------------------------------------------------------- commit beca6421efb0e9c0c3d34e535a83191256b83320 Author: Ben Gamari Date: Mon Aug 20 15:04:31 2018 -0400 Bump stm submodule >--------------------------------------------------------------- beca6421efb0e9c0c3d34e535a83191256b83320 libraries/stm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/stm b/libraries/stm index 637013d..4a1deb9 160000 --- a/libraries/stm +++ b/libraries/stm @@ -1 +1 @@ -Subproject commit 637013d3f2596c86adc8c946e2f38e9e1a85fd84 +Subproject commit 4a1deb98fc95e55d8a6762a7dfec1a7dfa8b49b2 From git at git.haskell.org Tue Aug 21 22:57:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:07 +0000 (UTC) Subject: [commit: ghc] master: Correct limb length and assertion for gcdExtInteger (c331592) Message-ID: <20180821225707.261913A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c331592130ef592b92084e7417581a4039bfa7d2/ghc >--------------------------------------------------------------- commit c331592130ef592b92084e7417581a4039bfa7d2 Author: DavidEichamnn Date: Tue Aug 21 16:06:45 2018 -0400 Correct limb length and assertion for gcdExtInteger Reviewers: hvr, bgamari, monoidal Reviewed By: monoidal Subscribers: monoidal, rwbarton, thomie, carter GHC Trac Issues: #15350 Differential Revision: https://phabricator.haskell.org/D5042 >--------------------------------------------------------------- c331592130ef592b92084e7417581a4039bfa7d2 libraries/integer-gmp/cbits/wrappers.c | 16 +++++++++++++--- testsuite/tests/lib/integer/integerGmpInternals.hs | 19 +++++++++++++++++++ .../tests/lib/integer/integerGmpInternals.stdout | 14 ++++++++++++++ 3 files changed, 46 insertions(+), 3 deletions(-) diff --git a/libraries/integer-gmp/cbits/wrappers.c b/libraries/integer-gmp/cbits/wrappers.c index 8f147ad..11e5179 100644 --- a/libraries/integer-gmp/cbits/wrappers.c +++ b/libraries/integer-gmp/cbits/wrappers.c @@ -286,9 +286,9 @@ integer_gmp_mpn_gcd(mp_limb_t r[], * reconstructed). * * g must have space for exactly gn=min(xn,yn) limbs. - * s must have space for at least xn limbs. + * s must have space for at least yn limbs. * - * return value: signed 'sn' of {sp,sn} + * return value: signed 'sn' of {sp,sn} where |sn| >= 1 */ mp_size_t integer_gmp_gcdext(mp_limb_t s0[], mp_limb_t g0[], @@ -305,15 +305,25 @@ integer_gmp_gcdext(mp_limb_t s0[], mp_limb_t g0[], mpz_gcdext (g, s, NULL, x, y); + // g must be positive (0 <= gn). + // According to the docs for mpz_gcdext(), we have: + // g < min(|y|/2|s|, |x|/2|t|) + // --> g < min(|y|, |x|) + // --> gn <= min(yn, xn) + // <-> gn <= gn0 const mp_size_t gn = g[0]._mp_size; assert(0 <= gn && gn <= gn0); memset(g0, 0, gn0*sizeof(mp_limb_t)); memcpy(g0, g[0]._mp_d, gn*sizeof(mp_limb_t)); mpz_clear (g); + // According to the docs for mpz_gcdext(), we have: + // |s| < |y| / 2g + // --> |s| < |y| (note g > 0) + // --> sn <= yn const mp_size_t ssn = s[0]._mp_size; const mp_size_t sn = mp_size_abs(ssn); - assert(sn <= mp_size_abs(xn)); + assert(sn <= mp_size_abs(yn)); memcpy(s0, s[0]._mp_d, sn*sizeof(mp_limb_t)); mpz_clear (s); diff --git a/testsuite/tests/lib/integer/integerGmpInternals.hs b/testsuite/tests/lib/integer/integerGmpInternals.hs index c90df5c..e45c6f4 100644 --- a/testsuite/tests/lib/integer/integerGmpInternals.hs +++ b/testsuite/tests/lib/integer/integerGmpInternals.hs @@ -79,6 +79,8 @@ main = do print $ powModInteger b e m print $ powModInteger b e (m-1) print $ powModSecInteger b e (m-1) + + putStrLn "\n# gcdExtInteger" print $ gcdExtInteger b e print $ gcdExtInteger e b print $ gcdExtInteger x y @@ -86,10 +88,27 @@ main = do print $ gcdExtInteger x (-y) print $ gcdExtInteger (-x) y print $ gcdExtInteger (-x) (-y) + + -- see Trac #15350 + do + let a = 2 + b = 2^65 + 1 + print $ gcdExtInteger a b + print $ gcdExtInteger a (-b) + print $ gcdExtInteger (-a) b + print $ gcdExtInteger (-a) (-b) + print $ gcdExtInteger b a + print $ gcdExtInteger b (-a) + print $ gcdExtInteger (-b) a + print $ gcdExtInteger (-b) (-a) + + putStrLn "\n# powInteger" print $ powInteger 12345 0 print $ powInteger 12345 1 print $ powInteger 12345 30 print $ [ (x,i) | x <- [-7..71], let i = recipModInteger x (2*3*11*11*17*17), i /= 0 ] + + putStrLn "\n# nextPrimeInteger" print $ I.nextPrimeInteger b print $ I.nextPrimeInteger e print $ [ k | k <- [ 0 .. 200 ], S# (I.testPrimeInteger k 25#) `elem` [1,2] ] diff --git a/testsuite/tests/lib/integer/integerGmpInternals.stdout b/testsuite/tests/lib/integer/integerGmpInternals.stdout index d5c1374..cff835b 100644 --- a/testsuite/tests/lib/integer/integerGmpInternals.stdout +++ b/testsuite/tests/lib/integer/integerGmpInternals.stdout @@ -1,6 +1,8 @@ 1527229998585248450016808958343740453059 682382427572745901624116300491295556924 682382427572745901624116300491295556924 + +# gcdExtInteger (1,-238164827888328100873319793437342927637138278785737103723156342382925) (1,302679100340807588460107986194035692812415103244388831792688023418704) (92889294,115110207004456909698806038261) @@ -8,10 +10,22 @@ (92889294,115110207004456909698806038261) (92889294,-115110207004456909698806038261) (92889294,-115110207004456909698806038261) +(1,-18446744073709551616) +(1,-18446744073709551616) +(1,18446744073709551616) +(1,18446744073709551616) +(1,1) +(1,1) +(1,-1) +(1,-1) + +# powInteger 1 12345 555562377826831043419246079513769804614412256811161773362797946971665712715296306339052301636736176350153982639312744140625 [(-7,149867),(-5,167851),(-1,209813),(1,1),(5,41963),(7,59947),(13,177535),(19,143557),(23,182447),(25,134281),(29,7235),(31,33841),(35,95915),(37,113413),(41,61409),(43,24397),(47,174101),(49,158431),(53,193979),(59,188477),(61,185737),(65,35507),(67,118999),(71,186173)] + +# nextPrimeInteger 2988348162058574136915891421498819466320163312926952423791023078876343 2351399303373464486466122544523690094744975233415544072992656881240451 [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199] From git at git.haskell.org Tue Aug 21 22:57:08 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:08 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Be mindful of GADT tyvar order when desugaring record updates (2d308da) Message-ID: <20180821225708.669223A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/2d308da237824b6ef3fe937d31787a96a96155f5/ghc >--------------------------------------------------------------- commit 2d308da237824b6ef3fe937d31787a96a96155f5 Author: Ryan Scott Date: Fri Aug 17 16:31:27 2018 +0200 Be mindful of GADT tyvar order when desugaring record updates After commit ef26182e2014b0a2a029ae466a4b121bf235e4e4, the type variable binders in GADT constructor type signatures are now quantified in toposorted order, instead of always having all the universals before all the existentials. Unfortunately, that commit forgot to update some code (which was assuming the latter scenario) in `DsExpr` which desugars record updates. This wound up being the cause of #15499. This patch makes up for lost time by desugaring record updates in a way such that the desugared expression applies type arguments to the right-hand side constructor in the correct order—that is, the order in which they were quantified by the user. Test Plan: make test TEST=T15499 Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, carter GHC Trac Issues: #15499 Differential Revision: https://phabricator.haskell.org/D5060 (cherry picked from commit 63b6a1d44849c479d2a7cb59211f5c64d133bc62) >--------------------------------------------------------------- 2d308da237824b6ef3fe937d31787a96a96155f5 compiler/deSugar/DsExpr.hs | 25 +++++++++++++++------- testsuite/tests/typecheck/should_compile/T15499.hs | 11 ++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 3 files changed, 29 insertions(+), 8 deletions(-) diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index 954ca9c..7142cfb 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -636,12 +636,18 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields mk_alt upd_fld_env con = do { let (univ_tvs, ex_tvs, eq_spec, prov_theta, _req_theta, arg_tys, _) = conLikeFullSig con - subst = zipTvSubst univ_tvs in_inst_tys + user_tvs = + case con of + RealDataCon data_con -> dataConUserTyVars data_con + PatSynCon _ -> univ_tvs ++ ex_tvs + -- The order here is because of the order in `TcPatSyn`. + in_subst = zipTvSubst univ_tvs in_inst_tys + out_subst = zipTvSubst univ_tvs out_inst_tys -- I'm not bothering to clone the ex_tvs - ; eqs_vars <- mapM newPredVarDs (substTheta subst (eqSpecPreds eq_spec)) - ; theta_vars <- mapM newPredVarDs (substTheta subst prov_theta) - ; arg_ids <- newSysLocalsDs (substTysUnchecked subst arg_tys) + ; eqs_vars <- mapM newPredVarDs (substTheta in_subst (eqSpecPreds eq_spec)) + ; theta_vars <- mapM newPredVarDs (substTheta in_subst prov_theta) + ; arg_ids <- newSysLocalsDs (substTysUnchecked in_subst arg_tys) ; let field_labels = conLikeFieldLabels con val_args = zipWithEqual "dsExpr:RecordUpd" mk_val_arg field_labels arg_ids @@ -650,13 +656,16 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields inst_con = noLoc $ mkHsWrap wrap (HsConLikeOut noExt con) -- Reconstruct with the WrapId so that unpacking happens - -- The order here is because of the order in `TcPatSyn`. wrap = mkWpEvVarApps theta_vars <.> dict_req_wrap <.> - mkWpTyApps (mkTyVarTys ex_tvs) <.> - mkWpTyApps [ ty - | (tv, ty) <- univ_tvs `zip` out_inst_tys + mkWpTyApps [ lookupTyVar out_subst tv + `orElse` mkTyVarTy tv + | tv <- user_tvs , not (tv `elemVarEnv` wrap_subst) ] + -- Be sure to use user_tvs (which may be ordered + -- differently than `univ_tvs ++ ex_tvs) above. + -- See Note [DataCon user type variable binders] + -- in DataCon. rhs = foldl (\a b -> nlHsApp a b) inst_con val_args -- Tediously wrap the application in a cast diff --git a/testsuite/tests/typecheck/should_compile/T15499.hs b/testsuite/tests/typecheck/should_compile/T15499.hs new file mode 100644 index 0000000..653440a --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15499.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE DataKinds, GADTs, KindSignatures #-} +module T15499 () +where + +data ADT (p :: Integer) where + ADT :: + { a :: a + , b :: Integer + } -> ADT p + +foo = undefined {b=undefined} diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 2d20491..a7b283d 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -646,3 +646,4 @@ test('T15428', normal, compile, ['']) test('T15431', normal, compile, ['']) test('T15431a', normal, compile, ['']) test('T15412', normal, compile, ['']) +test('T15499', normal, compile, ['']) From git at git.haskell.org Tue Aug 21 22:57:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:10 +0000 (UTC) Subject: [commit: ghc] master: Fix precision of asinh/acosh/atanh by making them primops (c6f4eb4) Message-ID: <20180821225710.081493A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c6f4eb4f8bc5e00024c74198ab9126bf1750db40/ghc >--------------------------------------------------------------- commit c6f4eb4f8bc5e00024c74198ab9126bf1750db40 Author: Artem Pelenitsyn Date: Tue Aug 21 16:07:24 2018 -0400 Fix precision of asinh/acosh/atanh by making them primops Reviewers: hvr, bgamari, simonmar, jrtc27 Reviewed By: bgamari Subscribers: alpmestan, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5034 >--------------------------------------------------------------- c6f4eb4f8bc5e00024c74198ab9126bf1750db40 compiler/cmm/CmmMachOp.hs | 6 ++++++ compiler/cmm/PprC.hs | 6 ++++++ compiler/codeGen/StgCmmPrim.hs | 6 ++++++ compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 8 ++++++++ compiler/nativeGen/PPC/CodeGen.hs | 8 ++++++++ compiler/nativeGen/SPARC/CodeGen.hs | 8 ++++++++ compiler/nativeGen/X86/CodeGen.hs | 8 ++++++++ compiler/prelude/primops.txt.pp | 30 ++++++++++++++++++++++++++++++ libraries/base/GHC/Float.hs | 28 ++++++++++++++-------------- 9 files changed, 94 insertions(+), 14 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c6f4eb4f8bc5e00024c74198ab9126bf1750db40 From git at git.haskell.org Tue Aug 21 22:57:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:12 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Set strictness correctly for JoinIds (b81fc82) Message-ID: <20180821225712.59E1A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/b81fc821597cb7578f93cbea772304f1effd46cf/ghc >--------------------------------------------------------------- commit b81fc821597cb7578f93cbea772304f1effd46cf Author: Simon Peyton Jones Date: Tue Aug 21 09:56:39 2018 +0100 Set strictness correctly for JoinIds We were failing to keep correct strictness info when eta-expanding join points; Trac #15517. The situation was something like \q v eta -> let j x = error "blah -- STR Lx bottoming! in case y of A -> j x eta B -> blah C -> j x eta So we spot j as a join point and eta-expand it. But we must also adjust the stricness info, else it vlaimes to bottom after one arg is applied but now it has become two. I fixed this in two places: - In CoreOpt.joinPointBinding_maybe, adjust strictness info - In SimplUtils.tryEtaExpandRhs, return consistent values for arity and bottom-ness (cherry picked from commit ce6ce788251b6102f5c1b878ffec53ba7ad678b5) >--------------------------------------------------------------- b81fc821597cb7578f93cbea772304f1effd46cf compiler/basicTypes/Demand.hs | 21 ++++- compiler/coreSyn/CoreOpt.hs | 28 ++++++- compiler/simplCore/SimplUtils.hs | 9 +- testsuite/tests/simplCore/should_compile/T15517.hs | 10 +++ .../tests/simplCore/should_compile/T15517a.hs | 96 ++++++++++++++++++++++ testsuite/tests/simplCore/should_compile/all.T | 4 +- 6 files changed, 160 insertions(+), 8 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 b81fc821597cb7578f93cbea772304f1effd46cf From git at git.haskell.org Tue Aug 21 22:57:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:13 +0000 (UTC) Subject: [commit: ghc] master: Add traceBinaryEvent# primop (21f0f56) Message-ID: <20180821225713.D57A83A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/21f0f56164f50844c2150c62f950983b2376f8b6/ghc >--------------------------------------------------------------- commit 21f0f56164f50844c2150c62f950983b2376f8b6 Author: Mitsutoshi Aoe Date: Tue Aug 21 16:08:17 2018 -0400 Add traceBinaryEvent# primop This adds a new primop called traceBinaryEvent# that takes the length of binary data and a pointer to the data, then emits it to the eventlog. There is some example code that uses this primop and the new event: * [traceBinaryEventIO][1] that calls `traceBinaryEvent#` * [A patch to ghc-events][2] that parses the new `EVENT_USER_BINARY_MSG` There's no corresponding issue on Trac but it was discussed at ghc-devs [3]. [1] https://github.com/maoe/ghc-trace-events/blob /fb226011ef1f85a97b4da7cc9d5f98f9fe6316ae/src/Debug/Trace/Binary.hs#L29) [2] https://github.com/maoe/ghc-events/commit /239ca77c24d18cdd10d6d85a0aef98e4a7c56ae6) [3] https://mail.haskell.org/pipermail/ghc-devs/2018-May/015791.html Reviewers: bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5007 >--------------------------------------------------------------- 21f0f56164f50844c2150c62f950983b2376f8b6 compiler/prelude/primops.txt.pp | 14 ++++++-- includes/rts/EventLogFormat.h | 6 +++- includes/stg/MiscClosures.h | 1 + rts/PrimOps.cmm | 8 +++++ rts/RtsSymbols.c | 1 + rts/Trace.c | 11 ++++++ rts/Trace.h | 5 +++ rts/eventlog/EventLog.c | 54 +++++++++++++++++++++++++---- rts/eventlog/EventLog.h | 3 ++ testsuite/tests/rts/all.T | 4 +++ testsuite/tests/rts/traceBinaryEvent.hs | 25 +++++++++++++ testsuite/tests/rts/traceBinaryEvent.stderr | 1 + testsuite/tests/rts/traceEvent.hs | 5 +++ testsuite/tests/rts/traceEvent.stderr | 1 + 14 files changed, 130 insertions(+), 9 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 21f0f56164f50844c2150c62f950983b2376f8b6 From git at git.haskell.org Tue Aug 21 22:57:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:15 +0000 (UTC) Subject: [commit: ghc] master: Fix redundant imports of Class (966aa78) Message-ID: <20180821225715.2D5D63A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/966aa7818222a8637b56ca32b3892901de1bf5d4/ghc >--------------------------------------------------------------- commit 966aa7818222a8637b56ca32b3892901de1bf5d4 Author: Ben Gamari Date: Tue Aug 21 17:18:14 2018 -0400 Fix redundant imports of Class >--------------------------------------------------------------- 966aa7818222a8637b56ca32b3892901de1bf5d4 compiler/deSugar/DsMeta.hs | 1 - compiler/hsSyn/Convert.hs | 1 - compiler/rename/RnSource.hs | 1 - 3 files changed, 3 deletions(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 085cfc5..785eb84 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -30,7 +30,6 @@ import DsMonad import qualified Language.Haskell.TH as TH import HsSyn -import Class import PrelNames -- To avoid clashes with DsMeta.varName we must make a local alias for -- OccName.varName we do this by removing varName from the import of diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 66a2681..24b0b20 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -17,7 +17,6 @@ module Convert( convertToHsExpr, convertToPat, convertToHsDecls, import GhcPrelude import HsSyn as Hs -import qualified Class import PrelNames import RdrName import qualified Name diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index 987ed17..00fc335 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -38,7 +38,6 @@ import TcRnMonad import ForeignCall ( CCallTarget(..) ) import Module import HscTypes ( Warnings(..), plusWarns ) -import Class ( FunDep ) import PrelNames ( applicativeClassName, pureAName, thenAName , monadClassName, returnMName, thenMName , monadFailClassName, failMName, failMName_preMFP From git at git.haskell.org Tue Aug 21 22:57:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:16 +0000 (UTC) Subject: [commit: ghc] master: docs: "state transformer" -> "state monad" / "ST" (whichever is meant) (8546afc) Message-ID: <20180821225716.B16973A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8546afc502306de16b62c6386fe419753393cb12/ghc >--------------------------------------------------------------- commit 8546afc502306de16b62c6386fe419753393cb12 Author: Artem Pelenitsyn Date: Tue Aug 21 16:07:39 2018 -0400 docs: "state transformer" -> "state monad" / "ST" (whichever is meant) FIxes #15189. Reviewers: hvr, bgamari, simonmar, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15189 Differential Revision: https://phabricator.haskell.org/D5019 >--------------------------------------------------------------- 8546afc502306de16b62c6386fe419753393cb12 docs/rts/rts.tex | 4 ++-- libraries/base/Control/Monad.hs | 2 +- libraries/base/Control/Monad/ST/Imp.hs | 2 +- libraries/base/Control/Monad/ST/Lazy/Imp.hs | 16 ++++++++-------- libraries/base/Control/Monad/ST/Lazy/Safe.hs | 2 +- libraries/base/Control/Monad/ST/Lazy/Unsafe.hs | 2 +- libraries/base/Data/Functor/Utils.hs | 4 ++-- libraries/base/GHC/Exts.hs | 2 +- libraries/base/GHC/IO.hs | 14 +++++++------- libraries/base/GHC/ST.hs | 12 ++++++------ 10 files changed, 30 insertions(+), 30 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8546afc502306de16b62c6386fe419753393cb12 From git at git.haskell.org Tue Aug 21 22:57:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:19 +0000 (UTC) Subject: [commit: ghc] master: Fix #line pragmas in nested comments (02518f9) Message-ID: <20180821225719.1A4843A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/02518f9d99c2d038384263f9e039efcb09bc96ff/ghc >--------------------------------------------------------------- commit 02518f9d99c2d038384263f9e039efcb09bc96ff Author: Ben Sklaroff Date: Tue Aug 21 12:03:24 2018 -0400 Fix #line pragmas in nested comments When parsing a nested comment or nested doc comment in the lexer, if we see a line starting with '#' we attempt to parse a #line pragma. This fixes how ghc handles output of the C preproccesor (-cpp flag) when the original source has C comments or pragmas inside haskell comments. Updates haddock submodule. Test Plan: ./validate Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #314 Differential Revision: https://phabricator.haskell.org/D4934 >--------------------------------------------------------------- 02518f9d99c2d038384263f9e039efcb09bc96ff compiler/parser/Lexer.x | 166 +++++++++++++++------ testsuite/tests/parser/should_fail/all.T | 3 +- testsuite/tests/parser/should_fail/readFail032.hs | 19 ++- .../tests/parser/should_fail/readFail032.stderr | 13 +- testsuite/tests/parser/should_fail/readFail048.hs | 25 ++++ .../tests/parser/should_fail/readFail048.stderr | 11 ++ utils/haddock | 2 +- 7 files changed, 180 insertions(+), 59 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 02518f9d99c2d038384263f9e039efcb09bc96ff From git at git.haskell.org Tue Aug 21 22:57:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:19 +0000 (UTC) Subject: [commit: ghc] master: Properly tag fun field of PAPs generated by ap_0_fast (2693eb1) Message-ID: <20180821225719.873913A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2693eb11f55f2001701c90c24183e21c794a8be1/ghc >--------------------------------------------------------------- commit 2693eb11f55f2001701c90c24183e21c794a8be1 Author: Ömer Sinan Ağacan Date: Tue Aug 21 16:06:29 2018 -0400 Properly tag fun field of PAPs generated by ap_0_fast Currently ap_0_fast doesn't maintain the invariant for PAP fun fields which says if the closure can be tagged, it should be. This is checked by `Sanity.c:checkPAP` and correctly implemented by `genautoapply`. This causes sanity check failures when we have a profiling code like f = {-# SCC scc #-} g where g is a PAP or a FUN, and `scc` is different than the current cost centre. Test Plan: Slow validate (not done yet) Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15508 Differential Revision: https://phabricator.haskell.org/D5051 >--------------------------------------------------------------- 2693eb11f55f2001701c90c24183e21c794a8be1 rts/Apply.cmm | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/rts/Apply.cmm b/rts/Apply.cmm index 15d8250..7e23609 100644 --- a/rts/Apply.cmm +++ b/rts/Apply.cmm @@ -106,6 +106,9 @@ again: pap = Hp - SIZEOF_StgPAP + WDS(1); SET_HDR(pap, stg_PAP_info, CCCS); StgPAP_arity(pap) = arity; + if (arity <= TAG_MASK) { + fun = untaggedfun + arity; + } StgPAP_fun(pap) = fun; StgPAP_n_args(pap) = 0; return (pap); @@ -117,9 +120,8 @@ again: return (fun); } else { // We're going to copy this PAP, and put the new CCS in it - fun = untaggedfun; W_ size; - size = SIZEOF_StgPAP + WDS(TO_W_(StgPAP_n_args(fun))); + size = SIZEOF_StgPAP + WDS(TO_W_(StgPAP_n_args(untaggedfun))); HP_CHK_GEN(size); TICK_ALLOC_PAP(size, 0); // attribute this allocation to the "overhead of profiling" @@ -127,13 +129,13 @@ again: P_ pap; pap = Hp - size + WDS(1); // We'll lose the original PAP, so we should enter its CCS - ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(fun) "ptr"); + ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(untaggedfun) "ptr"); SET_HDR(pap, stg_PAP_info, CCCS); - StgPAP_arity(pap) = StgPAP_arity(fun); - StgPAP_n_args(pap) = StgPAP_n_args(fun); + StgPAP_arity(pap) = StgPAP_arity(untaggedfun); + StgPAP_n_args(pap) = StgPAP_n_args(untaggedfun); StgPAP_fun(pap) = StgPAP_fun(fun); W_ i; - i = TO_W_(StgPAP_n_args(fun)); + i = TO_W_(StgPAP_n_args(untaggedfun)); loop: if (i == 0) { return (pap); From git at git.haskell.org Tue Aug 21 22:57:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:22 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Deduplicate source in wcompat-warnings test (92db10b) Message-ID: <20180821225722.7ADB33A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/92db10bc061e0054d0a7504de420b5ad7f72a0a0/ghc >--------------------------------------------------------------- commit 92db10bc061e0054d0a7504de420b5ad7f72a0a0 Author: Ben Gamari Date: Tue Aug 21 12:48:34 2018 -0400 testsuite: Deduplicate source in wcompat-warnings test >--------------------------------------------------------------- 92db10bc061e0054d0a7504de420b5ad7f72a0a0 .../{WCompatWarningsOnOff.hs => Template.hs} | 5 +---- .../tests/wcompat-warnings/WCompatWarningsNotOn.hs | 25 ++------------------- .../tests/wcompat-warnings/WCompatWarningsOff.hs | 26 +++------------------- .../tests/wcompat-warnings/WCompatWarningsOn.hs | 26 +++------------------- .../wcompat-warnings/WCompatWarningsOn.stderr | 10 ++++----- .../tests/wcompat-warnings/WCompatWarningsOnOff.hs | 26 +++------------------- testsuite/tests/wcompat-warnings/all.T | 9 ++++---- 7 files changed, 22 insertions(+), 105 deletions(-) diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs b/testsuite/tests/wcompat-warnings/Template.hs similarity index 74% copy from testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs copy to testsuite/tests/wcompat-warnings/Template.hs index 81df757..e3423c8 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs +++ b/testsuite/tests/wcompat-warnings/Template.hs @@ -1,8 +1,4 @@ --- Test purpose: --- Ensure that -Wno-compat disables a previously set -Wcompat {-# LANGUAGE NoMonadFailDesugaring #-} -{-# OPTIONS_GHC -Wcompat #-} -{-# OPTIONS_GHC -Wno-compat #-} module WCompatWarningsOnOff where @@ -24,3 +20,4 @@ instance Semi.Semigroup S where instance Monoid S where S a `mappend` S b = S (a+b) mempty = S 0 + diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsNotOn.hs b/testsuite/tests/wcompat-warnings/WCompatWarningsNotOn.hs index a26c565..7cd6a42 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsNotOn.hs +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsNotOn.hs @@ -1,26 +1,5 @@ -- Test purpose: -- Ensure that not using -Wcompat does not enable its warnings -{-# LANGUAGE NoMonadFailDesugaring #-} --- {-# OPTIONS_GHC -Wcompat #-} --- {-# OPTIONS_GHC -Wno-compat #-} -module WCompatWarningsNotOn where - -import qualified Data.Semigroup as Semi - -monadFail :: Monad m => m a -monadFail = do - Just _ <- undefined - undefined - -(<>) = undefined -- Semigroup warnings - --- -fwarn-noncanonical-monoid-instances -newtype S = S Int - -instance Semi.Semigroup S where - (<>) = mappend - -instance Monoid S where - S a `mappend` S b = S (a+b) - mempty = S 0 +{-# LANGUAGE CPP #-} +#include "Template.hs" diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOff.hs b/testsuite/tests/wcompat-warnings/WCompatWarningsOff.hs index 33c26cc..637fbb3 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOff.hs +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOff.hs @@ -1,26 +1,6 @@ -- Test purpose: -- Ensure that using -Wno-compat does not switch on warnings -{-# LANGUAGE NoMonadFailDesugaring #-} --- {-# OPTIONS_GHC -Wcompat #-} -{-# OPTIONS_GHC -Wno-compat #-} - -module WCompatWarningsOff where - -import qualified Data.Semigroup as Semi - -monadFail :: Monad m => m a -monadFail = do - Just _ <- undefined - undefined -(<>) = undefined -- Semigroup warnings - --- -fwarn-noncanonical-monoid-instances -newtype S = S Int - -instance Semi.Semigroup S where - (<>) = mappend - -instance Monoid S where - S a `mappend` S b = S (a+b) - mempty = S 0 +{-# OPTIONS_GHC -Wno-compat #-} +{-# LANGUAGE CPP #-} +#include "Template.hs" diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.hs b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.hs index 7d9e7de..9c75982 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.hs +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.hs @@ -1,26 +1,6 @@ -- Test purpose: -- Ensure that -Wcompat switches on the right warnings -{-# LANGUAGE NoMonadFailDesugaring #-} -{-# OPTIONS_GHC -Wcompat #-} --- {-# OPTIONS_GHC -Wno-compat #-} - -module WCompatWarningsOn where - -import qualified Data.Semigroup as Semi - -monadFail :: Monad m => m a -monadFail = do - Just _ <- undefined - undefined -(<>) = undefined -- Semigroup warnings - --- -fwarn-noncanonical-monoid-instances -newtype S = S Int - -instance Semi.Semigroup S where - (<>) = mappend - -instance Monoid S where - S a `mappend` S b = S (a+b) - mempty = S 0 +{-# OPTIONS_GHC -Wcompat #-} +{-# LANGUAGE CPP #-} +#include "Template.hs" diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr index c62780f..5c2d9c5 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr @@ -1,12 +1,12 @@ -WCompatWarningsOn.hs:13:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] +Template.hs:9:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] • Could not deduce (Control.Monad.Fail.MonadFail m) arising from the failable pattern ‘Just _’ (this will become an error in a future GHC release) from the context: Monad m bound by the type signature for: monadFail :: forall (m :: * -> *) a. Monad m => m a - at WCompatWarningsOn.hs:11:1-27 + at Template.hs:7:1-27 Possible fix: add (Control.Monad.Fail.MonadFail m) to the context of the type signature for: @@ -20,16 +20,16 @@ WCompatWarningsOn.hs:13:5: warning: [-Wmissing-monadfail-instances (in -Wcompat) = do Just _ <- undefined undefined -WCompatWarningsOn.hs:16:1: warning: [-Wsemigroup (in -Wcompat)] +Template.hs:12:1: warning: [-Wsemigroup (in -Wcompat)] Local definition of ‘<>’ clashes with a future Prelude name. This will become an error in a future release. -WCompatWarningsOn.hs:22:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] +Template.hs:18:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] Noncanonical ‘(<>) = mappend’ definition detected in the instance declaration for ‘Semigroup S’. Move definition from ‘mappend’ to ‘(<>)’ -WCompatWarningsOn.hs:25:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] +Template.hs:21:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] Noncanonical ‘mappend’ definition detected in the instance declaration for ‘Monoid S’. Define as ‘mappend = (<>)’ diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs b/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs index 81df757..d644568 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs @@ -1,26 +1,6 @@ -- Test purpose: -- Ensure that -Wno-compat disables a previously set -Wcompat -{-# LANGUAGE NoMonadFailDesugaring #-} -{-# OPTIONS_GHC -Wcompat #-} -{-# OPTIONS_GHC -Wno-compat #-} -module WCompatWarningsOnOff where - -import qualified Data.Semigroup as Semi - -monadFail :: Monad m => m a -monadFail = do - Just _ <- undefined - undefined - -(<>) = undefined -- Semigroup warnings - --- -fwarn-noncanonical-monoid-instances -newtype S = S Int - -instance Semi.Semigroup S where - (<>) = mappend - -instance Monoid S where - S a `mappend` S b = S (a+b) - mempty = S 0 +{-# OPTIONS_GHC -Wcompat -Wno-compat #-} +{-# LANGUAGE CPP #-} +#include "Template.hs" diff --git a/testsuite/tests/wcompat-warnings/all.T b/testsuite/tests/wcompat-warnings/all.T index 4447f99..5d62466 100644 --- a/testsuite/tests/wcompat-warnings/all.T +++ b/testsuite/tests/wcompat-warnings/all.T @@ -1,4 +1,5 @@ -test('WCompatWarningsOn', normal, compile, ['']) -test('WCompatWarningsOff', normal, compile, ['']) -test('WCompatWarningsNotOn', normal, compile, ['']) -test('WCompatWarningsOnOff', normal, compile, ['']) +# N.B. the source files are all stubs; edit Template.hs +test('WCompatWarningsOn', extra_files(['Template.hs']), compile, ['']) +test('WCompatWarningsOff', extra_files(['Template.hs']), compile, ['']) +test('WCompatWarningsNotOn', extra_files(['Template.hs']), compile, ['']) +test('WCompatWarningsOnOff', extra_files(['Template.hs']), compile, ['']) From git at git.haskell.org Tue Aug 21 22:57:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:23 +0000 (UTC) Subject: [commit: ghc] master: Show -with-rtsopts options in runtime's --info (#15261) (dcf27e6) Message-ID: <20180821225723.530DA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dcf27e6f78529e7e471a4be64ca47398eb1b6b52/ghc >--------------------------------------------------------------- commit dcf27e6f78529e7e471a4be64ca47398eb1b6b52 Author: roland Date: Tue Aug 21 16:05:45 2018 -0400 Show -with-rtsopts options in runtime's --info (#15261) Add an additional line to the output of +RTS --info. It shows the value of the flag -with-rtsopts provided at compile/link time. Test Plan: make test TESTS="T15261a T15261b" Reviewers: hvr, erikd, dfeuer, thomie, austin, bgamari, simonmar, osa1, monoidal Reviewed By: osa1, monoidal Subscribers: osa1, rwbarton, carter GHC Trac Issues: #15261 Differential Revision: https://phabricator.haskell.org/D5053 >--------------------------------------------------------------- dcf27e6f78529e7e471a4be64ca47398eb1b6b52 docs/users_guide/phases.rst | 3 +++ docs/users_guide/runtime_control.rst | 4 ++++ rts/RtsFlags.c | 2 +- rts/RtsUtils.c | 6 ++++-- rts/RtsUtils.h | 2 +- testsuite/tests/rts/T15261/Makefile | 11 +++++++++++ testsuite/tests/rts/T15261/T15261a.hs | 2 ++ testsuite/tests/rts/T15261/T15261a.stdout | 1 + testsuite/tests/rts/T15261/T15261b.hs | 2 ++ testsuite/tests/rts/T15261/T15261b.stdout | 1 + testsuite/tests/rts/T15261/all.T | 2 ++ 11 files changed, 32 insertions(+), 4 deletions(-) diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst index f8fe8d1..531f8c0 100644 --- a/docs/users_guide/phases.rst +++ b/docs/users_guide/phases.rst @@ -1004,6 +1004,9 @@ for example). change RTS options at run-time, in which case ``-with-rtsopts`` would be the *only* way to set them.) + Use the runtime flag :rts-flag:`--info` on the executable program + to see the options set with ``-with-rtsopts``. + Note that ``-with-rtsopts`` has no effect when used with ``-no-hs-main``; see :ref:`using-own-main` for details. diff --git a/docs/users_guide/runtime_control.rst b/docs/users_guide/runtime_control.rst index 797c7e2..0c38ac5 100644 --- a/docs/users_guide/runtime_control.rst +++ b/docs/users_guide/runtime_control.rst @@ -1219,6 +1219,7 @@ Getting information about the RTS ,("Word size", "64") ,("Compiler unregisterised", "NO") ,("Tables next to code", "YES") + ,("Flag -with-rtsopts", "") ] The information is formatted such that it can be read as a of type @@ -1269,3 +1270,6 @@ Getting information about the RTS performance optimisation that is not available on all platforms. This field tells you whether the program has been compiled with this optimisation. (Usually yes, except on unusual platforms.) + + ``Flag -with-rtsopts`` + The value of the GHC flag :ghc-flag:`-with-rtsopts=⟨opts⟩` at compile/link time. diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index 7c292d2..6a72e67 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -901,7 +901,7 @@ error = true; else if (strequal("info", &rts_argv[arg][2])) { OPTION_SAFE; - printRtsInfo(); + printRtsInfo(rtsConfig); stg_exit(0); } #if defined(THREADED_RTS) diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c index 5357dc6..618815d 100644 --- a/rts/RtsUtils.c +++ b/rts/RtsUtils.c @@ -275,7 +275,7 @@ int genericRaise(int sig) { #endif } -static void mkRtsInfoPair(char *key, char *val) { +static void mkRtsInfoPair(const char *key, const char *val) { /* XXX should check for "s, \s etc in key and val */ printf(" ,(\"%s\", \"%s\")\n", key, val); } @@ -285,7 +285,7 @@ static void mkRtsInfoPair(char *key, char *val) { #define TOSTRING2(x) #x #define TOSTRING(x) TOSTRING2(x) -void printRtsInfo(void) { +void printRtsInfo(const RtsConfig rts_config) { /* The first entry is just a hack to make it easy to get the * commas right */ printf(" [(\"GHC RTS\", \"YES\")\n"); @@ -306,6 +306,8 @@ void printRtsInfo(void) { mkRtsInfoPair("Word size", TOSTRING(WORD_SIZE_IN_BITS)); mkRtsInfoPair("Compiler unregisterised", GhcUnregisterised); mkRtsInfoPair("Tables next to code", GhcEnableTablesNextToCode); + mkRtsInfoPair("Flag -with-rtsopts", /* See Trac #15261 */ + rts_config.rts_opts != NULL ? rts_config.rts_opts : ""); printf(" ]\n"); } diff --git a/rts/RtsUtils.h b/rts/RtsUtils.h index 16596c1..49712c0 100644 --- a/rts/RtsUtils.h +++ b/rts/RtsUtils.h @@ -40,7 +40,7 @@ char *showStgWord64(StgWord64, char *, bool); void heapCheckFail( void ); #endif -void printRtsInfo(void); +void printRtsInfo(const RtsConfig); void checkFPUStack(void); diff --git a/testsuite/tests/rts/T15261/Makefile b/testsuite/tests/rts/T15261/Makefile new file mode 100644 index 0000000..f50b22c --- /dev/null +++ b/testsuite/tests/rts/T15261/Makefile @@ -0,0 +1,11 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T15261a: + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -with-rtsopts="-t -s" --make T15261a.hs + ./T15261a +RTS --info | grep "rtsopts" + +T15261b: + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make T15261b.hs + ./T15261b +RTS --info | grep "rtsopts" diff --git a/testsuite/tests/rts/T15261/T15261a.hs b/testsuite/tests/rts/T15261/T15261a.hs new file mode 100644 index 0000000..4c512dc --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261a.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "T15261a" diff --git a/testsuite/tests/rts/T15261/T15261a.stdout b/testsuite/tests/rts/T15261/T15261a.stdout new file mode 100644 index 0000000..5919bb4 --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261a.stdout @@ -0,0 +1 @@ + ,("Flag -with-rtsopts", "-t -s") diff --git a/testsuite/tests/rts/T15261/T15261b.hs b/testsuite/tests/rts/T15261/T15261b.hs new file mode 100644 index 0000000..1304a85 --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261b.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "T15261b" diff --git a/testsuite/tests/rts/T15261/T15261b.stdout b/testsuite/tests/rts/T15261/T15261b.stdout new file mode 100644 index 0000000..80184e8 --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261b.stdout @@ -0,0 +1 @@ + ,("Flag -with-rtsopts", "") diff --git a/testsuite/tests/rts/T15261/all.T b/testsuite/tests/rts/T15261/all.T new file mode 100644 index 0000000..5bc6977 --- /dev/null +++ b/testsuite/tests/rts/T15261/all.T @@ -0,0 +1,2 @@ +test('T15261a', normal, run_command, ['$MAKE -s --no-print-directory T15261a']) +test('T15261b', normal, run_command, ['$MAKE -s --no-print-directory T15261b']) From git at git.haskell.org Tue Aug 21 22:57:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:25 +0000 (UTC) Subject: [commit: ghc] master: function-section: enable on windows (23774c9) Message-ID: <20180821225725.4C1C43A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23774c98f1368b41515cbd5223b87ea6dbf644e1/ghc >--------------------------------------------------------------- commit 23774c98f1368b41515cbd5223b87ea6dbf644e1 Author: Tamar Christina Date: Tue Aug 21 12:13:06 2018 -0400 function-section: enable on windows gc-sections was onced observed to be slow on Windows, which is the only reason it's not enabled yet. However, it seems to be better now. Test Plan: ./validate Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15051 Differential Revision: https://phabricator.haskell.org/D4916 >--------------------------------------------------------------- 23774c98f1368b41515cbd5223b87ea6dbf644e1 mk/config.mk.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mk/config.mk.in b/mk/config.mk.in index 1105012..e4a79a1 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -365,7 +365,7 @@ SplitObjs = $(if $(and $(filter YES,$(SupportsSplitObjs)),\ # This is not supported on Darwin (where you can use subsections-via-symbols # instead) and Windows is disabled until we figure the linking performance # issues related to BFD out. (See #11445, #12913 and related tickets.) -OsSupportsSplitSections=$(if $(filter $(TargetOS_CPP),mingw32 darwin),NO,YES) +OsSupportsSplitSections=$(if $(filter $(TargetOS_CPP),darwin),NO,YES) SupportsSplitSections=$(if $(and $(filter YES,$(OsSupportsSplitSections)),\ $(filter YES,$(LdIsGNULd))),YES,NO) SplitSections ?= $(SupportsSplitSections) From git at git.haskell.org Tue Aug 21 22:57:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:28 +0000 (UTC) Subject: [commit: ghc] master: Replace most occurences of foldl with foldl'. (09c1d5a) Message-ID: <20180821225728.622E23A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/09c1d5afba655a2427a448a9933bebe7d13b696b/ghc >--------------------------------------------------------------- commit 09c1d5afba655a2427a448a9933bebe7d13b696b Author: klebinger.andreas at gmx.at Date: Tue Aug 21 12:10:38 2018 -0400 Replace most occurences of foldl with foldl'. This patch adds foldl' to GhcPrelude and changes must occurences of foldl to foldl'. This leads to better performance especially for quick builds where GHC does not perform strictness analysis. It does change strictness behaviour when we use foldl' to turn a argument list into function applications. But this is only a drawback if code looks ONLY at the last argument but not at the first. And as the benchmarks show leads to fewer allocations in practice at O2. Compiler performance for Nofib: O2 Allocations: -1 s.d. ----- -0.0% +1 s.d. ----- -0.0% Average ----- -0.0% O2 Compile Time: -1 s.d. ----- -2.8% +1 s.d. ----- +1.3% Average ----- -0.8% O0 Allocations: -1 s.d. ----- -0.2% +1 s.d. ----- -0.1% Average ----- -0.2% Test Plan: ci Reviewers: goldfire, bgamari, simonmar, tdammers, monoidal Reviewed By: bgamari, monoidal Subscribers: tdammers, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4929 >--------------------------------------------------------------- 09c1d5afba655a2427a448a9933bebe7d13b696b compiler/basicTypes/Avail.hs | 2 +- compiler/basicTypes/NameCache.hs | 2 +- compiler/basicTypes/NameSet.hs | 2 +- compiler/basicTypes/OccName.hs | 2 +- compiler/basicTypes/RdrName.hs | 4 ++-- compiler/basicTypes/VarEnv.hs | 2 +- compiler/cmm/CmmContFlowOpt.hs | 1 - compiler/cmm/CmmExpr.hs | 1 - compiler/cmm/CmmSink.hs | 1 - compiler/cmm/Hoopl/Dataflow.hs | 1 - compiler/codeGen/StgCmmMonad.hs | 2 +- compiler/coreSyn/CoreArity.hs | 2 +- compiler/coreSyn/CoreMap.hs | 4 ++-- compiler/coreSyn/CoreOpt.hs | 4 ++-- compiler/coreSyn/CoreSyn.hs | 8 ++++---- compiler/deSugar/DsExpr.hs | 2 +- compiler/deSugar/DsForeign.hs | 2 +- compiler/deSugar/DsMeta.hs | 2 +- compiler/deSugar/DsUtils.hs | 2 +- compiler/deSugar/Match.hs | 4 ++-- compiler/hsSyn/HsTypes.hs | 3 ++- compiler/hsSyn/HsUtils.hs | 14 +++++++------- compiler/iface/MkIface.hs | 2 +- compiler/iface/TcIface.hs | 1 - compiler/iface/ToIface.hs | 2 +- compiler/main/Ar.hs | 2 +- compiler/main/DynFlags.hs | 2 +- compiler/main/GhcMake.hs | 2 +- compiler/main/HscTypes.hs | 5 ++--- compiler/main/Packages.hs | 4 ++-- compiler/nativeGen/AsmCodeGen.hs | 4 ++-- compiler/nativeGen/RegAlloc/Graph/Coalesce.hs | 2 -- compiler/nativeGen/RegAlloc/Graph/Main.hs | 1 - compiler/nativeGen/RegAlloc/Graph/Stats.hs | 3 --- compiler/nativeGen/RegAlloc/Linear/Stats.hs | 1 - compiler/prelude/PrelInfo.hs | 4 ++-- compiler/rename/RnNames.hs | 2 +- compiler/simplCore/CallArity.hs | 2 +- compiler/simplCore/FloatIn.hs | 4 ++-- compiler/simplCore/OccurAnal.hs | 2 +- compiler/simplCore/SetLevels.hs | 18 +++++++++--------- compiler/simplCore/Simplify.hs | 4 ++-- compiler/specialise/Rules.hs | 4 ++-- compiler/specialise/Specialise.hs | 2 +- compiler/stranal/DmdAnal.hs | 4 ++-- compiler/typecheck/FunDeps.hs | 2 +- compiler/typecheck/TcEvidence.hs | 2 +- compiler/typecheck/TcExpr.hs | 2 +- compiler/typecheck/TcGenDeriv.hs | 4 ++-- compiler/typecheck/TcGenFunctor.hs | 2 +- compiler/typecheck/TcInstDcls.hs | 4 ++-- compiler/typecheck/TcPatSyn.hs | 6 +++--- compiler/typecheck/TcRnTypes.hs | 2 +- compiler/typecheck/TcSigs.hs | 2 +- compiler/typecheck/TcSplice.hs | 2 +- compiler/typecheck/TcType.hs | 6 +++--- compiler/typecheck/TcValidity.hs | 2 +- compiler/types/Coercion.hs | 8 ++++---- compiler/types/FamInstEnv.hs | 2 +- compiler/types/InstEnv.hs | 2 +- compiler/types/Type.hs | 4 ++-- compiler/types/Unify.hs | 2 +- compiler/utils/FiniteMap.hs | 6 +++--- compiler/utils/GhcPrelude.hs | 2 ++ compiler/utils/ListSetOps.hs | 2 +- compiler/utils/UnVarGraph.hs | 1 - compiler/utils/UniqDFM.hs | 12 ++++++------ compiler/utils/UniqDSet.hs | 4 ++-- compiler/utils/UniqFM.hs | 18 ++++++++---------- 69 files changed, 115 insertions(+), 128 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 09c1d5afba655a2427a448a9933bebe7d13b696b From git at git.haskell.org Tue Aug 21 22:57:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:31 +0000 (UTC) Subject: [commit: ghc] master: Simplify callSiteInline a little (8a05836) Message-ID: <20180821225731.35A7C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8a05836a6cb58274e41aec9e44ea2fa732b2f840/ghc >--------------------------------------------------------------- commit 8a05836a6cb58274e41aec9e44ea2fa732b2f840 Author: Simon Peyton Jones Date: Fri May 4 15:47:31 2018 +0100 Simplify callSiteInline a little This patch has virtually no effect on anything (according to a nofib run). But it simplifies the definition of interesting_call by being a bit less gung-ho about inlining nested function bindings. See Note [Nested functions] ----------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem ----------------------------------------------------------------------- anna +0.2% -0.0% 0.163 0.163 0.0% binary-trees +0.1% +0.0% -4.5% -4.5% 0.0% cacheprof -0.1% +0.1% -4.7% -4.8% +2.7% fasta +0.2% 0.0% +2.6% +3.0% 0.0% fluid -0.0% -0.6% 0.011 0.011 0.0% gamteb -0.1% -0.0% 0.069 0.070 0.0% hpg +0.1% +0.0% +0.7% +0.7% 0.0% infer +0.3% +0.2% 0.097 0.098 0.0% lambda -0.1% -0.0% +2.0% +2.0% 0.0% n-body +0.1% -0.1% -0.1% -0.1% 0.0% simple -0.2% -0.2% +0.6% +0.6% 0.0% spectral-norm +0.1% -0.0% -0.1% -0.1% 0.0% tak -0.0% -0.1% 0.024 0.024 0.0% -------------------------------------------------------------------------------- Min -0.4% -0.6% -5.3% -5.3% 0.0% Max +0.3% +0.2% +3.3% +3.3% +15.0% Geometric Mean -0.0% -0.0% -0.3% -0.3% +0.2% (cherry picked from commit 33de71fa06d03e6da396a7c0a314fea3b492ab91) (This reverts the previous reversion in commit 9dbf66d74e65309d02c9d700094e363f59c94096) >--------------------------------------------------------------- 8a05836a6cb58274e41aec9e44ea2fa732b2f840 compiler/coreSyn/CoreUnfold.hs | 33 ++++++++++++++++----------------- 1 file changed, 16 insertions(+), 17 deletions(-) diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index 7bd512d..68e7290 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -1153,11 +1153,11 @@ callSiteInline dflags id active_unfolding lone_variable arg_infos cont_info -- idUnfolding checks for loop-breakers, returning NoUnfolding -- Things with an INLINE pragma may have an unfolding *and* -- be a loop breaker (maybe the knot is not yet untied) - CoreUnfolding { uf_tmpl = unf_template, uf_is_top = is_top + CoreUnfolding { uf_tmpl = unf_template , uf_is_work_free = is_wf , uf_guidance = guidance, uf_expandable = is_exp } | active_unfolding -> tryUnfolding dflags id lone_variable - arg_infos cont_info unf_template is_top + arg_infos cont_info unf_template is_wf is_exp guidance | otherwise -> traceInline dflags id "Inactive unfolding:" (ppr id) Nothing NoUnfolding -> Nothing @@ -1177,10 +1177,10 @@ traceInline dflags inline_id str doc result = result tryUnfolding :: DynFlags -> Id -> Bool -> [ArgSummary] -> CallCtxt - -> CoreExpr -> Bool -> Bool -> Bool -> UnfoldingGuidance + -> CoreExpr -> Bool -> Bool -> UnfoldingGuidance -> Maybe CoreExpr tryUnfolding dflags id lone_variable - arg_infos cont_info unf_template is_top + arg_infos cont_info unf_template is_wf is_exp guidance = case guidance of UnfNever -> traceInline dflags id str (text "UnfNever") Nothing @@ -1252,10 +1252,10 @@ tryUnfolding dflags id lone_variable CaseCtxt -> not (lone_variable && is_exp) -- Note [Lone variables] ValAppCtxt -> True -- Note [Cast then apply] RuleArgCtxt -> uf_arity > 0 -- See Note [Unfold info lazy contexts] - DiscArgCtxt -> uf_arity > 0 -- + DiscArgCtxt -> uf_arity > 0 -- Note [Inlining in ArgCtxt] RhsCtxt -> uf_arity > 0 -- - _ -> not is_top && uf_arity > 0 -- Note [Nested functions] - -- Note [Inlining in ArgCtxt] + _other -> False -- See Note [Nested functions] + {- Note [Unfold into lazy contexts], Note [RHS of lets] @@ -1325,18 +1325,17 @@ However for worker/wrapper it may be worth inlining even if the arity is not satisfied (as we do in the CoreUnfolding case) so we don't require saturation. - Note [Nested functions] ~~~~~~~~~~~~~~~~~~~~~~~ -If a function has a nested defn we also record some-benefit, on the -grounds that we are often able to eliminate the binding, and hence the -allocation, for the function altogether; this is good for join points. -But this only makes sense for *functions*; inlining a constructor -doesn't help allocation unless the result is scrutinised. UNLESS the -constructor occurs just once, albeit possibly in multiple case -branches. Then inlining it doesn't increase allocation, but it does -increase the chance that the constructor won't be allocated at all in -the branches that don't use it. +At one time we treated a call of a non-top-level function as +"interesting" (regardless of how boring the context) in the hope +that inlining it would eliminate the binding, and its allocation. +Specifically, in the default case of interesting_call we had + _other -> not is_top && uf_arity > 0 + +But actually postInlineUnconditionally does some of this and overall +it makes virtually no difference to nofib. So I simplified away this +special case Note [Cast then apply] ~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Tue Aug 21 22:57:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:34 +0000 (UTC) Subject: [commit: ghc] master: Introduce flag -keep-hscpp-files (ebcbfba) Message-ID: <20180821225734.A879C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ebcbfba7bbf07fa9fbb78b46951892997795bcb8/ghc >--------------------------------------------------------------- commit ebcbfba7bbf07fa9fbb78b46951892997795bcb8 Author: roland Date: Tue Aug 21 12:18:26 2018 -0400 Introduce flag -keep-hscpp-files Test Plan: `make test=T10869` Reviewers: mpickering, thomie, ezyang, bgamari Reviewed By: thomie, bgamari Subscribers: rwbarton, carter GHC Trac Issues: #10869 Differential Revision: https://phabricator.haskell.org/D4861 >--------------------------------------------------------------- ebcbfba7bbf07fa9fbb78b46951892997795bcb8 compiler/main/DriverPipeline.hs | 2 ++ compiler/main/DynFlags.hs | 5 +++++ docs/users_guide/8.8.1-notes.rst | 1 + docs/users_guide/separate_compilation.rst | 13 +++++++++++++ testsuite/tests/driver/Makefile | 8 ++++++++ testsuite/tests/driver/T10869.hs | 9 +++++++++ testsuite/tests/driver/T10869A.hs | 7 +++++++ testsuite/tests/driver/all.T | 2 ++ 8 files changed, 47 insertions(+) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 68f69fc..eff542a 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -762,6 +762,7 @@ getOutputFilename stop_phase output basename dflags next_phase maybe_location odir = objectDir dflags osuf = objectSuf dflags keep_hc = gopt Opt_KeepHcFiles dflags + keep_hscpp = gopt Opt_KeepHscppFiles dflags keep_s = gopt Opt_KeepSFiles dflags keep_bc = gopt Opt_KeepLlvmFiles dflags @@ -778,6 +779,7 @@ getOutputFilename stop_phase output basename dflags next_phase maybe_location As _ | keep_s -> True LlvmOpt | keep_bc -> True HCc | keep_hc -> True + HsPp _ | keep_hscpp -> True -- See Trac #10869 _other -> False suffix = myPhaseInputExt next_phase diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index ff4766f..be14879 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -618,6 +618,7 @@ data GeneralFlag | Opt_ImplicitImportQualified -- keeping stuff + | Opt_KeepHscppFiles | Opt_KeepHiDiffs | Opt_KeepHcFiles | Opt_KeepSFiles @@ -2961,6 +2962,10 @@ dynamic_flags_deps = [ (NoArg (setGeneralFlag Opt_KeepHcFiles)) , make_ord_flag defGhcFlag "keep-hc-files" (NoArg (setGeneralFlag Opt_KeepHcFiles)) + , make_ord_flag defGhcFlag "keep-hscpp-file" + (NoArg (setGeneralFlag Opt_KeepHscppFiles)) + , make_ord_flag defGhcFlag "keep-hscpp-files" + (NoArg (setGeneralFlag Opt_KeepHscppFiles)) , make_ord_flag defGhcFlag "keep-s-file" (NoArg (setGeneralFlag Opt_KeepSFiles)) , make_ord_flag defGhcFlag "keep-s-files" diff --git a/docs/users_guide/8.8.1-notes.rst b/docs/users_guide/8.8.1-notes.rst index 2661b33..7ea2c87 100644 --- a/docs/users_guide/8.8.1-notes.rst +++ b/docs/users_guide/8.8.1-notes.rst @@ -30,6 +30,7 @@ Language Compiler ~~~~~~~~ +- New :ghc-flag:`-keep-hscpp-files` to keep the output of the CPP pre-processor. Runtime system ~~~~~~~~~~~~~~ diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst index 613e4de..d17ed21 100644 --- a/docs/users_guide/separate_compilation.rst +++ b/docs/users_guide/separate_compilation.rst @@ -397,6 +397,19 @@ compilation: Keep intermediate ``.hi`` files. This is the default. You may use ``-no-keep-hi-files`` if you are not interested in the ``.hi`` files. +.. ghc-flag:: -keep-hscpp-file + -keep-hscpp-files + :shortdesc: Retain intermediate ``.hscpp`` files. + :type: dynamic + :category: keep-intermediates + + .. index:: + single: temporary files; keeping + + Keep the output of the ``CPP`` pre-processor phase as ``.hscpp`` files. + A ``.hscpp`` file is only created, if a module gets compiled and uses the + C pre-processor. + .. ghc-flag:: -keep-llvm-file -keep-llvm-files :shortdesc: Retain intermediate LLVM ``.ll`` files. diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile index 727cc44..540f158 100644 --- a/testsuite/tests/driver/Makefile +++ b/testsuite/tests/driver/Makefile @@ -619,6 +619,14 @@ T10320: "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -fforce-recomp -ddump-to-file -ddump-rule-rewrites T10320.hs [ -f T10320.dump-rule-rewrites ] && [ ! -s T10320.dump-rule-rewrites ] +.PHONY: T10869 +T10869: + $(RM) -rf T10869.hi T10869.o T10869.hspp T10869 + $(RM) -rf T10869A.hi T10869A.o T10869A.hspp + "$(TEST_HC)" $(TEST_HC_OPTS) -c -keep-hscpp-files T10869A.hs T10869.hs + test -f T10869.hscpp + test -f T10869A.hscpp + .PHONY: T12135 T12135: $(RM) -rf T12135.o T12135.hi T12135 T12135a T12135b diff --git a/testsuite/tests/driver/T10869.hs b/testsuite/tests/driver/T10869.hs new file mode 100644 index 0000000..e151854 --- /dev/null +++ b/testsuite/tests/driver/T10869.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE CPP #-} + +module T10869 where +import T10869A + +main :: IO() +#if defined(__GLASGOW_HASKELL__) +main = writeMsg +#endif diff --git a/testsuite/tests/driver/T10869A.hs b/testsuite/tests/driver/T10869A.hs new file mode 100644 index 0000000..14e5777 --- /dev/null +++ b/testsuite/tests/driver/T10869A.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE CPP #-} +module T10869A (writeMsg) where + +writeMsg :: IO () +#if defined(__GLASGOW_HASKELL__) +writeMsg = putStrLn "Hello HSPP File" +#endif diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 07dc3bf..be91a26 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -234,6 +234,8 @@ test('T10220', normal, run_command, test('T10182', [], run_command, ['$MAKE -s --no-print-directory T10182']) +test('T10869', [], run_command, ['$MAKE -s --no-print-directory T10869']) + test('T365', [pre_cmd('touch test_preprocessor.txt'), unless(opsys('mingw32'), skip)], compile_fail, ['']) From git at git.haskell.org Tue Aug 21 22:57:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:37 +0000 (UTC) Subject: [commit: ghc] master: Explicitly tell 'getNameToInstances' mods to load (c971e11) Message-ID: <20180821225737.80D233A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c971e1193fa44bb507d1806d5bb61768670dc912/ghc >--------------------------------------------------------------- commit c971e1193fa44bb507d1806d5bb61768670dc912 Author: Alec Theriault Date: Tue Aug 21 16:03:40 2018 -0400 Explicitly tell 'getNameToInstances' mods to load Calculating which modules to load based on the InteractiveContext means maintaining a potentially very large GblRdrEnv. In Haddock's case, it is much cheaper (from a memory perspective) to just keep track of which modules interfaces we want loaded then hand these off explicitly to 'getNameToInstancesIndex'. Bumps haddock submodule. Reviewers: alexbiehl, bgamari Reviewed By: alexbiehl Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5003 >--------------------------------------------------------------- c971e1193fa44bb507d1806d5bb61768670dc912 compiler/main/GHC.hs | 18 +++++++++++++----- utils/haddock | 2 +- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 0e20e21..29921de 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -300,7 +300,8 @@ import HscMain import GhcMake import DriverPipeline ( compileOne' ) import GhcMonad -import TcRnMonad ( finalSafeMode, fixSafeInstances ) +import TcRnMonad ( finalSafeMode, fixSafeInstances, initIfaceTcRn ) +import LoadIface ( loadSysInterface ) import TcRnTypes import Packages import NameSet @@ -1247,13 +1248,20 @@ getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env) -- by 'Name'. Each name's lists will contain every instance in which that name -- is mentioned in the instance head. getNameToInstancesIndex :: GhcMonad m - => [Module] -- ^ visible modules. An orphan instance will be returned if and - -- only it is visible from at least one module in the list. + => [Module] -- ^ visible modules. An orphan instance will be returned + -- if it is visible from at least one module in the list. + -> Maybe [Module] -- ^ modules to load. If this is not specified, we load + -- modules for everything that is in scope unqualified. -> m (Messages, Maybe (NameEnv ([ClsInst], [FamInst]))) -getNameToInstancesIndex visible_mods = do +getNameToInstancesIndex visible_mods mods_to_load = do hsc_env <- getSession liftIO $ runTcInteractive hsc_env $ - do { loadUnqualIfaces hsc_env (hsc_IC hsc_env) + do { case mods_to_load of + Nothing -> loadUnqualIfaces hsc_env (hsc_IC hsc_env) + Just mods -> + let doc = text "Need interface for reporting instances in scope" + in initIfaceTcRn $ mapM_ (loadSysInterface doc) mods + ; InstEnvs {ie_global, ie_local} <- tcGetInstEnvs ; let visible_mods' = mkModuleSet visible_mods ; (pkg_fie, home_fie) <- tcGetFamInstEnvs diff --git a/utils/haddock b/utils/haddock index 488aa22..9ef12f3 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 488aa22f393c0addb4c0e0b63cfe0aaea32b85d7 +Subproject commit 9ef12f3c2f0ef2948e6f4bd38fdfa002c416ab09 From git at git.haskell.org Tue Aug 21 22:57:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:40 +0000 (UTC) Subject: [commit: ghc] master: Fix ambiguous/out-of-scope Haddock identifiers (ddffa0c) Message-ID: <20180821225740.6E5B93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ddffa0cd8da568c97011007fc6470c61cd4447e5/ghc >--------------------------------------------------------------- commit ddffa0cd8da568c97011007fc6470c61cd4447e5 Author: Alec Theriault Date: Tue Aug 21 16:05:16 2018 -0400 Fix ambiguous/out-of-scope Haddock identifiers This drastically cuts down on the number of Haddock warnings when making docs for `base`. Plus this means more actual links end up in the docs! Also fixed other small mostly markup issues in the documentation along the way. This is a docs-only change. Reviewers: hvr, bgamari, thomie Reviewed By: thomie Subscribers: thomie, rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5055 >--------------------------------------------------------------- ddffa0cd8da568c97011007fc6470c61cd4447e5 libraries/base/Control/Arrow.hs | 4 +-- libraries/base/Control/Concurrent/Chan.hs | 4 +-- libraries/base/Control/Concurrent/MVar.hs | 8 ++--- libraries/base/Control/Exception.hs | 19 ++++++----- libraries/base/Control/Monad.hs | 4 +-- libraries/base/Control/Monad/Fail.hs | 4 +-- libraries/base/Control/Monad/Fix.hs | 2 +- libraries/base/Control/Monad/ST/Imp.hs | 2 +- libraries/base/Data/Bifoldable.hs | 2 +- libraries/base/Data/Bitraversable.hs | 30 +++++------------ libraries/base/Data/Either.hs | 2 +- libraries/base/Data/Foldable.hs | 4 +-- libraries/base/Data/Function.hs | 8 +++-- libraries/base/Data/Functor.hs | 31 +++++++++-------- libraries/base/Data/Functor/Const.hs | 4 +-- libraries/base/Data/Functor/Contravariant.hs | 2 +- libraries/base/Data/List.hs | 4 +-- libraries/base/Data/List/NonEmpty.hs | 2 +- libraries/base/Data/Maybe.hs | 6 ++-- libraries/base/Data/Monoid.hs | 14 ++++---- libraries/base/Data/Traversable.hs | 4 +-- libraries/base/Debug/Trace.hs | 5 +-- libraries/base/Foreign/C/Types.hs | 11 +++--- libraries/base/Foreign/Concurrent.hs | 23 +++++++------ libraries/base/GHC/Arr.hs | 8 ++--- libraries/base/GHC/Base.hs | 24 ++++++------- libraries/base/GHC/Conc/IO.hs | 4 +-- libraries/base/GHC/Conc/Sync.hs | 11 +++--- libraries/base/GHC/Environment.hs | 8 ++--- libraries/base/GHC/Event/Internal.hs | 2 +- libraries/base/GHC/Event/Thread.hs | 8 ++--- libraries/base/GHC/Float.hs | 2 +- libraries/base/GHC/Foreign.hs | 3 +- libraries/base/GHC/ForeignPtr.hs | 11 +++--- libraries/base/GHC/Generics.hs | 50 +++++++++++++--------------- libraries/base/GHC/IO/BufferedIO.hs | 4 +-- libraries/base/GHC/IO/Device.hs | 4 +-- libraries/base/GHC/IO/Encoding.hs | 7 ++-- libraries/base/GHC/IO/Encoding/Failure.hs | 4 +-- libraries/base/GHC/IO/Encoding/Types.hs | 4 +-- libraries/base/GHC/IO/Exception.hs | 3 +- libraries/base/GHC/IO/Handle.hs | 44 ++++++++++++------------ libraries/base/GHC/IO/Handle/FD.hs | 10 +++--- libraries/base/GHC/IO/Handle/Text.hs | 16 ++++----- libraries/base/GHC/IO/Unsafe.hs | 3 +- libraries/base/GHC/Maybe.hs | 2 +- libraries/base/GHC/Natural.hs | 22 ++++++------ libraries/base/GHC/Num.hs | 4 +-- libraries/base/GHC/RTS/Flags.hsc | 32 +++++++++--------- libraries/base/GHC/Real.hs | 2 +- libraries/base/GHC/ResponseFile.hs | 2 +- libraries/base/GHC/Stable.hs | 2 +- libraries/base/GHC/StaticPtr.hs | 4 +-- libraries/base/GHC/TypeLits.hs | 2 +- libraries/base/GHC/Unicode.hs | 2 +- libraries/base/System/Exit.hs | 2 +- libraries/base/System/IO.hs | 9 ++--- libraries/base/Type/Reflection.hs | 2 +- 58 files changed, 262 insertions(+), 254 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ddffa0cd8da568c97011007fc6470c61cd4447e5 From git at git.haskell.org Tue Aug 21 22:57:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:43 +0000 (UTC) Subject: [commit: ghc] master: base: Mark `findIndices` as INLINABLE instead of INLINE (fixes #15426) (1481762) Message-ID: <20180821225743.C15BE3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/14817621aae2d45f8272a36b171b9ccce8763bba/ghc >--------------------------------------------------------------- commit 14817621aae2d45f8272a36b171b9ccce8763bba Author: Kevin Buhr Date: Tue Aug 21 16:04:59 2018 -0400 base: Mark `findIndices` as INLINABLE instead of INLINE (fixes #15426) If `findIndices` is marked INLINE in `Data.OldList`, then the unfolded versions of `elemIndex` and `findIndex` included in the interface file are unfusible (even though `findIndices` itself remains fusible). By marking it INLINABLE instead, elemIndex` and `findIndex` will fuse properly. Test Plan: make TEST=T15426 Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, carter GHC Trac Issues: #15426 Differential Revision: https://phabricator.haskell.org/D5063 >--------------------------------------------------------------- 14817621aae2d45f8272a36b171b9ccce8763bba libraries/base/Data/OldList.hs | 4 +++- testsuite/tests/perf/should_run/T15426.hs | 13 +++++++++++++ testsuite/tests/perf/should_run/all.T | 9 +++++++++ 3 files changed, 25 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/OldList.hs b/libraries/base/Data/OldList.hs index c4c38d4..ee2dfac 100644 --- a/libraries/base/Data/OldList.hs +++ b/libraries/base/Data/OldList.hs @@ -310,7 +310,9 @@ findIndices :: (a -> Bool) -> [a] -> [Int] findIndices p xs = [ i | (x,i) <- zip xs [0..], p x] #else -- Efficient definition, adapted from Data.Sequence -{-# INLINE findIndices #-} +-- (Note that making this INLINABLE instead of INLINE allows +-- 'findIndex' to fuse, fixing #15426.) +{-# INLINABLE findIndices #-} findIndices p ls = build $ \c n -> let go x r k | p x = I# k `c` r (k +# 1#) | otherwise = r (k +# 1#) diff --git a/testsuite/tests/perf/should_run/T15426.hs b/testsuite/tests/perf/should_run/T15426.hs new file mode 100644 index 0000000..de88c28 --- /dev/null +++ b/testsuite/tests/perf/should_run/T15426.hs @@ -0,0 +1,13 @@ +import Control.Exception (evaluate) +import Data.List + +-- The following will fuse with minimal heap usage provided +-- `findIndices` is marked `INLINABLE` instead of `INLINE`. + +unsafeFindIndex p = head . findIndices p + +main = do evaluate $ elemIndex 999999 [(1::Int)..1000000] + evaluate $ elemIndices 999999 [(1::Int)..1000000] + evaluate $ findIndex (>=999999) [(1::Int)..1000000] + evaluate $ findIndices (>=999999) [(1::Int)..1000000] + evaluate $ unsafeFindIndex (>=999999) [(1::Int)..1000000] diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 9705a08..6a7bcf0 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -595,3 +595,12 @@ test('T15226a', only_ways(['normal'])], compile_and_run, ['-O']) + +test('T15426', + [stats_num_field('bytes allocated', + [ (wordsize(64), 41272, 20) ]), + # 2018-08-10 41272 Change findIndices from INLINE to INLINABLE + # initial 160041176 + only_ways(['normal'])], + compile_and_run, + ['-O2']) From git at git.haskell.org Tue Aug 21 22:57:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:46 +0000 (UTC) Subject: [commit: ghc] master: rts/RetainerProfile: Dump closure type if pop() fails (2bacf6f) Message-ID: <20180821225746.9851A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2bacf6f8842d8e1288917e358ed41e4c61b7948e/ghc >--------------------------------------------------------------- commit 2bacf6f8842d8e1288917e358ed41e4c61b7948e Author: Ryan Scott Date: Tue Aug 21 16:04:45 2018 -0400 rts/RetainerProfile: Dump closure type if pop() fails While investigating #15529, I noticed that the `barf`ed error message in `pop()` doesn't print out the closure type that causes it to crash. Let's do so. Reviewers: bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, carter GHC Trac Issues: #15529 Differential Revision: https://phabricator.haskell.org/D5072 >--------------------------------------------------------------- 2bacf6f8842d8e1288917e358ed41e4c61b7948e rts/RetainerProfile.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index 6a0af21..9458b13 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -897,7 +897,7 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) case IND: case INVALID_OBJECT: default: - barf("Invalid object *c in pop()"); + barf("Invalid object *c in pop(): %d", get_itbl(se->c)->type); return; } } while (true); From git at git.haskell.org Tue Aug 21 22:57:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:50 +0000 (UTC) Subject: [commit: ghc] master: Add traceBinaryEvent# primop (21f0f56) Message-ID: <20180821225750.7BA2F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/21f0f56164f50844c2150c62f950983b2376f8b6/ghc >--------------------------------------------------------------- commit 21f0f56164f50844c2150c62f950983b2376f8b6 Author: Mitsutoshi Aoe Date: Tue Aug 21 16:08:17 2018 -0400 Add traceBinaryEvent# primop This adds a new primop called traceBinaryEvent# that takes the length of binary data and a pointer to the data, then emits it to the eventlog. There is some example code that uses this primop and the new event: * [traceBinaryEventIO][1] that calls `traceBinaryEvent#` * [A patch to ghc-events][2] that parses the new `EVENT_USER_BINARY_MSG` There's no corresponding issue on Trac but it was discussed at ghc-devs [3]. [1] https://github.com/maoe/ghc-trace-events/blob /fb226011ef1f85a97b4da7cc9d5f98f9fe6316ae/src/Debug/Trace/Binary.hs#L29) [2] https://github.com/maoe/ghc-events/commit /239ca77c24d18cdd10d6d85a0aef98e4a7c56ae6) [3] https://mail.haskell.org/pipermail/ghc-devs/2018-May/015791.html Reviewers: bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5007 >--------------------------------------------------------------- 21f0f56164f50844c2150c62f950983b2376f8b6 compiler/prelude/primops.txt.pp | 14 ++++++-- includes/rts/EventLogFormat.h | 6 +++- includes/stg/MiscClosures.h | 1 + rts/PrimOps.cmm | 8 +++++ rts/RtsSymbols.c | 1 + rts/Trace.c | 11 ++++++ rts/Trace.h | 5 +++ rts/eventlog/EventLog.c | 54 +++++++++++++++++++++++++---- rts/eventlog/EventLog.h | 3 ++ testsuite/tests/rts/all.T | 4 +++ testsuite/tests/rts/traceBinaryEvent.hs | 25 +++++++++++++ testsuite/tests/rts/traceBinaryEvent.stderr | 1 + testsuite/tests/rts/traceEvent.hs | 5 +++ testsuite/tests/rts/traceEvent.stderr | 1 + 14 files changed, 130 insertions(+), 9 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 21f0f56164f50844c2150c62f950983b2376f8b6 From git at git.haskell.org Tue Aug 21 22:57:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:54 +0000 (UTC) Subject: [commit: ghc] master: Show -with-rtsopts options in runtime's --info (#15261) (dcf27e6) Message-ID: <20180821225754.4A8F33A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dcf27e6f78529e7e471a4be64ca47398eb1b6b52/ghc >--------------------------------------------------------------- commit dcf27e6f78529e7e471a4be64ca47398eb1b6b52 Author: roland Date: Tue Aug 21 16:05:45 2018 -0400 Show -with-rtsopts options in runtime's --info (#15261) Add an additional line to the output of +RTS --info. It shows the value of the flag -with-rtsopts provided at compile/link time. Test Plan: make test TESTS="T15261a T15261b" Reviewers: hvr, erikd, dfeuer, thomie, austin, bgamari, simonmar, osa1, monoidal Reviewed By: osa1, monoidal Subscribers: osa1, rwbarton, carter GHC Trac Issues: #15261 Differential Revision: https://phabricator.haskell.org/D5053 >--------------------------------------------------------------- dcf27e6f78529e7e471a4be64ca47398eb1b6b52 docs/users_guide/phases.rst | 3 +++ docs/users_guide/runtime_control.rst | 4 ++++ rts/RtsFlags.c | 2 +- rts/RtsUtils.c | 6 ++++-- rts/RtsUtils.h | 2 +- testsuite/tests/rts/T15261/Makefile | 11 +++++++++++ testsuite/tests/rts/T15261/T15261a.hs | 2 ++ testsuite/tests/rts/T15261/T15261a.stdout | 1 + testsuite/tests/rts/T15261/T15261b.hs | 2 ++ testsuite/tests/rts/T15261/T15261b.stdout | 1 + testsuite/tests/rts/T15261/all.T | 2 ++ 11 files changed, 32 insertions(+), 4 deletions(-) diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst index f8fe8d1..531f8c0 100644 --- a/docs/users_guide/phases.rst +++ b/docs/users_guide/phases.rst @@ -1004,6 +1004,9 @@ for example). change RTS options at run-time, in which case ``-with-rtsopts`` would be the *only* way to set them.) + Use the runtime flag :rts-flag:`--info` on the executable program + to see the options set with ``-with-rtsopts``. + Note that ``-with-rtsopts`` has no effect when used with ``-no-hs-main``; see :ref:`using-own-main` for details. diff --git a/docs/users_guide/runtime_control.rst b/docs/users_guide/runtime_control.rst index 797c7e2..0c38ac5 100644 --- a/docs/users_guide/runtime_control.rst +++ b/docs/users_guide/runtime_control.rst @@ -1219,6 +1219,7 @@ Getting information about the RTS ,("Word size", "64") ,("Compiler unregisterised", "NO") ,("Tables next to code", "YES") + ,("Flag -with-rtsopts", "") ] The information is formatted such that it can be read as a of type @@ -1269,3 +1270,6 @@ Getting information about the RTS performance optimisation that is not available on all platforms. This field tells you whether the program has been compiled with this optimisation. (Usually yes, except on unusual platforms.) + + ``Flag -with-rtsopts`` + The value of the GHC flag :ghc-flag:`-with-rtsopts=⟨opts⟩` at compile/link time. diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index 7c292d2..6a72e67 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -901,7 +901,7 @@ error = true; else if (strequal("info", &rts_argv[arg][2])) { OPTION_SAFE; - printRtsInfo(); + printRtsInfo(rtsConfig); stg_exit(0); } #if defined(THREADED_RTS) diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c index 5357dc6..618815d 100644 --- a/rts/RtsUtils.c +++ b/rts/RtsUtils.c @@ -275,7 +275,7 @@ int genericRaise(int sig) { #endif } -static void mkRtsInfoPair(char *key, char *val) { +static void mkRtsInfoPair(const char *key, const char *val) { /* XXX should check for "s, \s etc in key and val */ printf(" ,(\"%s\", \"%s\")\n", key, val); } @@ -285,7 +285,7 @@ static void mkRtsInfoPair(char *key, char *val) { #define TOSTRING2(x) #x #define TOSTRING(x) TOSTRING2(x) -void printRtsInfo(void) { +void printRtsInfo(const RtsConfig rts_config) { /* The first entry is just a hack to make it easy to get the * commas right */ printf(" [(\"GHC RTS\", \"YES\")\n"); @@ -306,6 +306,8 @@ void printRtsInfo(void) { mkRtsInfoPair("Word size", TOSTRING(WORD_SIZE_IN_BITS)); mkRtsInfoPair("Compiler unregisterised", GhcUnregisterised); mkRtsInfoPair("Tables next to code", GhcEnableTablesNextToCode); + mkRtsInfoPair("Flag -with-rtsopts", /* See Trac #15261 */ + rts_config.rts_opts != NULL ? rts_config.rts_opts : ""); printf(" ]\n"); } diff --git a/rts/RtsUtils.h b/rts/RtsUtils.h index 16596c1..49712c0 100644 --- a/rts/RtsUtils.h +++ b/rts/RtsUtils.h @@ -40,7 +40,7 @@ char *showStgWord64(StgWord64, char *, bool); void heapCheckFail( void ); #endif -void printRtsInfo(void); +void printRtsInfo(const RtsConfig); void checkFPUStack(void); diff --git a/testsuite/tests/rts/T15261/Makefile b/testsuite/tests/rts/T15261/Makefile new file mode 100644 index 0000000..f50b22c --- /dev/null +++ b/testsuite/tests/rts/T15261/Makefile @@ -0,0 +1,11 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T15261a: + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -with-rtsopts="-t -s" --make T15261a.hs + ./T15261a +RTS --info | grep "rtsopts" + +T15261b: + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make T15261b.hs + ./T15261b +RTS --info | grep "rtsopts" diff --git a/testsuite/tests/rts/T15261/T15261a.hs b/testsuite/tests/rts/T15261/T15261a.hs new file mode 100644 index 0000000..4c512dc --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261a.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "T15261a" diff --git a/testsuite/tests/rts/T15261/T15261a.stdout b/testsuite/tests/rts/T15261/T15261a.stdout new file mode 100644 index 0000000..5919bb4 --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261a.stdout @@ -0,0 +1 @@ + ,("Flag -with-rtsopts", "-t -s") diff --git a/testsuite/tests/rts/T15261/T15261b.hs b/testsuite/tests/rts/T15261/T15261b.hs new file mode 100644 index 0000000..1304a85 --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261b.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "T15261b" diff --git a/testsuite/tests/rts/T15261/T15261b.stdout b/testsuite/tests/rts/T15261/T15261b.stdout new file mode 100644 index 0000000..80184e8 --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261b.stdout @@ -0,0 +1 @@ + ,("Flag -with-rtsopts", "") diff --git a/testsuite/tests/rts/T15261/all.T b/testsuite/tests/rts/T15261/all.T new file mode 100644 index 0000000..5bc6977 --- /dev/null +++ b/testsuite/tests/rts/T15261/all.T @@ -0,0 +1,2 @@ +test('T15261a', normal, run_command, ['$MAKE -s --no-print-directory T15261a']) +test('T15261b', normal, run_command, ['$MAKE -s --no-print-directory T15261b']) From git at git.haskell.org Tue Aug 21 22:57:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:57 +0000 (UTC) Subject: [commit: ghc] master: Correct limb length and assertion for gcdExtInteger (c331592) Message-ID: <20180821225757.1B21E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c331592130ef592b92084e7417581a4039bfa7d2/ghc >--------------------------------------------------------------- commit c331592130ef592b92084e7417581a4039bfa7d2 Author: DavidEichamnn Date: Tue Aug 21 16:06:45 2018 -0400 Correct limb length and assertion for gcdExtInteger Reviewers: hvr, bgamari, monoidal Reviewed By: monoidal Subscribers: monoidal, rwbarton, thomie, carter GHC Trac Issues: #15350 Differential Revision: https://phabricator.haskell.org/D5042 >--------------------------------------------------------------- c331592130ef592b92084e7417581a4039bfa7d2 libraries/integer-gmp/cbits/wrappers.c | 16 +++++++++++++--- testsuite/tests/lib/integer/integerGmpInternals.hs | 19 +++++++++++++++++++ .../tests/lib/integer/integerGmpInternals.stdout | 14 ++++++++++++++ 3 files changed, 46 insertions(+), 3 deletions(-) diff --git a/libraries/integer-gmp/cbits/wrappers.c b/libraries/integer-gmp/cbits/wrappers.c index 8f147ad..11e5179 100644 --- a/libraries/integer-gmp/cbits/wrappers.c +++ b/libraries/integer-gmp/cbits/wrappers.c @@ -286,9 +286,9 @@ integer_gmp_mpn_gcd(mp_limb_t r[], * reconstructed). * * g must have space for exactly gn=min(xn,yn) limbs. - * s must have space for at least xn limbs. + * s must have space for at least yn limbs. * - * return value: signed 'sn' of {sp,sn} + * return value: signed 'sn' of {sp,sn} where |sn| >= 1 */ mp_size_t integer_gmp_gcdext(mp_limb_t s0[], mp_limb_t g0[], @@ -305,15 +305,25 @@ integer_gmp_gcdext(mp_limb_t s0[], mp_limb_t g0[], mpz_gcdext (g, s, NULL, x, y); + // g must be positive (0 <= gn). + // According to the docs for mpz_gcdext(), we have: + // g < min(|y|/2|s|, |x|/2|t|) + // --> g < min(|y|, |x|) + // --> gn <= min(yn, xn) + // <-> gn <= gn0 const mp_size_t gn = g[0]._mp_size; assert(0 <= gn && gn <= gn0); memset(g0, 0, gn0*sizeof(mp_limb_t)); memcpy(g0, g[0]._mp_d, gn*sizeof(mp_limb_t)); mpz_clear (g); + // According to the docs for mpz_gcdext(), we have: + // |s| < |y| / 2g + // --> |s| < |y| (note g > 0) + // --> sn <= yn const mp_size_t ssn = s[0]._mp_size; const mp_size_t sn = mp_size_abs(ssn); - assert(sn <= mp_size_abs(xn)); + assert(sn <= mp_size_abs(yn)); memcpy(s0, s[0]._mp_d, sn*sizeof(mp_limb_t)); mpz_clear (s); diff --git a/testsuite/tests/lib/integer/integerGmpInternals.hs b/testsuite/tests/lib/integer/integerGmpInternals.hs index c90df5c..e45c6f4 100644 --- a/testsuite/tests/lib/integer/integerGmpInternals.hs +++ b/testsuite/tests/lib/integer/integerGmpInternals.hs @@ -79,6 +79,8 @@ main = do print $ powModInteger b e m print $ powModInteger b e (m-1) print $ powModSecInteger b e (m-1) + + putStrLn "\n# gcdExtInteger" print $ gcdExtInteger b e print $ gcdExtInteger e b print $ gcdExtInteger x y @@ -86,10 +88,27 @@ main = do print $ gcdExtInteger x (-y) print $ gcdExtInteger (-x) y print $ gcdExtInteger (-x) (-y) + + -- see Trac #15350 + do + let a = 2 + b = 2^65 + 1 + print $ gcdExtInteger a b + print $ gcdExtInteger a (-b) + print $ gcdExtInteger (-a) b + print $ gcdExtInteger (-a) (-b) + print $ gcdExtInteger b a + print $ gcdExtInteger b (-a) + print $ gcdExtInteger (-b) a + print $ gcdExtInteger (-b) (-a) + + putStrLn "\n# powInteger" print $ powInteger 12345 0 print $ powInteger 12345 1 print $ powInteger 12345 30 print $ [ (x,i) | x <- [-7..71], let i = recipModInteger x (2*3*11*11*17*17), i /= 0 ] + + putStrLn "\n# nextPrimeInteger" print $ I.nextPrimeInteger b print $ I.nextPrimeInteger e print $ [ k | k <- [ 0 .. 200 ], S# (I.testPrimeInteger k 25#) `elem` [1,2] ] diff --git a/testsuite/tests/lib/integer/integerGmpInternals.stdout b/testsuite/tests/lib/integer/integerGmpInternals.stdout index d5c1374..cff835b 100644 --- a/testsuite/tests/lib/integer/integerGmpInternals.stdout +++ b/testsuite/tests/lib/integer/integerGmpInternals.stdout @@ -1,6 +1,8 @@ 1527229998585248450016808958343740453059 682382427572745901624116300491295556924 682382427572745901624116300491295556924 + +# gcdExtInteger (1,-238164827888328100873319793437342927637138278785737103723156342382925) (1,302679100340807588460107986194035692812415103244388831792688023418704) (92889294,115110207004456909698806038261) @@ -8,10 +10,22 @@ (92889294,115110207004456909698806038261) (92889294,-115110207004456909698806038261) (92889294,-115110207004456909698806038261) +(1,-18446744073709551616) +(1,-18446744073709551616) +(1,18446744073709551616) +(1,18446744073709551616) +(1,1) +(1,1) +(1,-1) +(1,-1) + +# powInteger 1 12345 555562377826831043419246079513769804614412256811161773362797946971665712715296306339052301636736176350153982639312744140625 [(-7,149867),(-5,167851),(-1,209813),(1,1),(5,41963),(7,59947),(13,177535),(19,143557),(23,182447),(25,134281),(29,7235),(31,33841),(35,95915),(37,113413),(41,61409),(43,24397),(47,174101),(49,158431),(53,193979),(59,188477),(61,185737),(65,35507),(67,118999),(71,186173)] + +# nextPrimeInteger 2988348162058574136915891421498819466320163312926952423791023078876343 2351399303373464486466122544523690094744975233415544072992656881240451 [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199] From git at git.haskell.org Tue Aug 21 22:57:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:57:59 +0000 (UTC) Subject: [commit: ghc] master: rts: Align the_gc_thread to 64 bytes (68a1fc2) Message-ID: <20180821225759.E02393A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/68a1fc29b4bb3eae54e4d96c9aec20e700040f34/ghc >--------------------------------------------------------------- commit 68a1fc29b4bb3eae54e4d96c9aec20e700040f34 Author: Ben Gamari Date: Tue Aug 21 16:06:12 2018 -0400 rts: Align the_gc_thread to 64 bytes In a previous attempt (c6cc93bca69abc258513af8cf2370b14e70fd8fb) I had tried aligning to 8 bytes under the assumption that the problem was that the_gc_thread, a StgWord8[], wasn't being aligned to 8-bytes as the gc_thread struct would expect. However, we actually need even stronger alignment due to the alignment attribute attached to gen_workspace, which claims it should be aligned to a 64-byte boundary. This fixes #15482. Reviewers: erikd, simonmar Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15482 Differential Revision: https://phabricator.haskell.org/D5052 >--------------------------------------------------------------- 68a1fc29b4bb3eae54e4d96c9aec20e700040f34 rts/sm/GC.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 742ae36..90857ab 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -128,7 +128,9 @@ uint32_t mutlist_MUTVARS, gc_thread **gc_threads = NULL; #if !defined(THREADED_RTS) -StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)]; +// Must be aligned to 64-bytes to meet stated 64-byte alignment of gen_workspace +StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)] + ATTRIBUTE_ALIGNED(64); #endif // Number of threads running in *this* GC. Affects how many From git at git.haskell.org Tue Aug 21 22:58:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:58:02 +0000 (UTC) Subject: [commit: ghc] master: Fix precision of asinh/acosh/atanh by making them primops (c6f4eb4) Message-ID: <20180821225802.C53573A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c6f4eb4f8bc5e00024c74198ab9126bf1750db40/ghc >--------------------------------------------------------------- commit c6f4eb4f8bc5e00024c74198ab9126bf1750db40 Author: Artem Pelenitsyn Date: Tue Aug 21 16:07:24 2018 -0400 Fix precision of asinh/acosh/atanh by making them primops Reviewers: hvr, bgamari, simonmar, jrtc27 Reviewed By: bgamari Subscribers: alpmestan, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5034 >--------------------------------------------------------------- c6f4eb4f8bc5e00024c74198ab9126bf1750db40 compiler/cmm/CmmMachOp.hs | 6 ++++++ compiler/cmm/PprC.hs | 6 ++++++ compiler/codeGen/StgCmmPrim.hs | 6 ++++++ compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 8 ++++++++ compiler/nativeGen/PPC/CodeGen.hs | 8 ++++++++ compiler/nativeGen/SPARC/CodeGen.hs | 8 ++++++++ compiler/nativeGen/X86/CodeGen.hs | 8 ++++++++ compiler/prelude/primops.txt.pp | 30 ++++++++++++++++++++++++++++++ libraries/base/GHC/Float.hs | 28 ++++++++++++++-------------- 9 files changed, 94 insertions(+), 14 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c6f4eb4f8bc5e00024c74198ab9126bf1750db40 From git at git.haskell.org Tue Aug 21 22:58:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:58:05 +0000 (UTC) Subject: [commit: ghc] master: docs: "state transformer" -> "state monad" / "ST" (whichever is meant) (8546afc) Message-ID: <20180821225805.ABC7C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8546afc502306de16b62c6386fe419753393cb12/ghc >--------------------------------------------------------------- commit 8546afc502306de16b62c6386fe419753393cb12 Author: Artem Pelenitsyn Date: Tue Aug 21 16:07:39 2018 -0400 docs: "state transformer" -> "state monad" / "ST" (whichever is meant) FIxes #15189. Reviewers: hvr, bgamari, simonmar, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15189 Differential Revision: https://phabricator.haskell.org/D5019 >--------------------------------------------------------------- 8546afc502306de16b62c6386fe419753393cb12 docs/rts/rts.tex | 4 ++-- libraries/base/Control/Monad.hs | 2 +- libraries/base/Control/Monad/ST/Imp.hs | 2 +- libraries/base/Control/Monad/ST/Lazy/Imp.hs | 16 ++++++++-------- libraries/base/Control/Monad/ST/Lazy/Safe.hs | 2 +- libraries/base/Control/Monad/ST/Lazy/Unsafe.hs | 2 +- libraries/base/Data/Functor/Utils.hs | 4 ++-- libraries/base/GHC/Exts.hs | 2 +- libraries/base/GHC/IO.hs | 14 +++++++------- libraries/base/GHC/ST.hs | 12 ++++++------ 10 files changed, 30 insertions(+), 30 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8546afc502306de16b62c6386fe419753393cb12 From git at git.haskell.org Tue Aug 21 22:58:08 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Aug 2018 22:58:08 +0000 (UTC) Subject: [commit: ghc] master: Properly tag fun field of PAPs generated by ap_0_fast (2693eb1) Message-ID: <20180821225808.866153A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2693eb11f55f2001701c90c24183e21c794a8be1/ghc >--------------------------------------------------------------- commit 2693eb11f55f2001701c90c24183e21c794a8be1 Author: Ömer Sinan Ağacan Date: Tue Aug 21 16:06:29 2018 -0400 Properly tag fun field of PAPs generated by ap_0_fast Currently ap_0_fast doesn't maintain the invariant for PAP fun fields which says if the closure can be tagged, it should be. This is checked by `Sanity.c:checkPAP` and correctly implemented by `genautoapply`. This causes sanity check failures when we have a profiling code like f = {-# SCC scc #-} g where g is a PAP or a FUN, and `scc` is different than the current cost centre. Test Plan: Slow validate (not done yet) Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15508 Differential Revision: https://phabricator.haskell.org/D5051 >--------------------------------------------------------------- 2693eb11f55f2001701c90c24183e21c794a8be1 rts/Apply.cmm | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/rts/Apply.cmm b/rts/Apply.cmm index 15d8250..7e23609 100644 --- a/rts/Apply.cmm +++ b/rts/Apply.cmm @@ -106,6 +106,9 @@ again: pap = Hp - SIZEOF_StgPAP + WDS(1); SET_HDR(pap, stg_PAP_info, CCCS); StgPAP_arity(pap) = arity; + if (arity <= TAG_MASK) { + fun = untaggedfun + arity; + } StgPAP_fun(pap) = fun; StgPAP_n_args(pap) = 0; return (pap); @@ -117,9 +120,8 @@ again: return (fun); } else { // We're going to copy this PAP, and put the new CCS in it - fun = untaggedfun; W_ size; - size = SIZEOF_StgPAP + WDS(TO_W_(StgPAP_n_args(fun))); + size = SIZEOF_StgPAP + WDS(TO_W_(StgPAP_n_args(untaggedfun))); HP_CHK_GEN(size); TICK_ALLOC_PAP(size, 0); // attribute this allocation to the "overhead of profiling" @@ -127,13 +129,13 @@ again: P_ pap; pap = Hp - size + WDS(1); // We'll lose the original PAP, so we should enter its CCS - ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(fun) "ptr"); + ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(untaggedfun) "ptr"); SET_HDR(pap, stg_PAP_info, CCCS); - StgPAP_arity(pap) = StgPAP_arity(fun); - StgPAP_n_args(pap) = StgPAP_n_args(fun); + StgPAP_arity(pap) = StgPAP_arity(untaggedfun); + StgPAP_n_args(pap) = StgPAP_n_args(untaggedfun); StgPAP_fun(pap) = StgPAP_fun(fun); W_ i; - i = TO_W_(StgPAP_n_args(fun)); + i = TO_W_(StgPAP_n_args(untaggedfun)); loop: if (i == 0) { return (pap); From git at git.haskell.org Wed Aug 22 05:54:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Aug 2018 05:54:12 +0000 (UTC) Subject: [commit: ghc] master: Revert "Properly tag fun field of PAPs generated by ap_0_fast" (ab55b4d) Message-ID: <20180822055412.3E7E53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ab55b4ddb717dab13d8b4900024ccbc8e9280c5c/ghc >--------------------------------------------------------------- commit ab55b4ddb717dab13d8b4900024ccbc8e9280c5c Author: Ömer Sinan Ağacan Date: Wed Aug 22 08:52:50 2018 +0300 Revert "Properly tag fun field of PAPs generated by ap_0_fast" This reverts commit 2693eb11f55f2001701c90c24183e21c794a8be1. This patch isn't ready yet, see D5051. >--------------------------------------------------------------- ab55b4ddb717dab13d8b4900024ccbc8e9280c5c rts/Apply.cmm | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/rts/Apply.cmm b/rts/Apply.cmm index 7e23609..15d8250 100644 --- a/rts/Apply.cmm +++ b/rts/Apply.cmm @@ -106,9 +106,6 @@ again: pap = Hp - SIZEOF_StgPAP + WDS(1); SET_HDR(pap, stg_PAP_info, CCCS); StgPAP_arity(pap) = arity; - if (arity <= TAG_MASK) { - fun = untaggedfun + arity; - } StgPAP_fun(pap) = fun; StgPAP_n_args(pap) = 0; return (pap); @@ -120,8 +117,9 @@ again: return (fun); } else { // We're going to copy this PAP, and put the new CCS in it + fun = untaggedfun; W_ size; - size = SIZEOF_StgPAP + WDS(TO_W_(StgPAP_n_args(untaggedfun))); + size = SIZEOF_StgPAP + WDS(TO_W_(StgPAP_n_args(fun))); HP_CHK_GEN(size); TICK_ALLOC_PAP(size, 0); // attribute this allocation to the "overhead of profiling" @@ -129,13 +127,13 @@ again: P_ pap; pap = Hp - size + WDS(1); // We'll lose the original PAP, so we should enter its CCS - ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(untaggedfun) "ptr"); + ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(fun) "ptr"); SET_HDR(pap, stg_PAP_info, CCCS); - StgPAP_arity(pap) = StgPAP_arity(untaggedfun); - StgPAP_n_args(pap) = StgPAP_n_args(untaggedfun); + StgPAP_arity(pap) = StgPAP_arity(fun); + StgPAP_n_args(pap) = StgPAP_n_args(fun); StgPAP_fun(pap) = StgPAP_fun(fun); W_ i; - i = TO_W_(StgPAP_n_args(untaggedfun)); + i = TO_W_(StgPAP_n_args(fun)); loop: if (i == 0) { return (pap); From git at git.haskell.org Wed Aug 22 13:22:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Aug 2018 13:22:55 +0000 (UTC) Subject: [commit: ghc] master: Revert "driver: unconditionally disable relaxation when linking partially" (44ba665) Message-ID: <20180822132255.318E53A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/44ba66527ae207ce2dd64eb2bce14656d474f6d1/ghc >--------------------------------------------------------------- commit 44ba66527ae207ce2dd64eb2bce14656d474f6d1 Author: Ryan Scott Date: Wed Aug 22 09:19:42 2018 -0400 Revert "driver: unconditionally disable relaxation when linking partially" This reverts commit 1cc9061fce4270739677d475190fd6e890e8b1f9. This appears to break a clean build with certain versions of `ld.gold`. See https://phabricator.haskell.org/rGHC1cc9061fce42#132967. >--------------------------------------------------------------- 44ba66527ae207ce2dd64eb2bce14656d474f6d1 compiler/main/DriverPipeline.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index eff542a..a9e486c 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -2171,11 +2171,12 @@ joinObjectFiles dflags o_files output_fn = do ++ (if osInfo == OSFreeBSD then [SysTools.Option "-L/usr/lib"] else []) - -- gcc on sparc sets -Wl,--relax implicitly (another - -- use case is when use passes -optl-Wl,--relax) - -- but -r and --relax are incompatible for ld, so + -- gcc on sparc sets -Wl,--relax implicitly, but + -- -r and --relax are incompatible for ld, so -- disable --relax explicitly. - ++ (if ldIsGnuLd + ++ (if platformArch (targetPlatform dflags) + `elem` [ArchSPARC, ArchSPARC64] + && ldIsGnuLd then [SysTools.Option "-Wl,-no-relax"] else []) ++ map SysTools.Option ld_build_id From git at git.haskell.org Wed Aug 22 17:17:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Aug 2018 17:17:42 +0000 (UTC) Subject: [commit: nofib] master: Make lambda fit for MFP (7cbfbbe) Message-ID: <20180822171742.841C33A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7cbfbbed8b6d985187030dc5153aafb1ec1728a6/nofib >--------------------------------------------------------------- commit 7cbfbbed8b6d985187030dc5153aafb1ec1728a6 Author: Sebastian Graf Date: Wed Aug 22 13:15:24 2018 -0400 Make lambda fit for MFP Summary: The next step of the MonadFail Proposal broke nofib's lambda benchmark. This commit fixes that in an unintrusive way. Reviewers: O26 nofib, RyanGlScott, bgamari Reviewed By: RyanGlScott Subscribers: monoidal Differential Revision: https://phabricator.haskell.org/D5058 >--------------------------------------------------------------- 7cbfbbed8b6d985187030dc5153aafb1ec1728a6 spectral/lambda/Main.hs | 29 +++++++++++++++++++++-------- 1 file changed, 21 insertions(+), 8 deletions(-) diff --git a/spectral/lambda/Main.hs b/spectral/lambda/Main.hs index f97a64c..b5f5959 100644 --- a/spectral/lambda/Main.hs +++ b/spectral/lambda/Main.hs @@ -117,6 +117,12 @@ instance EvalEnvMonad (State Env) where currEnv = get withEnv tmp m = return (evalState m tmp) +traverseCon :: (EvalEnvMonad m) => Term -> m Int +traverseCon t = + do t' <- traverseTerm t + case t' of + Con c -> return c + _ -> error ("Not a Con: " ++ show t') eval :: (EvalEnvMonad m) => Term -> m Term eval (Var x) = @@ -124,8 +130,8 @@ eval (Var x) = t <- lookupVar x traverseTerm t eval (Add u v) = - do {Con u' <- traverseTerm u; - Con v' <- traverseTerm v; + do {u' <- traverseCon u; + v' <- traverseCon v; return (Con (u'+v'))} eval (Thunk t e) = withEnv e (traverseTerm t) @@ -149,7 +155,7 @@ eval (Incr) = incr >> return (Con 0) apply (Thunk (Lam x b) e) a = do orig <- currEnv withEnv e (pushVar x (Thunk a orig) (traverseTerm b)) -apply a b = fail ("bad application: " ++ pp a ++ +apply a b = error ("bad application: " ++ pp a ++ " [ " ++ pp b ++ " ].") @@ -165,6 +171,13 @@ newtype Id a = Id (Identity a) instance Show a => Show (Id a) where show (Id i) = show (runIdentity i) +simpleEvalCon :: Env -> Term -> Id Int +simpleEvalCon env e = + do e' <- simpleEval env e + case e' of + Con c -> return c + _ -> error ("Not a Con: " ++ show e') + simpleEval :: Env -> Term -> Id Term simpleEval env (Var v) = simpleEval env (maybe (error ("undefined var: " ++ v)) id (lookup v env)) @@ -173,13 +186,13 @@ simpleEval env e@(Con _) = simpleEval env e at Incr = return (Con 0) simpleEval env (Add u v) = - do {Con u' <- simpleEval env u; - Con v' <- simpleEval env v; + do {u' <- simpleEvalCon env u; + v' <- simpleEvalCon env v; return (Con (u' + v'))} where addCons (Con a) (Con b) = return (Con (a+b)) - addCons (Con _) b = fail ("type error in second arg of Add: " ++ pp b) - addCons a (Con _) = fail ("type error in first arg of Add: " ++ pp a) + addCons (Con _) b = error ("type error in second arg of Add: " ++ pp b) + addCons a (Con _) = error ("type error in first arg of Add: " ++ pp a) simpleEval env f@(Lam x b) = return (Thunk f env) -- return a closure! simpleEval env (App u v) = @@ -200,7 +213,7 @@ simpleApply env (Thunk (Lam x b) e) a = simpleEval env2 b where env2 = (x, Thunk a env) : e -simpleApply env a b = fail ("bad application: " ++ pp a ++ +simpleApply env a b = error ("bad application: " ++ pp a ++ " [ " ++ pp b ++ " ].") ------------------------------------------------------------ From git at git.haskell.org Wed Aug 22 20:48:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Aug 2018 20:48:39 +0000 (UTC) Subject: [commit: ghc] wip/T15548: Do not pass -DTABLES_NEXT_TO_CODE to gcc (untested) (93843a6) Message-ID: <20180822204839.F3DCE3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T15548 Link : http://ghc.haskell.org/trac/ghc/changeset/93843a6b95a5a3d1e750bc4618f542a9b37b9141/ghc >--------------------------------------------------------------- commit 93843a6b95a5a3d1e750bc4618f542a9b37b9141 Author: Joachim Breitner Date: Wed Aug 22 12:58:18 2018 -0700 Do not pass -DTABLES_NEXT_TO_CODE to gcc (untested) The goal of #15548 is to make GHC itself flexible in whether it should produce TABLES_NEXT_TO_CODE code or not. Before this patch, it would statically set the default set of gcc arguments to include `-DTABLES_NEXT_TO_CODE`. But already the header files set `-DTABLES_NEXT_TO_CODE`, so maybe this is not needed at all, and can simply be removed? >--------------------------------------------------------------- 93843a6b95a5a3d1e750bc4618f542a9b37b9141 compiler/main/SysTools.hs | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index ff36c04..48f8de8 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -199,15 +199,9 @@ initSysTools top_dir let unreg_gcc_args = if targetUnregisterised then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - -- TABLES_NEXT_TO_CODE affects the info table layout. - tntc_gcc_args - | mkTablesNextToCode targetUnregisterised - = ["-DTABLES_NEXT_TO_CODE"] - | otherwise = [] cpp_args= map Option (words cpp_args_str) gcc_args = map Option (words gcc_args_str - ++ unreg_gcc_args - ++ tntc_gcc_args) + ++ unreg_gcc_args) ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsBuildId <- getBooleanSetting "ld supports build-id" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" From git at git.haskell.org Thu Aug 23 10:56:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 10:56:32 +0000 (UTC) Subject: [commit: ghc] wip/t-12758_circleci_push_perf_notes: testsuite: Save performance metrics in git notes. (9facb31) Message-ID: <20180823105632.42DCA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/t-12758_circleci_push_perf_notes Link : http://ghc.haskell.org/trac/ghc/changeset/9facb312bd735cdc7f56d48ea71695043a2ac6d6/ghc >--------------------------------------------------------------- commit 9facb312bd735cdc7f56d48ea71695043a2ac6d6 Author: David Eichmann Date: Wed Aug 8 11:35:44 2018 +0100 testsuite: Save performance metrics in git notes. Summary: Can now load up git note data into the python test driver. Reviewers: bgamari Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5059 GHC Trac Issues: #12758 >--------------------------------------------------------------- 9facb312bd735cdc7f56d48ea71695043a2ac6d6 .circleci/config.yml | 89 +- libraries/base/tests/all.T | 18 +- testsuite/driver/README.md | 161 ++++ testsuite/driver/perf_notes.py | 332 ++++++++ testsuite/driver/runtests.py | 55 +- testsuite/driver/testglobals.py | 16 +- testsuite/driver/testlib.py | 232 ++++-- testsuite/driver/testutil.py | 6 + testsuite/mk/test.mk | 8 + testsuite/tests/callarity/perf/all.T | 12 +- testsuite/tests/deriving/perf/all.T | 11 +- testsuite/tests/perf/compiler/all.T | 1051 ++---------------------- testsuite/tests/perf/haddock/all.T | 183 +---- testsuite/tests/perf/join_points/all.T | 16 +- testsuite/tests/perf/should_run/all.T | 362 ++------ testsuite/tests/perf/space_leaks/all.T | 75 +- testsuite/tests/pmcheck/should_compile/all.T | 27 +- testsuite/tests/primops/should_run/all.T | 6 +- testsuite/tests/simplCore/should_compile/all.T | 3 +- testsuite/tests/simplStg/should_run/all.T | 5 +- 20 files changed, 934 insertions(+), 1734 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 9facb312bd735cdc7f56d48ea71695043a2ac6d6 From git at git.haskell.org Thu Aug 23 10:56:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 10:56:35 +0000 (UTC) Subject: [commit: ghc] wip/t-12758_circleci_push_perf_notes's head updated: testsuite: Save performance metrics in git notes. (9facb31) Message-ID: <20180823105635.330993A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/t-12758_circleci_push_perf_notes' now includes: bd48a88 Bump parsec submodule 32008a9 Properly designate LambdaCase alts as CaseAlt in TH 2908899 primops: Drop support for WORD_SIZE_IN_BITS < 32 9f932d8 Add a test for Trac #15523 1e741fe Cosmetics in GraphColor 7a63f75 primops: Drop documentation for WORD_SIZE_IN_BITS < 32 5238f20 Fix #15527 by pretty-printing an RdrName prefixly a50244c Rename SigTv to TyVarTv (#15480) 23f6f31 Document default value of +RTS -N in user's guide 63b6a1d Be mindful of GADT tyvar order when desugaring record updates ae68f32 base: rewrite Monoid module docs 2748e95 base: Rewrite semigroup documentation 8154faf Make ghci work for stage1 and Hadrian 1bbb5fa Add comment explaining change in syntax error suggestion for #12146. 8f4df7f Add test cases for Ticket #12146. a08b285 CSE should deal with letrec (#9441) ecc0ddf Initialise cec_suppress properly d04a152 Update .mailmap [skip ci] 2671ec5 Bump stm submodule 9c4e6c6 Expose the StableName constructor ce6ce78 Set strictness correctly for JoinIds 18c302c Improve ambiguous-occurrence error message 828e949 Comments only 43b08cf Add a solveEqualities to tcClassDecl1 1cc9061 driver: unconditionally disable relaxation when linking partially 966aa78 Fix redundant imports of Class 02518f9 Fix #line pragmas in nested comments 09c1d5a Replace most occurences of foldl with foldl'. 23774c9 function-section: enable on windows ebcbfba Introduce flag -keep-hscpp-files 8a05836 Simplify callSiteInline a little 92db10b testsuite: Deduplicate source in wcompat-warnings test c971e11 Explicitly tell 'getNameToInstances' mods to load 2bacf6f rts/RetainerProfile: Dump closure type if pop() fails 1481762 base: Mark `findIndices` as INLINABLE instead of INLINE (fixes #15426) ddffa0c Fix ambiguous/out-of-scope Haddock identifiers dcf27e6 Show -with-rtsopts options in runtime's --info (#15261) 68a1fc2 rts: Align the_gc_thread to 64 bytes 2693eb1 Properly tag fun field of PAPs generated by ap_0_fast c331592 Correct limb length and assertion for gcdExtInteger c6f4eb4 Fix precision of asinh/acosh/atanh by making them primops 8546afc docs: "state transformer" -> "state monad" / "ST" (whichever is meant) 21f0f56 Add traceBinaryEvent# primop ab55b4d Revert "Properly tag fun field of PAPs generated by ap_0_fast" 44ba665 Revert "driver: unconditionally disable relaxation when linking partially" 9facb31 testsuite: Save performance metrics in git notes. From git at git.haskell.org Thu Aug 23 11:29:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 11:29:42 +0000 (UTC) Subject: [commit: ghc] master: Turn infinite loop into a panic (db6f1d9) Message-ID: <20180823112942.20E003A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/db6f1d9cfc74690798645a7cc5b25040c36bb35d/ghc >--------------------------------------------------------------- commit db6f1d9cfc74690798645a7cc5b25040c36bb35d Author: Simon Peyton Jones Date: Wed Aug 22 09:51:26 2018 +0100 Turn infinite loop into a panic In these two functions * TcIface.toIfaceAppTyArgsX * Type.piResultTys we take a type application (f t1 .. tn) and try to find its kind. It turned out that, if (f t1 .. tn) was ill-kinded the function would go into an infinite loop. That's not good: it caused the loop in Trac #15473. This patch doesn't fix the bug in #15473, but it does turn the loop into a decent panic, which is a step forward. >--------------------------------------------------------------- db6f1d9cfc74690798645a7cc5b25040c36bb35d compiler/iface/ToIface.hs | 15 ++++++++++++--- compiler/types/Type.hs | 14 ++++++++++---- 2 files changed, 22 insertions(+), 7 deletions(-) diff --git a/compiler/iface/ToIface.hs b/compiler/iface/ToIface.hs index 8452b8b..0b0782d 100644 --- a/compiler/iface/ToIface.hs +++ b/compiler/iface/ToIface.hs @@ -305,11 +305,20 @@ toIfaceAppArgsX fr kind ty_args go env (FunTy _ res) (t:ts) -- No type-class args in tycon apps = IA_Vis (toIfaceTypeX fr t) (go env res ts) - go env ty ts = ASSERT2( not (isEmptyTCvSubst env) - , ppr kind $$ ppr ty_args ) - go (zapTCvSubst env) (substTy env ty) ts + go env ty ts@(t1:ts1) + | not (isEmptyTCvSubst env) + = go (zapTCvSubst env) (substTy env ty) ts -- See Note [Care with kind instantiation] in Type.hs + | otherwise + = -- There's a kind error in the type we are trying to print + -- e.g. kind = k, ty_args = [Int] + -- This is probably a compiler bug, so we print a trace and + -- carry on as if it were FunTy. Without the test for + -- isEmptyTCvSubst we'd get an infinite loop (Trac #15473) + WARN( True, ppr kind $$ ppr ty_args ) + IA_Vis (toIfaceTypeX fr t1) (go env ty ts1) + tidyToIfaceType :: TidyEnv -> Type -> IfaceType tidyToIfaceType env ty = toIfaceType (tidyType env ty) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 4f0bcf8..9b4aec6 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1048,13 +1048,19 @@ piResultTys ty orig_args@(arg:args) | ForAllTy (TvBndr tv _) res <- ty = go (extendVarEnv tv_env tv arg) res args - | otherwise -- See Note [Care with kind instantiation] - = ASSERT2( not (isEmptyVarEnv tv_env) - , ppr ty $$ ppr orig_args $$ ppr all_args ) - go emptyTvSubstEnv + | not (isEmptyVarEnv tv_env) -- See Note [Care with kind instantiation] + = go emptyTvSubstEnv (substTy (mkTvSubst in_scope tv_env) ty) all_args + | otherwise + = -- We have not run out of arguments, but the function doesn't + -- have the right kind to apply to them; so panic. + -- Without hte explicit isEmptyVarEnv test, an ill-kinded type + -- would give an infniite loop, which is very unhelpful + -- c.f. Trac #15473 + pprPanic "piResultTys2" (ppr ty $$ ppr orig_args $$ ppr all_args) + applyTysX :: [TyVar] -> Type -> [Type] -> Type -- applyTyxX beta-reduces (/\tvs. body_ty) arg_tys -- Assumes that (/\tvs. body_ty) is closed From git at git.haskell.org Thu Aug 23 11:29:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 11:29:44 +0000 (UTC) Subject: [commit: ghc] master: Comments only (2a54209) Message-ID: <20180823112944.EA6383A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2a54209f8f8ca665b9bee617bf96397b2c75a3da/ghc >--------------------------------------------------------------- commit 2a54209f8f8ca665b9bee617bf96397b2c75a3da Author: Simon Peyton Jones Date: Wed Aug 22 10:04:08 2018 +0100 Comments only >--------------------------------------------------------------- 2a54209f8f8ca665b9bee617bf96397b2c75a3da compiler/typecheck/TcTyClsDecls.hs | 39 ++++++++++++++++++++------------------ compiler/types/CoAxiom.hs | 2 ++ compiler/types/FamInstEnv.hs | 25 ++++++++++++++++-------- compiler/types/TyCon.hs | 3 +++ 4 files changed, 43 insertions(+), 26 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index fd032f8..5cbc078 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -913,8 +913,8 @@ Then: * During TcHsType.tcTyVar we look in the *local* env, to get the fully-known, not knot-tied TcTyCon for T. - * Then, in TcHsSyn.zonkTcTypeToType (and zonkTcTyCon in particular) we look in - the *global* env to get the TyCon. + * Then, in TcHsSyn.zonkTcTypeToType (and zonkTcTyCon in particular) + we look in the *global* env to get the TyCon. This fancy footwork (with two bindings for T) is only necessary for the TyCons or Classes of this recursive group. Earlier, finished groups, @@ -929,19 +929,19 @@ is done by establishing an "initial kind", which is a rather uninformed guess at a tycon's kind (by counting arguments, mainly) and then using this initial kind for recursive occurrences. -The initial kind is stored in exactly the same way during kind-checking -as it is during type-checking (Note [Type checking recursive type and class -declarations]): in the *local* environment, with ATcTyCon. But we still -must store *something* in the *global* environment. Even though we -discard the result of kind-checking, we sometimes need to produce error -messages. These error messages will want to refer to the tycons being -checked, except that they don't exist yet, and it would be Terribly -Annoying to get the error messages to refer back to HsSyn. So we -create a TcTyCon and put it in the global env. This tycon can -print out its name and knows its kind, -but any other action taken on it will panic. Note -that TcTyCons are *not* knot-tied, unlike the rather valid but -knot-tied ones that occur during type-checking. +The initial kind is stored in exactly the same way during +kind-checking as it is during type-checking (Note [Type checking +recursive type and class declarations]): in the *local* environment, +with ATcTyCon. But we still must store *something* in the *global* +environment. Even though we discard the result of kind-checking, we +sometimes need to produce error messages. These error messages will +want to refer to the tycons being checked, except that they don't +exist yet, and it would be Terribly Annoying to get the error messages +to refer back to HsSyn. So we create a TcTyCon and put it in the +global env. This tycon can print out its name and knows its kind, but +any other action taken on it will panic. Note that TcTyCons are *not* +knot-tied, unlike the rather valid but knot-tied ones that occur +during type-checking. Note [Declarations for wired-in things] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1482,12 +1482,15 @@ tcTyFamInstEqn fam_tc mb_clsinfo tcFamTyPats fam_tc mb_clsinfo tv_names pats (kcTyFamEqnRhs mb_clsinfo hs_ty) $ \tvs pats res_kind -> - do { rhs_ty <- solveEqualities $ tcCheckLHsType hs_ty res_kind - + do { traceTc "tcTyFamInstEqn {" (ppr eqn_tc_name <+> ppr pats) + ; rhs_ty <- solveEqualities $ tcCheckLHsType hs_ty res_kind + ; traceTc "tcTyFamInstEqn 1" (ppr eqn_tc_name <+> ppr pats) ; (ze, tvs') <- zonkTyBndrsX emptyZonkEnv tvs + ; traceTc "tcTyFamInstEqn 2" (ppr eqn_tc_name <+> ppr pats) ; pats' <- zonkTcTypeToTypes ze pats + ; traceTc "tcTyFamInstEqn 3" (ppr eqn_tc_name <+> ppr pats $$ ppr rhs_ty) ; rhs_ty' <- zonkTcTypeToType ze rhs_ty - ; traceTc "tcTyFamInstEqn" (ppr fam_tc <+> pprTyVars tvs') + ; traceTc "tcTyFamInstEqn 4" (ppr fam_tc <+> pprTyVars tvs') ; return (mkCoAxBranch tvs' [] pats' rhs_ty' (map (const Nominal) tvs') loc) } diff --git a/compiler/types/CoAxiom.hs b/compiler/types/CoAxiom.hs index 63c2162..7f578ec 100644 --- a/compiler/types/CoAxiom.hs +++ b/compiler/types/CoAxiom.hs @@ -222,6 +222,8 @@ data CoAxBranch -- See Note [CoAxiom locations] , cab_tvs :: [TyVar] -- Bound type variables; not necessarily fresh -- See Note [CoAxBranch type variables] + -- May be eta-reduded; see FamInstEnv + -- Note [Eta reduction for data families] , cab_cvs :: [CoVar] -- Bound coercion variables -- Always empty, for now. -- See Note [Constraints in patterns] diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index 45d0842..a59f9a6 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -191,22 +191,31 @@ Solution: eta-reduce both axioms, thus: Now d' = d |> Monad (sym (ax2 ; ax1)) -This eta reduction happens for data instances as well as newtype -instances. Here we want to eta-reduce the data family axiom. -All this is done in TcInstDcls.tcDataFamInstDecl. +----- Bottom line ------ -See also Note [Newtype eta] in TyCon. +For a FamInst with fi_flavour = DataFamilyInst rep_tc, + + - fi_tvs (and cab_tvs of its CoAxiom) may be shorter + than tyConTyVars of rep_tc. -Bottom line: - For a FamInst with fi_flavour = DataFamilyInst rep_tc, - - fi_tvs may be shorter than tyConTyVars of rep_tc. - fi_tys may be shorter than tyConArity of the family tycon i.e. LHS is unsaturated + - fi_rhs will be (rep_tc fi_tvs) i.e. RHS is un-saturated - But when fi_flavour = SynFamilyInst, + - This eta reduction happens for data instances as well + as newtype instances. Here we want to eta-reduce the data family axiom. + + - This eta-reduction is done in TcInstDcls.tcDataFamInstDecl. + +But when fi_flavour = SynFamilyInst, - fi_tys has the exact arity of the family tycon + + +(See also Note [Newtype eta] in TyCon. This is notionally separate +and deals with the axiom connecting a newtype with its representation +type; but it too is eta-reduced.) -} -- Obtain the axiom of a family instance diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 0a02adf..d5347fc 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -1172,6 +1172,9 @@ so the coercion tycon CoT must have kind: T ~ [] and arity: 0 +This eta-reduction is implemented in BuildTyCl.mkNewTyConRhs. + + ************************************************************************ * * TyConRepName From git at git.haskell.org Thu Aug 23 11:29:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 11:29:48 +0000 (UTC) Subject: [commit: ghc] master: Fix a typo in TcValidity.checkFamInstRhs (8c7f90a) Message-ID: <20180823112948.5907C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8c7f90abcc1e8f9f29b751f23174e8db89ba6983/ghc >--------------------------------------------------------------- commit 8c7f90abcc1e8f9f29b751f23174e8db89ba6983 Author: Simon Peyton Jones Date: Wed Aug 22 10:00:20 2018 +0100 Fix a typo in TcValidity.checkFamInstRhs In error message generation we were using the wrong type constructor in inst_head. Result: the type became ill-kinded, and that sent the compiler into a loop. A separate patch fixes the loop. This patch fixes the actual bug -- Trac #15473. I also improved the "occurs more often" error message a bit. But it's still pretty terrible: * Variable ‘a’ occurs more often in the type family application ‘Undefined’ than in the instance head ‘LetInterleave xs t ts is y z’ It looks like nonsense, but all becomes clear if you use -fprint-explicit-kinds. Really we should fix this by spotting when invisible arguments are involved and at least suggesting -fprint-explicit-kinds. >--------------------------------------------------------------- 8c7f90abcc1e8f9f29b751f23174e8db89ba6983 compiler/typecheck/TcValidity.hs | 24 +++++++++++++--------- .../tests/typecheck/should_compile/T15473.stderr | 8 ++++++++ testsuite/tests/typecheck/should_compile/all.T | 2 +- 3 files changed, 23 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 2682367..d773420 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -63,7 +63,7 @@ import Unique ( mkAlphaTyVarUnique ) import qualified GHC.LanguageExtensions as LangExt import Control.Monad -import Data.List ( (\\) ) +import Data.List ( (\\), nub ) import qualified Data.List.NonEmpty as NE {- @@ -1570,13 +1570,14 @@ smallerMsg what inst_head noMoreMsg :: [TcTyVar] -> SDoc -> SDoc -> SDoc noMoreMsg tvs what inst_head - = vcat [ hang (text "Variable" <> plural tvs <+> quotes (pprWithCommas ppr tvs) + = vcat [ hang (text "Variable" <> plural tvs1 <+> quotes (pprWithCommas ppr tvs1) <+> occurs <+> text "more often") 2 (sep [ text "in the" <+> what , text "than in the instance head" <+> quotes inst_head ]) , parens undecidableMsg ] where - occurs = if isSingleton tvs then text "occurs" + tvs1 = nub tvs + occurs = if isSingleton tvs1 then text "occurs" else text "occur" undecidableMsg, constraintKindsMsg :: SDoc @@ -1928,22 +1929,25 @@ checkValidTyFamEqn mb_clsinfo fam_tc tvs cvs typats rhs pp_lhs loc checkFamInstRhs :: TyCon -> [Type] -- LHS -> [(TyCon, [Type])] -- type family calls in RHS -> [MsgDoc] -checkFamInstRhs tc lhsTys famInsts +checkFamInstRhs lhs_tc lhs_tys famInsts = mapMaybe check famInsts where - lhs_size = sizeTyConAppArgs tc lhsTys - fvs = fvTypes lhsTys + lhs_size = sizeTyConAppArgs lhs_tc lhs_tys + inst_head = pprType (TyConApp lhs_tc lhs_tys) + lhs_fvs = fvTypes lhs_tys check (tc, tys) | not (all isTyFamFree tys) = Just (nestedMsg what) | not (null bad_tvs) = Just (noMoreMsg bad_tvs what inst_head) | lhs_size <= fam_app_size = Just (smallerMsg what inst_head) | otherwise = Nothing where - what = text "type family application" - <+> quotes (pprType (TyConApp tc tys)) - inst_head = pprType (TyConApp tc lhsTys) - bad_tvs = fvTypes tys \\ fvs + what = text "type family application" + <+> quotes (pprType (TyConApp tc tys)) fam_app_size = sizeTyConAppArgs tc tys + bad_tvs = fvTypes tys \\ lhs_fvs + -- The (\\) is list difference; e.g. + -- [a,b,a,a] \\ [a,a] = [b,a] + -- So we are counting repetitions checkValidFamPats :: Maybe ClsInstInfo -> TyCon -> [TyVar] -> [CoVar] -> [Type] -- ^ patterns the user wrote diff --git a/testsuite/tests/typecheck/should_compile/T15473.stderr b/testsuite/tests/typecheck/should_compile/T15473.stderr new file mode 100644 index 0000000..6fdeaa1 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15473.stderr @@ -0,0 +1,8 @@ + +T15473.hs:11:3: error: + • Variable ‘a’ occurs more often + in the type family application ‘Undefined’ + than in the instance head ‘LetInterleave xs t ts is y z’ + (Use UndecidableInstances to permit this) + • In the equations for closed type family ‘LetInterleave’ + In the type family declaration for ‘LetInterleave’ diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 75f9aba..64df3a8 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -647,5 +647,5 @@ test('T15431a', normal, compile, ['']) test('T15428', normal, compile, ['']) test('T15412', normal, compile, ['']) test('T15141', normal, compile, ['']) -test('T15473', expect_broken(15473), compile, ['']) +test('T15473', normal, compile_fail, ['']) test('T15499', normal, compile, ['']) From git at git.haskell.org Thu Aug 23 11:29:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 11:29:51 +0000 (UTC) Subject: [commit: ghc] master: Accommodate API change in transSuperClasses (4293a80) Message-ID: <20180823112951.306F33A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4293a80a3ea835412737911bcb2a6703e9af378b/ghc >--------------------------------------------------------------- commit 4293a80a3ea835412737911bcb2a6703e9af378b Author: Simon Peyton Jones Date: Thu Aug 23 09:22:42 2018 +0100 Accommodate API change in transSuperClasses In this patch commit 6eabb6ddb7c53784792ee26b1e0657bde7eee7fb Author: Simon Peyton Jones Date: Tue Dec 15 14:26:13 2015 +0000 Allow recursive (undecidable) superclasses I changed (transSuperClasses p) to return only the superclasses of p, but not p itself. (Previously it always returned p as well.) The use of transSuperClasses in TcErrors.warnRedundantConstraints really needs 'p' in the result -- but I faild to fix this call site, and instead crippled the test for Trac #10100. This patch sets things right * Accomodates the API change * Re-enables T10100 * And thereby fixes Trac #11474 >--------------------------------------------------------------- 4293a80a3ea835412737911bcb2a6703e9af378b compiler/typecheck/TcErrors.hs | 6 +++--- testsuite/tests/typecheck/should_compile/T10100.hs | 1 - 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 7ef0754..06b660f 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -467,14 +467,14 @@ warnRedundantConstraints ctxt env info ev_vars redundant_evs = filterOut is_type_error $ case info of -- See Note [Redundant constraints in instance decls] - InstSkol -> filterOut improving ev_vars + InstSkol -> filterOut (improving . idType) ev_vars _ -> ev_vars -- See #15232 is_type_error = isJust . userTypeError_maybe . idType - improving ev_var = any isImprovementPred $ - transSuperClasses (idType ev_var) + improving pred -- (transSuperClasses p) does not include p + = any isImprovementPred (pred : transSuperClasses pred) reportBadTelescope :: ReportErrCtxt -> TcLclEnv -> Maybe SDoc -> [TcTyVar] -> TcM () reportBadTelescope ctxt env (Just telescope) skols diff --git a/testsuite/tests/typecheck/should_compile/T10100.hs b/testsuite/tests/typecheck/should_compile/T10100.hs index 031be76..b88803c 100644 --- a/testsuite/tests/typecheck/should_compile/T10100.hs +++ b/testsuite/tests/typecheck/should_compile/T10100.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} module T10100 where From git at git.haskell.org Thu Aug 23 14:06:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 14:06:37 +0000 (UTC) Subject: [commit: ghc] wip/t-12758_circleci_push_perf_notes: testsuite: Save performance metrics in git notes. (5e3bc8a) Message-ID: <20180823140637.D203C3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/t-12758_circleci_push_perf_notes Link : http://ghc.haskell.org/trac/ghc/changeset/5e3bc8ac9b9f8c2b7aa78b8a22809c8b7360652a/ghc >--------------------------------------------------------------- commit 5e3bc8ac9b9f8c2b7aa78b8a22809c8b7360652a Author: David Eichmann Date: Wed Aug 8 11:35:44 2018 +0100 testsuite: Save performance metrics in git notes. Summary: Can now load up git note data into the python test driver. Reviewers: bgamari Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5059 GHC Trac Issues: #12758 >--------------------------------------------------------------- 5e3bc8ac9b9f8c2b7aa78b8a22809c8b7360652a .circleci/config.yml | 89 +- libraries/base/tests/all.T | 18 +- testsuite/driver/README.md | 161 ++++ testsuite/driver/perf_notes.py | 332 ++++++++ testsuite/driver/runtests.py | 57 +- testsuite/driver/testglobals.py | 16 +- testsuite/driver/testlib.py | 232 ++++-- testsuite/driver/testutil.py | 6 + testsuite/mk/test.mk | 8 + testsuite/tests/callarity/perf/all.T | 12 +- testsuite/tests/deriving/perf/all.T | 11 +- testsuite/tests/perf/compiler/all.T | 1051 ++---------------------- testsuite/tests/perf/haddock/all.T | 183 +---- testsuite/tests/perf/join_points/all.T | 16 +- testsuite/tests/perf/should_run/all.T | 362 ++------ testsuite/tests/perf/space_leaks/all.T | 75 +- testsuite/tests/pmcheck/should_compile/all.T | 27 +- testsuite/tests/primops/should_run/all.T | 6 +- testsuite/tests/simplCore/should_compile/all.T | 3 +- testsuite/tests/simplStg/should_run/all.T | 5 +- 20 files changed, 936 insertions(+), 1734 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 5e3bc8ac9b9f8c2b7aa78b8a22809c8b7360652a From git at git.haskell.org Thu Aug 23 14:06:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 14:06:40 +0000 (UTC) Subject: [commit: ghc] wip/t-12758_circleci_push_perf_notes: Metric Increase: T8766 (e9807ae) Message-ID: <20180823140640.A25BE3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/t-12758_circleci_push_perf_notes Link : http://ghc.haskell.org/trac/ghc/changeset/e9807ae738fee424b3a76f89c4ed5eebebac65c0/ghc >--------------------------------------------------------------- commit e9807ae738fee424b3a76f89c4ed5eebebac65c0 Author: David Eichmann Date: Thu Aug 23 14:47:17 2018 +0100 Metric Increase: T8766 Metric Increase 'a' (test_env='asdf'): a b c Metric Increase (test_env='asdf'): a b c Metric Increase (test_env='asdf'): a, b, c Metric Increase ['a','b', 'c'] (test_env='asdf'): a b c Metric Increase: a b c >--------------------------------------------------------------- e9807ae738fee424b3a76f89c4ed5eebebac65c0 testsuite/driver/perf_notes.py | 16 ++++++++-------- testsuite/driver/runtests.py | 2 -- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/testsuite/driver/perf_notes.py b/testsuite/driver/perf_notes.py index 6dff446..9273f0f 100644 --- a/testsuite/driver/perf_notes.py +++ b/testsuite/driver/perf_notes.py @@ -86,15 +86,15 @@ def parse_allowed_perf_changes(commitMsg): s = r"(?:\s*\n?\s+)" # Space, possible new line with an indent. qstr = r"(?:'(?:[^'\\]|\\.)*')" # Quoted string. qstrCap = r"(?:'((?:[^'\\]|\\.)*)')" # Quoted string. Captures the string without the quotes. - innerQstrList = rf"(?:{qstr}(?:{s}?,{s}?{qstr})*)?" # Inside of a list of strings. - qstrList = rf"(?:\[{s}?{innerQstrList}{s}?\])" # A list of strings (using box brackets). + innerQstrList = r"(?:"+qstr+r"(?:"+s+r"?,"+s+r"?"+qstr+r")*)?" # Inside of a list of strings.gs.s.. + qstrList = r"(?:\["+s+r"?"+innerQstrList+s+r"?\])" # A list of strings (using box brackets).. exp = (r"^Metric" - + rf"{s}(Increase|Decrease)" - + rf"{s}?({qstr}|{qstrList})?" # Metric or list of metrics. - + rf"{s}?(\(" + rf"(?:[^')]|{qstr})*" + r"\))?" # Options surounded in parenthesis. (allow parenthases in quoted strings) - + rf"{s}?:?" # Optional ":" - + rf"{s}?((?:(?!\n\n)(?!\n[^\s])(?:.|\n))*)" # Test names. Stop parsing on empty or non-indented new line. + +s+r"(Increase|Decrease)" + +s+r"?("+qstr+r"|"+qstrList+r")?" # Metric or list of metrics.s.. + +s+r"?(\(" + r"(?:[^')]|"+qstr+r")*" + r"\))?" # Options surounded in parenthesis. (allow parenthases in quoted strings)) + +s+r"?:?" # Optional ":" + +s+r"?((?:(?!\n\n)(?!\n[^\s])(?:.|\n))*)" # Test names. Stop parsing on empty or non-indented new line. ) matches = re.findall(exp, commitMsg, re.M) @@ -105,7 +105,7 @@ def parse_allowed_perf_changes(commitMsg): changes.setdefault(test, []).append({ 'direction': direction, 'metrics': re.findall(qstrCap, metricsStr), - 'opts': dict(re.findall(rf"(\w+){s}?={s}?{qstrCap}", optsStr)) + 'opts': dict(re.findall(r"(\w+)"+s+r"?="+s+r"?"+qstrCap, optsStr)) }) return changes diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 3cb7477..ded3472 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -240,8 +240,6 @@ print('Timeout is ' + str(config.timeout)) # Try get allowed performance changes from the git commit. try: config.allowed_perf_changes = Perf.get_allowed_perf_changes() - if config.allowed_perf_changes: - print('Found ' + str(len(config.allowed_perf_changes)) + ' valid metric change statements from the HEAD git commit message.') except subprocess.CalledProcessError: print('Failed to get allowed metric changes from the HEAD git commit message.') From git at git.haskell.org Thu Aug 23 15:26:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 15:26:26 +0000 (UTC) Subject: [commit: ghc] wip/t-12758_circleci_push_perf_notes: testsuite: Save performance metrics in git notes. (7b6ad12) Message-ID: <20180823152626.E4D363A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/t-12758_circleci_push_perf_notes Link : http://ghc.haskell.org/trac/ghc/changeset/7b6ad1243eb7297b07c3e958eb478101b0d70986/ghc >--------------------------------------------------------------- commit 7b6ad1243eb7297b07c3e958eb478101b0d70986 Author: David Eichmann Date: Wed Aug 8 11:35:44 2018 +0100 testsuite: Save performance metrics in git notes. Reviewers: bgamari Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5059 GHC Trac Issues: #12758 >--------------------------------------------------------------- 7b6ad1243eb7297b07c3e958eb478101b0d70986 .circleci/config.yml | 89 +- libraries/base/tests/all.T | 18 +- testsuite/driver/README.md | 161 ++++ testsuite/driver/perf_notes.py | 332 ++++++++ testsuite/driver/runtests.py | 55 +- testsuite/driver/testglobals.py | 16 +- testsuite/driver/testlib.py | 232 ++++-- testsuite/driver/testutil.py | 6 + testsuite/mk/test.mk | 8 + testsuite/tests/callarity/perf/all.T | 12 +- testsuite/tests/deriving/perf/all.T | 11 +- testsuite/tests/perf/compiler/all.T | 1051 ++---------------------- testsuite/tests/perf/haddock/all.T | 183 +---- testsuite/tests/perf/join_points/all.T | 16 +- testsuite/tests/perf/should_run/all.T | 362 ++------ testsuite/tests/perf/space_leaks/all.T | 75 +- testsuite/tests/pmcheck/should_compile/all.T | 27 +- testsuite/tests/primops/should_run/all.T | 6 +- testsuite/tests/simplCore/should_compile/all.T | 3 +- testsuite/tests/simplStg/should_run/all.T | 5 +- 20 files changed, 934 insertions(+), 1734 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 7b6ad1243eb7297b07c3e958eb478101b0d70986 From git at git.haskell.org Thu Aug 23 16:42:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 16:42:46 +0000 (UTC) Subject: [commit: ghc] wip/t-12758_circleci_push_perf_notes: testsuite: Save performance metrics in git notes. (90a1d43) Message-ID: <20180823164246.ED8033A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/t-12758_circleci_push_perf_notes Link : http://ghc.haskell.org/trac/ghc/changeset/90a1d43a35cdf704dc2f1832e0726b70edd9b251/ghc >--------------------------------------------------------------- commit 90a1d43a35cdf704dc2f1832e0726b70edd9b251 Author: David Eichmann Date: Wed Aug 8 11:35:44 2018 +0100 testsuite: Save performance metrics in git notes. Reviewers: bgamari Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5059 GHC Trac Issues: #12758 >--------------------------------------------------------------- 90a1d43a35cdf704dc2f1832e0726b70edd9b251 .circleci/config.yml | 95 ++- libraries/base/tests/all.T | 18 +- testsuite/driver/README.md | 161 ++++ testsuite/driver/perf_notes.py | 332 ++++++++ testsuite/driver/runtests.py | 55 +- testsuite/driver/testglobals.py | 16 +- testsuite/driver/testlib.py | 232 ++++-- testsuite/driver/testutil.py | 6 + testsuite/mk/test.mk | 8 + testsuite/tests/callarity/perf/all.T | 12 +- testsuite/tests/deriving/perf/all.T | 11 +- testsuite/tests/perf/compiler/all.T | 1051 ++---------------------- testsuite/tests/perf/haddock/all.T | 183 +---- testsuite/tests/perf/join_points/all.T | 16 +- testsuite/tests/perf/should_run/all.T | 362 ++------ testsuite/tests/perf/space_leaks/all.T | 75 +- testsuite/tests/pmcheck/should_compile/all.T | 27 +- testsuite/tests/primops/should_run/all.T | 6 +- testsuite/tests/simplCore/should_compile/all.T | 3 +- testsuite/tests/simplStg/should_run/all.T | 5 +- 20 files changed, 940 insertions(+), 1734 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 90a1d43a35cdf704dc2f1832e0726b70edd9b251 From git at git.haskell.org Thu Aug 23 16:47:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 16:47:42 +0000 (UTC) Subject: [commit: ghc] branch 'wip/t-12758_circleci_push_perf_notes_short' created Message-ID: <20180823164742.14FB83A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/t-12758_circleci_push_perf_notes_short Referencing: 12fde7809c32ea26876fc42c902067d1e8529f2c From git at git.haskell.org Thu Aug 23 16:47:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 16:47:45 +0000 (UTC) Subject: [commit: ghc] wip/t-12758_circleci_push_perf_notes_short: testsuite: Save performance metrics in git notes. (12fde78) Message-ID: <20180823164745.B95673A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/t-12758_circleci_push_perf_notes_short Link : http://ghc.haskell.org/trac/ghc/changeset/12fde7809c32ea26876fc42c902067d1e8529f2c/ghc >--------------------------------------------------------------- commit 12fde7809c32ea26876fc42c902067d1e8529f2c Author: David Eichmann Date: Wed Aug 8 11:35:44 2018 +0100 testsuite: Save performance metrics in git notes. Reviewers: bgamari Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5059 GHC Trac Issues: #12758 >--------------------------------------------------------------- 12fde7809c32ea26876fc42c902067d1e8529f2c .circleci/config.yml | 131 ++- libraries/base/tests/all.T | 18 +- testsuite/driver/README.md | 161 ++++ testsuite/driver/perf_notes.py | 332 ++++++++ testsuite/driver/runtests.py | 55 +- testsuite/driver/testglobals.py | 16 +- testsuite/driver/testlib.py | 232 ++++-- testsuite/driver/testutil.py | 6 + testsuite/mk/test.mk | 8 + testsuite/tests/callarity/perf/all.T | 12 +- testsuite/tests/deriving/perf/all.T | 11 +- testsuite/tests/perf/compiler/all.T | 1051 ++---------------------- testsuite/tests/perf/haddock/all.T | 183 +---- testsuite/tests/perf/join_points/all.T | 16 +- testsuite/tests/perf/should_run/all.T | 362 ++------ testsuite/tests/perf/space_leaks/all.T | 75 +- testsuite/tests/pmcheck/should_compile/all.T | 27 +- testsuite/tests/primops/should_run/all.T | 6 +- testsuite/tests/simplCore/should_compile/all.T | 3 +- testsuite/tests/simplStg/should_run/all.T | 5 +- 20 files changed, 971 insertions(+), 1739 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 12fde7809c32ea26876fc42c902067d1e8529f2c From git at git.haskell.org Thu Aug 23 16:50:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 16:50:01 +0000 (UTC) Subject: [commit: ghc] wip/t-12758_circleci_push_perf_notes_short: testsuite: Save performance metrics in git notes. (ea348b0) Message-ID: <20180823165001.445BA3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/t-12758_circleci_push_perf_notes_short Link : http://ghc.haskell.org/trac/ghc/changeset/ea348b0995f28c9b21c036351b5deecaeab79c78/ghc >--------------------------------------------------------------- commit ea348b0995f28c9b21c036351b5deecaeab79c78 Author: David Eichmann Date: Wed Aug 8 11:35:44 2018 +0100 testsuite: Save performance metrics in git notes. Reviewers: bgamari Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5059 GHC Trac Issues: #12758 >--------------------------------------------------------------- ea348b0995f28c9b21c036351b5deecaeab79c78 .circleci/config.yml | 132 ++- libraries/base/tests/all.T | 18 +- testsuite/driver/README.md | 161 ++++ testsuite/driver/perf_notes.py | 332 ++++++++ testsuite/driver/runtests.py | 55 +- testsuite/driver/testglobals.py | 16 +- testsuite/driver/testlib.py | 232 ++++-- testsuite/driver/testutil.py | 6 + testsuite/mk/test.mk | 8 + testsuite/tests/callarity/perf/all.T | 12 +- testsuite/tests/deriving/perf/all.T | 11 +- testsuite/tests/perf/compiler/all.T | 1051 ++---------------------- testsuite/tests/perf/haddock/all.T | 183 +---- testsuite/tests/perf/join_points/all.T | 16 +- testsuite/tests/perf/should_run/all.T | 362 ++------ testsuite/tests/perf/space_leaks/all.T | 75 +- testsuite/tests/pmcheck/should_compile/all.T | 27 +- testsuite/tests/primops/should_run/all.T | 6 +- testsuite/tests/simplCore/should_compile/all.T | 3 +- testsuite/tests/simplStg/should_run/all.T | 5 +- 20 files changed, 972 insertions(+), 1739 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 ea348b0995f28c9b21c036351b5deecaeab79c78 From git at git.haskell.org Thu Aug 23 16:54:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 16:54:53 +0000 (UTC) Subject: [commit: ghc] wip/t-12758_circleci_push_perf_notes_short: testsuite: Save performance metrics in git notes. (a34302c) Message-ID: <20180823165453.C69193A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/t-12758_circleci_push_perf_notes_short Link : http://ghc.haskell.org/trac/ghc/changeset/a34302ceed7b936b3aa83bac64dd39aac765d146/ghc >--------------------------------------------------------------- commit a34302ceed7b936b3aa83bac64dd39aac765d146 Author: David Eichmann Date: Wed Aug 8 11:35:44 2018 +0100 testsuite: Save performance metrics in git notes. Reviewers: bgamari Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5059 GHC Trac Issues: #12758 >--------------------------------------------------------------- a34302ceed7b936b3aa83bac64dd39aac765d146 .circleci/config.yml | 132 ++- libraries/base/tests/all.T | 18 +- testsuite/driver/README.md | 161 ++++ testsuite/driver/perf_notes.py | 332 ++++++++ testsuite/driver/runtests.py | 55 +- testsuite/driver/testglobals.py | 16 +- testsuite/driver/testlib.py | 232 ++++-- testsuite/driver/testutil.py | 6 + testsuite/mk/test.mk | 8 + testsuite/tests/callarity/perf/all.T | 12 +- testsuite/tests/deriving/perf/all.T | 11 +- testsuite/tests/perf/compiler/all.T | 1051 ++---------------------- testsuite/tests/perf/haddock/all.T | 183 +---- testsuite/tests/perf/join_points/all.T | 16 +- testsuite/tests/perf/should_run/all.T | 362 ++------ testsuite/tests/perf/space_leaks/all.T | 75 +- testsuite/tests/pmcheck/should_compile/all.T | 27 +- testsuite/tests/primops/should_run/all.T | 6 +- testsuite/tests/simplCore/should_compile/all.T | 3 +- testsuite/tests/simplStg/should_run/all.T | 5 +- 20 files changed, 972 insertions(+), 1739 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 a34302ceed7b936b3aa83bac64dd39aac765d146 From git at git.haskell.org Thu Aug 23 19:56:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 19:56:38 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: rts: Align the_gc_thread to 64 bytes (c3e50b0) Message-ID: <20180823195638.CB88B3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/c3e50b053cd49c465bfd2d095e3f681510993d2b/ghc >--------------------------------------------------------------- commit c3e50b053cd49c465bfd2d095e3f681510993d2b Author: Ben Gamari Date: Tue Aug 21 16:06:12 2018 -0400 rts: Align the_gc_thread to 64 bytes In a previous attempt (c6cc93bca69abc258513af8cf2370b14e70fd8fb) I had tried aligning to 8 bytes under the assumption that the problem was that the_gc_thread, a StgWord8[], wasn't being aligned to 8-bytes as the gc_thread struct would expect. However, we actually need even stronger alignment due to the alignment attribute attached to gen_workspace, which claims it should be aligned to a 64-byte boundary. This fixes #15482. Reviewers: erikd, simonmar Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15482 Differential Revision: https://phabricator.haskell.org/D5052 (cherry picked from commit 68a1fc29b4bb3eae54e4d96c9aec20e700040f34) >--------------------------------------------------------------- c3e50b053cd49c465bfd2d095e3f681510993d2b rts/sm/GC.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 67eba93..aeb0c8a 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -128,7 +128,9 @@ uint32_t mutlist_MUTVARS, gc_thread **gc_threads = NULL; #if !defined(THREADED_RTS) -StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)]; +// Must be aligned to 64-bytes to meet stated 64-byte alignment of gen_workspace +StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)] + ATTRIBUTE_ALIGNED(64); #endif // Number of threads running in *this* GC. Affects how many From git at git.haskell.org Thu Aug 23 19:56:41 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 19:56:41 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix gcdExtInteger (trac#15350) (767f56605) Message-ID: <20180823195641.97E793A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/767f5660529f41788d6df53ad0461a2856f15a85/ghc >--------------------------------------------------------------- commit 767f5660529f41788d6df53ad0461a2856f15a85 Author: Bodigrim Date: Sat Jul 7 00:20:10 2018 +0100 Fix gcdExtInteger (trac#15350) (cherry picked from commit 7c207c86ab0de955ebec70eeeb366ba0d94acc4a) >--------------------------------------------------------------- 767f5660529f41788d6df53ad0461a2856f15a85 libraries/integer-gmp/src/GHC/Integer/Type.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs index 9ea7c06..9636b9f 100644 --- a/libraries/integer-gmp/src/GHC/Integer/Type.hs +++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs @@ -1389,7 +1389,9 @@ gcdExtSBigNat x y = case runS go of (g,s) -> (# g, s #) where go = do g@(MBN# g#) <- newBigNat# gn0# - s@(MBN# s#) <- newBigNat# (absI# xn#) + -- According to https://gmplib.org/manual/Number-Theoretic-Functions.html#index-mpz_005fgcdext + -- abs(s) < abs(y) / (2 g) + s@(MBN# s#) <- newBigNat# (absI# yn#) I# ssn_# <- liftIO (integer_gmp_gcdext# s# g# x# xn# y# yn#) let ssn# = narrowGmpSize# ssn_# sn# = absI# ssn# From git at git.haskell.org Thu Aug 23 19:56:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 19:56:44 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Explicitly tell 'getNameToInstances' mods to load (18cb44d) Message-ID: <20180823195644.641483A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/18cb44dfae3f0847447da33c9d7a25d2709d838f/ghc >--------------------------------------------------------------- commit 18cb44dfae3f0847447da33c9d7a25d2709d838f Author: Alec Theriault Date: Tue Aug 21 16:03:40 2018 -0400 Explicitly tell 'getNameToInstances' mods to load Calculating which modules to load based on the InteractiveContext means maintaining a potentially very large GblRdrEnv. In Haddock's case, it is much cheaper (from a memory perspective) to just keep track of which modules interfaces we want loaded then hand these off explicitly to 'getNameToInstancesIndex'. Bumps haddock submodule. Reviewers: alexbiehl, bgamari Reviewed By: alexbiehl Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D5003 (cherry picked from commit c971e1193fa44bb507d1806d5bb61768670dc912) >--------------------------------------------------------------- 18cb44dfae3f0847447da33c9d7a25d2709d838f compiler/main/GHC.hs | 18 +++++++++++++----- utils/haddock | 2 +- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 2b25646..f80394e 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -300,7 +300,8 @@ import HscMain import GhcMake import DriverPipeline ( compileOne' ) import GhcMonad -import TcRnMonad ( finalSafeMode, fixSafeInstances ) +import TcRnMonad ( finalSafeMode, fixSafeInstances, initIfaceTcRn ) +import LoadIface ( loadSysInterface ) import TcRnTypes import Packages import NameSet @@ -1245,13 +1246,20 @@ getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env) -- by 'Name'. Each name's lists will contain every instance in which that name -- is mentioned in the instance head. getNameToInstancesIndex :: GhcMonad m - => [Module] -- ^ visible modules. An orphan instance will be returned if and - -- only it is visible from at least one module in the list. + => [Module] -- ^ visible modules. An orphan instance will be returned + -- if it is visible from at least one module in the list. + -> Maybe [Module] -- ^ modules to load. If this is not specified, we load + -- modules for everything that is in scope unqualified. -> m (Messages, Maybe (NameEnv ([ClsInst], [FamInst]))) -getNameToInstancesIndex visible_mods = do +getNameToInstancesIndex visible_mods mods_to_load = do hsc_env <- getSession liftIO $ runTcInteractive hsc_env $ - do { loadUnqualIfaces hsc_env (hsc_IC hsc_env) + do { case mods_to_load of + Nothing -> loadUnqualIfaces hsc_env (hsc_IC hsc_env) + Just mods -> + let doc = text "Need interface for reporting instances in scope" + in initIfaceTcRn $ mapM_ (loadSysInterface doc) mods + ; InstEnvs {ie_global, ie_local} <- tcGetInstEnvs ; let visible_mods' = mkModuleSet visible_mods ; (pkg_fie, home_fie) <- tcGetFamInstEnvs diff --git a/utils/haddock b/utils/haddock index 9765c10..3902a80 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 9765c10a27013b5c9168ee507d1f3b34cb4be26f +Subproject commit 3902a807acf4bccf5cd01d2115bed10d57316661 From git at git.haskell.org Thu Aug 23 19:56:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 19:56:47 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Correct limb length and assertion for gcdExtInteger (c53a9f7) Message-ID: <20180823195647.2F3B23A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/c53a9f7325fe6426b84a8c43e859471d65041453/ghc >--------------------------------------------------------------- commit c53a9f7325fe6426b84a8c43e859471d65041453 Author: DavidEichamnn Date: Tue Aug 21 16:06:45 2018 -0400 Correct limb length and assertion for gcdExtInteger Reviewers: hvr, bgamari, monoidal Reviewed By: monoidal Subscribers: monoidal, rwbarton, thomie, carter GHC Trac Issues: #15350 Differential Revision: https://phabricator.haskell.org/D5042 (cherry picked from commit c331592130ef592b92084e7417581a4039bfa7d2) >--------------------------------------------------------------- c53a9f7325fe6426b84a8c43e859471d65041453 libraries/integer-gmp/cbits/wrappers.c | 16 +++++++++++++--- testsuite/tests/lib/integer/integerGmpInternals.hs | 19 +++++++++++++++++++ .../tests/lib/integer/integerGmpInternals.stdout | 14 ++++++++++++++ 3 files changed, 46 insertions(+), 3 deletions(-) diff --git a/libraries/integer-gmp/cbits/wrappers.c b/libraries/integer-gmp/cbits/wrappers.c index 8f147ad..11e5179 100644 --- a/libraries/integer-gmp/cbits/wrappers.c +++ b/libraries/integer-gmp/cbits/wrappers.c @@ -286,9 +286,9 @@ integer_gmp_mpn_gcd(mp_limb_t r[], * reconstructed). * * g must have space for exactly gn=min(xn,yn) limbs. - * s must have space for at least xn limbs. + * s must have space for at least yn limbs. * - * return value: signed 'sn' of {sp,sn} + * return value: signed 'sn' of {sp,sn} where |sn| >= 1 */ mp_size_t integer_gmp_gcdext(mp_limb_t s0[], mp_limb_t g0[], @@ -305,15 +305,25 @@ integer_gmp_gcdext(mp_limb_t s0[], mp_limb_t g0[], mpz_gcdext (g, s, NULL, x, y); + // g must be positive (0 <= gn). + // According to the docs for mpz_gcdext(), we have: + // g < min(|y|/2|s|, |x|/2|t|) + // --> g < min(|y|, |x|) + // --> gn <= min(yn, xn) + // <-> gn <= gn0 const mp_size_t gn = g[0]._mp_size; assert(0 <= gn && gn <= gn0); memset(g0, 0, gn0*sizeof(mp_limb_t)); memcpy(g0, g[0]._mp_d, gn*sizeof(mp_limb_t)); mpz_clear (g); + // According to the docs for mpz_gcdext(), we have: + // |s| < |y| / 2g + // --> |s| < |y| (note g > 0) + // --> sn <= yn const mp_size_t ssn = s[0]._mp_size; const mp_size_t sn = mp_size_abs(ssn); - assert(sn <= mp_size_abs(xn)); + assert(sn <= mp_size_abs(yn)); memcpy(s0, s[0]._mp_d, sn*sizeof(mp_limb_t)); mpz_clear (s); diff --git a/testsuite/tests/lib/integer/integerGmpInternals.hs b/testsuite/tests/lib/integer/integerGmpInternals.hs index c90df5c..e45c6f4 100644 --- a/testsuite/tests/lib/integer/integerGmpInternals.hs +++ b/testsuite/tests/lib/integer/integerGmpInternals.hs @@ -79,6 +79,8 @@ main = do print $ powModInteger b e m print $ powModInteger b e (m-1) print $ powModSecInteger b e (m-1) + + putStrLn "\n# gcdExtInteger" print $ gcdExtInteger b e print $ gcdExtInteger e b print $ gcdExtInteger x y @@ -86,10 +88,27 @@ main = do print $ gcdExtInteger x (-y) print $ gcdExtInteger (-x) y print $ gcdExtInteger (-x) (-y) + + -- see Trac #15350 + do + let a = 2 + b = 2^65 + 1 + print $ gcdExtInteger a b + print $ gcdExtInteger a (-b) + print $ gcdExtInteger (-a) b + print $ gcdExtInteger (-a) (-b) + print $ gcdExtInteger b a + print $ gcdExtInteger b (-a) + print $ gcdExtInteger (-b) a + print $ gcdExtInteger (-b) (-a) + + putStrLn "\n# powInteger" print $ powInteger 12345 0 print $ powInteger 12345 1 print $ powInteger 12345 30 print $ [ (x,i) | x <- [-7..71], let i = recipModInteger x (2*3*11*11*17*17), i /= 0 ] + + putStrLn "\n# nextPrimeInteger" print $ I.nextPrimeInteger b print $ I.nextPrimeInteger e print $ [ k | k <- [ 0 .. 200 ], S# (I.testPrimeInteger k 25#) `elem` [1,2] ] diff --git a/testsuite/tests/lib/integer/integerGmpInternals.stdout b/testsuite/tests/lib/integer/integerGmpInternals.stdout index d5c1374..cff835b 100644 --- a/testsuite/tests/lib/integer/integerGmpInternals.stdout +++ b/testsuite/tests/lib/integer/integerGmpInternals.stdout @@ -1,6 +1,8 @@ 1527229998585248450016808958343740453059 682382427572745901624116300491295556924 682382427572745901624116300491295556924 + +# gcdExtInteger (1,-238164827888328100873319793437342927637138278785737103723156342382925) (1,302679100340807588460107986194035692812415103244388831792688023418704) (92889294,115110207004456909698806038261) @@ -8,10 +10,22 @@ (92889294,115110207004456909698806038261) (92889294,-115110207004456909698806038261) (92889294,-115110207004456909698806038261) +(1,-18446744073709551616) +(1,-18446744073709551616) +(1,18446744073709551616) +(1,18446744073709551616) +(1,1) +(1,1) +(1,-1) +(1,-1) + +# powInteger 1 12345 555562377826831043419246079513769804614412256811161773362797946971665712715296306339052301636736176350153982639312744140625 [(-7,149867),(-5,167851),(-1,209813),(1,1),(5,41963),(7,59947),(13,177535),(19,143557),(23,182447),(25,134281),(29,7235),(31,33841),(35,95915),(37,113413),(41,61409),(43,24397),(47,174101),(49,158431),(53,193979),(59,188477),(61,185737),(65,35507),(67,118999),(71,186173)] + +# nextPrimeInteger 2988348162058574136915891421498819466320163312926952423791023078876343 2351399303373464486466122544523690094744975233415544072992656881240451 [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199] From git at git.haskell.org Thu Aug 23 22:50:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 22:50:45 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: testsuite: Add (broken) test for #15473 (7c819cb) Message-ID: <20180823225045.4D2F93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/7c819cbed9677e840d8233aed1f88f27579545b4/ghc >--------------------------------------------------------------- commit 7c819cbed9677e840d8233aed1f88f27579545b4 Author: Ben Gamari Date: Tue Aug 7 13:59:31 2018 -0400 testsuite: Add (broken) test for #15473 (cherry picked from commit 5487f305d9dea298f0822082389d8a0225956c55) >--------------------------------------------------------------- 7c819cbed9677e840d8233aed1f88f27579545b4 testsuite/tests/typecheck/should_compile/T15473.hs | 12 ++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 2 +- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/typecheck/should_compile/T15473.hs b/testsuite/tests/typecheck/should_compile/T15473.hs new file mode 100644 index 0000000..d6bf57b --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15473.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +-- {-# LANGUAGE UndecidableInstances #-} +module Bug where + +type family Undefined :: k where {} + +type family LetInterleave xs t ts is (a_ahkO :: [a]) (a_ahkP :: [[a]]) :: [[a]] where + LetInterleave xs t ts is y z = Undefined y z + diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index a7b283d..6e0398d 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -646,4 +646,4 @@ test('T15428', normal, compile, ['']) test('T15431', normal, compile, ['']) test('T15431a', normal, compile, ['']) test('T15412', normal, compile, ['']) -test('T15499', normal, compile, ['']) +test('T15473', expect_broken(15473), compile, ['']) From git at git.haskell.org Thu Aug 23 22:50:48 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 22:50:48 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Turn infinite loop into a panic (d3ce884) Message-ID: <20180823225048.1E3EC3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/d3ce8842226877d753f55f2ab5fdf2b815d7300f/ghc >--------------------------------------------------------------- commit d3ce8842226877d753f55f2ab5fdf2b815d7300f Author: Simon Peyton Jones Date: Wed Aug 22 09:51:26 2018 +0100 Turn infinite loop into a panic In these two functions * TcIface.toIfaceAppTyArgsX * Type.piResultTys we take a type application (f t1 .. tn) and try to find its kind. It turned out that, if (f t1 .. tn) was ill-kinded the function would go into an infinite loop. That's not good: it caused the loop in Trac #15473. This patch doesn't fix the bug in #15473, but it does turn the loop into a decent panic, which is a step forward. (cherry picked from commit db6f1d9cfc74690798645a7cc5b25040c36bb35d) >--------------------------------------------------------------- d3ce8842226877d753f55f2ab5fdf2b815d7300f compiler/iface/ToIface.hs | 15 ++++++++++++--- compiler/types/Type.hs | 14 ++++++++++---- 2 files changed, 22 insertions(+), 7 deletions(-) diff --git a/compiler/iface/ToIface.hs b/compiler/iface/ToIface.hs index dc9ea71..8ca7fbc 100644 --- a/compiler/iface/ToIface.hs +++ b/compiler/iface/ToIface.hs @@ -291,11 +291,20 @@ toIfaceTcArgsX fr tc ty_args go env (FunTy _ res) (t:ts) -- No type-class args in tycon apps = ITC_Vis (toIfaceTypeX fr t) (go env res ts) - go env ty ts = ASSERT2( not (isEmptyTCvSubst env) - , ppr (tyConKind tc) $$ ppr ty_args ) - go (zapTCvSubst env) (substTy env ty) ts + go env ty ts@(t1:ts1) + | not (isEmptyTCvSubst env) + = go (zapTCvSubst env) (substTy env ty) ts -- See Note [Care with kind instantiation] in Type.hs + | otherwise + = -- There's a kind error in the type we are trying to print + -- e.g. kind = k, ty_args = [Int] + -- This is probably a compiler bug, so we print a trace and + -- carry on as if it were FunTy. Without the test for + -- isEmptyTCvSubst we'd get an infinite loop (Trac #15473) + WARN( True, ppr ty $$ ppr ts) + ITC_Vis (toIfaceTypeX fr t1) (go env ty ts1) + tidyToIfaceType :: TidyEnv -> Type -> IfaceType tidyToIfaceType env ty = toIfaceType (tidyType env ty) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 5c6ea9b..4dde129 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1036,13 +1036,19 @@ piResultTys ty orig_args@(arg:args) | ForAllTy (TvBndr tv _) res <- ty = go (extendVarEnv tv_env tv arg) res args - | otherwise -- See Note [Care with kind instantiation] - = ASSERT2( not (isEmptyVarEnv tv_env) - , ppr ty $$ ppr orig_args $$ ppr all_args ) - go emptyTvSubstEnv + | not (isEmptyVarEnv tv_env) -- See Note [Care with kind instantiation] + = go emptyTvSubstEnv (substTy (mkTvSubst in_scope tv_env) ty) all_args + | otherwise + = -- We have not run out of arguments, but the function doesn't + -- have the right kind to apply to them; so panic. + -- Without hte explicit isEmptyVarEnv test, an ill-kinded type + -- would give an infniite loop, which is very unhelpful + -- c.f. Trac #15473 + pprPanic "piResultTys2" (ppr ty $$ ppr orig_args $$ ppr all_args) + applyTysX :: [TyVar] -> Type -> [Type] -> Type -- applyTyxX beta-reduces (/\tvs. body_ty) arg_tys -- Assumes that (/\tvs. body_ty) is closed From git at git.haskell.org Thu Aug 23 22:50:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 22:50:50 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Accommodate API change in transSuperClasses (0282974) Message-ID: <20180823225050.E204A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/02829747cdf72fe83e511232cef12cd01df5dce6/ghc >--------------------------------------------------------------- commit 02829747cdf72fe83e511232cef12cd01df5dce6 Author: Simon Peyton Jones Date: Thu Aug 23 09:22:42 2018 +0100 Accommodate API change in transSuperClasses In this patch commit 6eabb6ddb7c53784792ee26b1e0657bde7eee7fb Author: Simon Peyton Jones Date: Tue Dec 15 14:26:13 2015 +0000 Allow recursive (undecidable) superclasses I changed (transSuperClasses p) to return only the superclasses of p, but not p itself. (Previously it always returned p as well.) The use of transSuperClasses in TcErrors.warnRedundantConstraints really needs 'p' in the result -- but I faild to fix this call site, and instead crippled the test for Trac #10100. This patch sets things right * Accomodates the API change * Re-enables T10100 * And thereby fixes Trac #11474 (cherry picked from commit 4293a80a3ea835412737911bcb2a6703e9af378b) >--------------------------------------------------------------- 02829747cdf72fe83e511232cef12cd01df5dce6 compiler/typecheck/TcErrors.hs | 6 +++--- testsuite/tests/typecheck/should_compile/T10100.hs | 1 - 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 355a9e3..1528a49 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -462,14 +462,14 @@ warnRedundantConstraints ctxt env info ev_vars redundant_evs = filterOut is_type_error $ case info of -- See Note [Redundant constraints in instance decls] - InstSkol -> filterOut improving ev_vars + InstSkol -> filterOut (improving . idType) ev_vars _ -> ev_vars -- See #15232 is_type_error = isJust . userTypeError_maybe . idType - improving ev_var = any isImprovementPred $ - transSuperClasses (idType ev_var) + improving pred -- (transSuperClasses p) does not include p + = any isImprovementPred (pred : transSuperClasses pred) reportBadTelescope :: ReportErrCtxt -> TcLclEnv -> Maybe SDoc -> [TcTyVar] -> TcM () reportBadTelescope ctxt env (Just telescope) skols diff --git a/testsuite/tests/typecheck/should_compile/T10100.hs b/testsuite/tests/typecheck/should_compile/T10100.hs index 031be76..b88803c 100644 --- a/testsuite/tests/typecheck/should_compile/T10100.hs +++ b/testsuite/tests/typecheck/should_compile/T10100.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} module T10100 where From git at git.haskell.org Thu Aug 23 22:50:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 22:50:53 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: --show-iface: Qualify all non-local names (c69c9d3) Message-ID: <20180823225053.B26773A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/c69c9d399746966f5d4ffbf73f49cd768a097dbd/ghc >--------------------------------------------------------------- commit c69c9d399746966f5d4ffbf73f49cd768a097dbd Author: Simon Jakobi Date: Sun Aug 12 11:10:39 2018 +0200 --show-iface: Qualify all non-local names Summary: In order to disambiguate names from different modules, qualify all names that don't originate in the current module. Also update docs for QueryQualifyName Test Plan: validate Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie, carter, tdammers GHC Trac Issues: #15269 Differential Revision: https://phabricator.haskell.org/D4852 (cherry picked from commit d42eef344a71990d12f27e88cdf10ba0b2a2f34b) >--------------------------------------------------------------- c69c9d399746966f5d4ffbf73f49cd768a097dbd compiler/iface/LoadIface.hs | 18 +++++++++++++++++- compiler/utils/Outputable.hs | 8 ++------ testsuite/tests/showIface/Orphans.stdout | 12 ++++++------ testsuite/tests/simplCore/should_compile/T4306.stdout | 2 +- testsuite/tests/simplCore/should_compile/T4918.stdout | 4 ++-- 5 files changed, 28 insertions(+), 16 deletions(-) diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index 20928d6..60a9bc9 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -1038,6 +1038,15 @@ ifaceStats eps Printing interfaces * * ************************************************************************ + +Note [Name qualification with --show-iface] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In order to disambiguate between identifiers from different modules, we qualify +all names that don't originate in the current module. In order to keep visual +noise as low as possible, we keep local names unqualified. + +For some background on this choice see trac #15269. -} -- | Read binary interface, and print it out @@ -1048,8 +1057,15 @@ showIface hsc_env filename = do iface <- initTcRnIf 's' hsc_env () () $ readBinIface IgnoreHiWay TraceBinIFaceReading filename let dflags = hsc_dflags hsc_env + -- See Note [Name qualification with --show-iface] + qualifyImportedNames mod _ + | mod == mi_module iface = NameUnqual + | otherwise = NameNotInScope1 + print_unqual = QueryQualify qualifyImportedNames + neverQualifyModules + neverQualifyPackages putLogMsg dflags NoReason SevDump noSrcSpan - (defaultDumpStyle dflags) (pprModIface iface) + (mkDumpStyle dflags print_unqual) (pprModIface iface) -- Show a ModIface but don't display details; suitable for ModIfaces stored in -- the EPT. diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index 4df9adf..929c7f3 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -181,12 +181,8 @@ data PrintUnqualified = QueryQualify { queryQualifyPackage :: QueryQualifyPackage } --- | given an /original/ name, this function tells you which module --- name it should be qualified with when printing for the user, if --- any. For example, given @Control.Exception.catch@, which is in scope --- as @Exception.catch@, this function will return @Just "Exception"@. --- Note that the return value is a ModuleName, not a Module, because --- in source code, names are qualified by ModuleNames. +-- | Given a `Name`'s `Module` and `OccName`, decide whether and how to qualify +-- it. type QueryQualifyName = Module -> OccName -> QualifyName -- | For a given module, we need to know whether to print it with diff --git a/testsuite/tests/showIface/Orphans.stdout b/testsuite/tests/showIface/Orphans.stdout index d61a5c9..63fcd79 100644 --- a/testsuite/tests/showIface/Orphans.stdout +++ b/testsuite/tests/showIface/Orphans.stdout @@ -1,6 +1,6 @@ -instance [orphan] IsList [Bool] = $fIsListBool -instance IsList [X] = $fIsListX -family instance Item [X] = D:R:ItemX -family instance [orphan] Item [Bool] = D:R:ItemBool -"myrule1" [orphan] forall @ a id @ (a -> a) (id @ a) = id @ a -"myrule2" forall id @ (X -> X) f = f +instance [orphan] GHC.Exts.IsList [GHC.Types.Bool] = $fIsListBool +instance GHC.Exts.IsList [X] = $fIsListX +family instance GHC.Exts.Item [X] = D:R:ItemX +family instance [orphan] GHC.Exts.Item [GHC.Types.Bool] +"myrule1" [orphan] forall @ a +"myrule2" forall GHC.Base.id @ (X -> X) f = f diff --git a/testsuite/tests/simplCore/should_compile/T4306.stdout b/testsuite/tests/simplCore/should_compile/T4306.stdout index 3d52e94..b2a93ff 100644 --- a/testsuite/tests/simplCore/should_compile/T4306.stdout +++ b/testsuite/tests/simplCore/should_compile/T4306.stdout @@ -1 +1 @@ - $wupd :: Double# -> Double# + $wupd :: GHC.Prim.Double# -> GHC.Prim.Double# diff --git a/testsuite/tests/simplCore/should_compile/T4918.stdout b/testsuite/tests/simplCore/should_compile/T4918.stdout index 257dbb5..4e957c0 100644 --- a/testsuite/tests/simplCore/should_compile/T4918.stdout +++ b/testsuite/tests/simplCore/should_compile/T4918.stdout @@ -1,2 +1,2 @@ - {- HasNoCafRefs, Strictness: m, Unfolding: (C# 'p'#) -} - {- HasNoCafRefs, Strictness: m, Unfolding: (C# 'q'#) -} + {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'p'#) -} + {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'q'#) -} From git at git.haskell.org Thu Aug 23 22:50:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 22:50:57 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix a typo in TcValidity.checkFamInstRhs (047c17a) Message-ID: <20180823225057.183E23A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/047c17a42f97fbd5df972b2c322b0ad0c6f9fdcd/ghc >--------------------------------------------------------------- commit 047c17a42f97fbd5df972b2c322b0ad0c6f9fdcd Author: Simon Peyton Jones Date: Wed Aug 22 10:00:20 2018 +0100 Fix a typo in TcValidity.checkFamInstRhs In error message generation we were using the wrong type constructor in inst_head. Result: the type became ill-kinded, and that sent the compiler into a loop. A separate patch fixes the loop. This patch fixes the actual bug -- Trac #15473. I also improved the "occurs more often" error message a bit. But it's still pretty terrible: * Variable ‘a’ occurs more often in the type family application ‘Undefined’ than in the instance head ‘LetInterleave xs t ts is y z’ It looks like nonsense, but all becomes clear if you use -fprint-explicit-kinds. Really we should fix this by spotting when invisible arguments are involved and at least suggesting -fprint-explicit-kinds. (cherry picked from commit 8c7f90abcc1e8f9f29b751f23174e8db89ba6983) >--------------------------------------------------------------- 047c17a42f97fbd5df972b2c322b0ad0c6f9fdcd compiler/typecheck/TcValidity.hs | 24 +++++++++++++--------- .../tests/typecheck/should_compile/T15473.stderr | 8 ++++++++ testsuite/tests/typecheck/should_compile/all.T | 2 +- 3 files changed, 23 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 7c6db0e..9f1c95d 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -60,7 +60,7 @@ import Unique ( mkAlphaTyVarUnique ) import qualified GHC.LanguageExtensions as LangExt import Control.Monad -import Data.List ( (\\) ) +import Data.List ( (\\), nub ) import qualified Data.List.NonEmpty as NE {- @@ -1441,13 +1441,14 @@ smallerMsg what inst_head noMoreMsg :: [TcTyVar] -> SDoc -> SDoc -> SDoc noMoreMsg tvs what inst_head - = vcat [ hang (text "Variable" <> plural tvs <+> quotes (pprWithCommas ppr tvs) + = vcat [ hang (text "Variable" <> plural tvs1 <+> quotes (pprWithCommas ppr tvs1) <+> occurs <+> text "more often") 2 (sep [ text "in the" <+> what , text "than in the instance head" <+> quotes inst_head ]) , parens undecidableMsg ] where - occurs = if isSingleton tvs then text "occurs" + tvs1 = nub tvs + occurs = if isSingleton tvs1 then text "occurs" else text "occur" undecidableMsg, constraintKindsMsg :: SDoc @@ -1799,22 +1800,25 @@ checkValidTyFamEqn mb_clsinfo fam_tc tvs cvs typats rhs pp_lhs loc checkFamInstRhs :: TyCon -> [Type] -- LHS -> [(TyCon, [Type])] -- type family calls in RHS -> [MsgDoc] -checkFamInstRhs tc lhsTys famInsts +checkFamInstRhs lhs_tc lhs_tys famInsts = mapMaybe check famInsts where - lhs_size = sizeTyConAppArgs tc lhsTys - fvs = fvTypes lhsTys + lhs_size = sizeTyConAppArgs lhs_tc lhs_tys + inst_head = pprType (TyConApp lhs_tc lhs_tys) + lhs_fvs = fvTypes lhs_tys check (tc, tys) | not (all isTyFamFree tys) = Just (nestedMsg what) | not (null bad_tvs) = Just (noMoreMsg bad_tvs what inst_head) | lhs_size <= fam_app_size = Just (smallerMsg what inst_head) | otherwise = Nothing where - what = text "type family application" - <+> quotes (pprType (TyConApp tc tys)) - inst_head = pprType (TyConApp tc lhsTys) - bad_tvs = fvTypes tys \\ fvs + what = text "type family application" + <+> quotes (pprType (TyConApp tc tys)) fam_app_size = sizeTyConAppArgs tc tys + bad_tvs = fvTypes tys \\ lhs_fvs + -- The (\\) is list difference; e.g. + -- [a,b,a,a] \\ [a,a] = [b,a] + -- So we are counting repetitions checkValidFamPats :: Maybe ClsInstInfo -> TyCon -> [TyVar] -> [CoVar] -> [Type] -- ^ patterns the user wrote diff --git a/testsuite/tests/typecheck/should_compile/T15473.stderr b/testsuite/tests/typecheck/should_compile/T15473.stderr new file mode 100644 index 0000000..6fdeaa1 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15473.stderr @@ -0,0 +1,8 @@ + +T15473.hs:11:3: error: + • Variable ‘a’ occurs more often + in the type family application ‘Undefined’ + than in the instance head ‘LetInterleave xs t ts is y z’ + (Use UndecidableInstances to permit this) + • In the equations for closed type family ‘LetInterleave’ + In the type family declaration for ‘LetInterleave’ diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 6e0398d..173a7e5 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -646,4 +646,4 @@ test('T15428', normal, compile, ['']) test('T15431', normal, compile, ['']) test('T15431a', normal, compile, ['']) test('T15412', normal, compile, ['']) -test('T15473', expect_broken(15473), compile, ['']) +test('T15473', normal, compile_fail, ['']) From git at git.haskell.org Thu Aug 23 22:51:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 22:51:00 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Suppress redundant givens during error reporting (89ad5fe) Message-ID: <20180823225100.A208E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/89ad5fed345d54ed73ecb3057346f3ef81864c8c/ghc >--------------------------------------------------------------- commit 89ad5fed345d54ed73ecb3057346f3ef81864c8c Author: Ryan Scott Date: Sun Aug 12 17:27:27 2018 +0200 Suppress redundant givens during error reporting Summary: When GHC reports that it cannot solve a constraint in error messages, it often reports what given constraints it has in scope. Unfortunately, sometimes redundant constraints (like `* ~ *`, from #15361) can sneak in. The fix is simple: blast away these redundant constraints using `mkMinimalBySCs`. Test Plan: make test TEST=T15361 Reviewers: simonpj, bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15361 Differential Revision: https://phabricator.haskell.org/D5002 (cherry picked from commit c552feea127d8ed8cbf4994a157c4bbe254b96c3) >--------------------------------------------------------------- 89ad5fed345d54ed73ecb3057346f3ef81864c8c compiler/typecheck/TcErrors.hs | 44 +++++++++++++++++++++- testsuite/tests/typecheck/should_fail/T15361.hs | 20 ++++++++++ .../tests/typecheck/should_fail/T15361.stderr | 36 ++++++++++++++++++ testsuite/tests/typecheck/should_fail/T5853.stderr | 2 +- testsuite/tests/typecheck/should_fail/all.T | 1 + 5 files changed, 100 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 1528a49..1b86756 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -1809,7 +1809,8 @@ misMatchOrCND ctxt ct oriented ty1 ty2 eq_pred = ctEvPred ev orig = ctEvOrigin ev givens = [ given | given <- getUserGivens ctxt, not (ic_no_eqs given)] - -- Keep only UserGivens that have some equalities + -- Keep only UserGivens that have some equalities. + -- See Note [Suppress redundant givens during error reporting] couldNotDeduce :: [UserGiven] -> (ThetaType, CtOrigin) -> SDoc couldNotDeduce givens (wanteds, orig) @@ -1824,10 +1825,49 @@ pp_givens givens : map (ppr_given (text "or from:")) gs where ppr_given herald implic@(Implic { ic_given = gs, ic_info = skol_info }) - = hang (herald <+> pprEvVarTheta gs) + = hang (herald <+> pprEvVarTheta (mkMinimalBySCs evVarPred gs)) + -- See Note [Suppress redundant givens during error reporting] + -- for why we use mkMinimalBySCs above. 2 (sep [ text "bound by" <+> ppr skol_info , text "at" <+> ppr (tcl_loc (implicLclEnv implic)) ]) +{- +Note [Suppress redundant givens during error reporting] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When GHC is unable to solve a constraint and prints out an error message, it +will print out what given constraints are in scope to provide some context to +the programmer. But we shouldn't print out /every/ given, since some of them +are not terribly helpful to diagnose type errors. Consider this example: + + foo :: Int :~: Int -> a :~: b -> a :~: c + foo Refl Refl = Refl + +When reporting that GHC can't solve (a ~ c), there are two givens in scope: +(Int ~ Int) and (a ~ b). But (Int ~ Int) is trivially soluble (i.e., +redundant), so it's not terribly useful to report it in an error message. +To accomplish this, we discard any Implications that do not bind any +equalities by filtering the `givens` selected in `misMatchOrCND` (based on +the `ic_no_eqs` field of the Implication). + +But this is not enough to avoid all redundant givens! Consider this example, +from #15361: + + goo :: forall (a :: Type) (b :: Type) (c :: Type). + a :~~: b -> a :~~: c + goo HRefl = HRefl + +Matching on HRefl brings the /single/ given (* ~ *, a ~ b) into scope. +The (* ~ *) part arises due the kinds of (:~~:) being unified. More +importantly, (* ~ *) is redundant, so we'd like not to report it. However, +the Implication (* ~ *, a ~ b) /does/ bind an equality (as reported by its +ic_no_eqs field), so the test above will keep it wholesale. + +To refine this given, we apply mkMinimalBySCs on it to extract just the (a ~ b) +part. This works because mkMinimalBySCs eliminates reflexive equalities in +addition to superclasses (see Note [Remove redundant provided dicts] +in TcPatSyn). +-} + extraTyVarEqInfo :: ReportErrCtxt -> TcTyVar -> TcType -> SDoc -- Add on extra info about skolem constants -- NB: The types themselves are already tidied diff --git a/testsuite/tests/typecheck/should_fail/T15361.hs b/testsuite/tests/typecheck/should_fail/T15361.hs new file mode 100644 index 0000000..53ae965 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15361.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeOperators #-} +module T15361 where + +import Data.Kind +import Data.Type.Equality + +-- Don't report (* ~ *) here +foo :: forall (a :: Type) (b :: Type) (c :: Type). + a :~~: b -> a :~~: c +foo HRefl = HRefl + +data Chumbawamba :: Type -> Type where + IGetKnockedDown :: (Eq a, Ord a) => a -> Chumbawamba a + +-- Don't report (Eq a) here +goo :: Chumbawamba a -> String +goo (IGetKnockedDown x) = show x diff --git a/testsuite/tests/typecheck/should_fail/T15361.stderr b/testsuite/tests/typecheck/should_fail/T15361.stderr new file mode 100644 index 0000000..93b0174 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15361.stderr @@ -0,0 +1,36 @@ + +T15361.hs:13:13: error: + • Could not deduce: a ~ c + from the context: b ~ a + bound by a pattern with constructor: + HRefl :: forall k1 (a :: k1). a :~~: a, + in an equation for ‘foo’ + at T15361.hs:13:5-9 + ‘a’ is a rigid type variable bound by + the type signature for: + foo :: forall a b c. (a :~~: b) -> a :~~: c + at T15361.hs:(11,1)-(12,27) + ‘c’ is a rigid type variable bound by + the type signature for: + foo :: forall a b c. (a :~~: b) -> a :~~: c + at T15361.hs:(11,1)-(12,27) + Expected type: a :~~: c + Actual type: a :~~: a + • In the expression: HRefl + In an equation for ‘foo’: foo HRefl = HRefl + • Relevant bindings include + foo :: (a :~~: b) -> a :~~: c (bound at T15361.hs:13:1) + +T15361.hs:20:27: error: + • Could not deduce (Show a) arising from a use of ‘show’ + from the context: Ord a + bound by a pattern with constructor: + IGetKnockedDown :: forall a. (Eq a, Ord a) => a -> Chumbawamba a, + in an equation for ‘goo’ + at T15361.hs:20:6-22 + Possible fix: + add (Show a) to the context of + the type signature for: + goo :: forall a. Chumbawamba a -> String + • In the expression: show x + In an equation for ‘goo’: goo (IGetKnockedDown x) = show x diff --git a/testsuite/tests/typecheck/should_fail/T5853.stderr b/testsuite/tests/typecheck/should_fail/T5853.stderr index decc6ad..573a532 100644 --- a/testsuite/tests/typecheck/should_fail/T5853.stderr +++ b/testsuite/tests/typecheck/should_fail/T5853.stderr @@ -2,7 +2,7 @@ T5853.hs:15:46: error: • Could not deduce: Subst (Subst fa a) b ~ Subst fa b arising from a use of ‘<$>’ - from the context: (F fa, Elem fa ~ Elem fa, Elem (Subst fa b) ~ b, + from the context: (F fa, Elem (Subst fa b) ~ b, Subst fa b ~ Subst fa b, Subst (Subst fa b) (Elem fa) ~ fa, F (Subst fa a), Elem (Subst fa a) ~ a, Elem fa ~ Elem fa, Subst (Subst fa a) (Elem fa) ~ fa, Subst fa a ~ Subst fa a) diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index e2d6b71..434c79c 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -474,4 +474,5 @@ test('T14884', normal, compile_fail, ['']) test('T14904a', normal, compile_fail, ['']) test('T14904b', normal, compile_fail, ['']) test('T15067', normal, compile_fail, ['']) +test('T15361', normal, compile_fail, ['']) test('T15527', normal, compile_fail, ['']) From git at git.haskell.org Thu Aug 23 22:51:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 22:51:04 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Properly designate LambdaCase alts as CaseAlt in TH (e57a15d) Message-ID: <20180823225104.20CB13A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/e57a15d820b44751fcfc14c056ae284caab697a6/ghc >--------------------------------------------------------------- commit e57a15d820b44751fcfc14c056ae284caab697a6 Author: Ryan Scott Date: Tue Aug 14 22:35:23 2018 +0200 Properly designate LambdaCase alts as CaseAlt in TH Summary: When `\case` expressions are parsed normally, their alternatives are marked as `CaseAlt` (which means that they are pretty-printed without a `\` character in front of them, unlike for lambda expressions). However, `\case` expressions created by way of Template Haskell (in `Convert`) inconsistently designated the case alternatives as `LambdaExpr`, causing them to be pretty-printed poorly (as shown in #15518). The fix is simple: use `CaseAlt` consistently. Test Plan: make test TEST=T15518 Reviewers: goldfire, bgamari Subscribers: rwbarton, carter GHC Trac Issues: #15518 Differential Revision: https://phabricator.haskell.org/D5069 (cherry picked from commit 32008a9d0e09f0cc8899aa871d9a6b63fcc28a1a) >--------------------------------------------------------------- e57a15d820b44751fcfc14c056ae284caab697a6 compiler/hsSyn/Convert.hs | 2 +- testsuite/tests/th/T15518.hs | 8 ++++++++ testsuite/tests/th/T15518.stderr | 10 ++++++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 20 insertions(+), 1 deletion(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index c64cb7c..b637a3c 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -829,7 +829,7 @@ cvtl e = wrapL (cvt e) ; return $ HsLam noExt (mkMatchGroup FromSource [mkSimpleMatch LambdaExpr pats e'])} - cvt (LamCaseE ms) = do { ms' <- mapM (cvtMatch LambdaExpr) ms + cvt (LamCaseE ms) = do { ms' <- mapM (cvtMatch CaseAlt) ms ; return $ HsLamCase noExt (mkMatchGroup FromSource ms') } diff --git a/testsuite/tests/th/T15518.hs b/testsuite/tests/th/T15518.hs new file mode 100644 index 0000000..eb424a9 --- /dev/null +++ b/testsuite/tests/th/T15518.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskell #-} +module T15518 where + +$([d| f :: Bool -> () + f = \case True -> () + False -> () + |]) diff --git a/testsuite/tests/th/T15518.stderr b/testsuite/tests/th/T15518.stderr new file mode 100644 index 0000000..7d9ef29 --- /dev/null +++ b/testsuite/tests/th/T15518.stderr @@ -0,0 +1,10 @@ +T15518.hs:(5,3)-(8,6): Splicing declarations + [d| f :: Bool -> () + f = \case + True -> () + False -> () |] + ======> + f :: Bool -> () + f = \case + True -> () + False -> () diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index f6656c4..ebdd2ce 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -419,3 +419,4 @@ test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T15321', normal, compile_fail, ['']) test('T15365', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T15518', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) From git at git.haskell.org Thu Aug 23 22:51:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Aug 2018 22:51:07 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Expose the StableName constructor (768cc53) Message-ID: <20180823225107.38C933A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/768cc53d73e46954b01df69c6b215a41b3533f56/ghc >--------------------------------------------------------------- commit 768cc53d73e46954b01df69c6b215a41b3533f56 Author: David Feuer Date: Mon Aug 20 20:08:14 2018 -0400 Expose the StableName constructor * Move the definition of `StableName` from `System.Mem.StableName` to a new `GHC.StableName` module. * Expose the `StableName` data constructor from `GHC.StableName`. Once we have `UnliftedArray#`, this will enable `StableName`s to be stored in `UnliftedArray`s (from `primitive`) without unsafe coercions. Reviewers: hvr, bgamari, andrewthad, osa1 Reviewed By: osa1 Subscribers: osa1, rwbarton, carter GHC Trac Issues: #15535 Differential Revision: https://phabricator.haskell.org/D5078 (cherry picked from commit 9c4e6c6b1affd410604f8f76ecf56abfcc5cccb6) >--------------------------------------------------------------- 768cc53d73e46954b01df69c6b215a41b3533f56 libraries/base/{System/Mem => GHC}/StableName.hs | 4 +- libraries/base/System/Mem/StableName.hs | 75 +----------------------- libraries/base/base.cabal | 1 + 3 files changed, 5 insertions(+), 75 deletions(-) diff --git a/libraries/base/System/Mem/StableName.hs b/libraries/base/GHC/StableName.hs similarity index 98% copy from libraries/base/System/Mem/StableName.hs copy to libraries/base/GHC/StableName.hs index dcd5273..7369f41 100644 --- a/libraries/base/System/Mem/StableName.hs +++ b/libraries/base/GHC/StableName.hs @@ -27,9 +27,9 @@ -- ------------------------------------------------------------------------------- -module System.Mem.StableName ( +module GHC.StableName ( -- * Stable Names - StableName, + StableName (..), makeStableName, hashStableName, eqStableName diff --git a/libraries/base/System/Mem/StableName.hs b/libraries/base/System/Mem/StableName.hs index dcd5273..064d928 100644 --- a/libraries/base/System/Mem/StableName.hs +++ b/libraries/base/System/Mem/StableName.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | @@ -35,72 +32,4 @@ module System.Mem.StableName ( eqStableName ) where -import GHC.IO ( IO(..) ) -import GHC.Base ( Int(..), StableName#, makeStableName# - , eqStableName#, stableNameToInt# ) - ------------------------------------------------------------------------------ --- Stable Names - -{-| - An abstract name for an object, that supports equality and hashing. - - Stable names have the following property: - - * If @sn1 :: StableName@ and @sn2 :: StableName@ and @sn1 == sn2@ - then @sn1@ and @sn2@ were created by calls to @makeStableName@ on - the same object. - - The reverse is not necessarily true: if two stable names are not - equal, then the objects they name may still be equal. Note in particular - that `makeStableName` may return a different `StableName` after an - object is evaluated. - - Stable Names are similar to Stable Pointers ("Foreign.StablePtr"), - but differ in the following ways: - - * There is no @freeStableName@ operation, unlike "Foreign.StablePtr"s. - Stable names are reclaimed by the runtime system when they are no - longer needed. - - * There is no @deRefStableName@ operation. You can\'t get back from - a stable name to the original Haskell object. The reason for - this is that the existence of a stable name for an object does not - guarantee the existence of the object itself; it can still be garbage - collected. --} - -data StableName a = StableName (StableName# a) - --- | Makes a 'StableName' for an arbitrary object. The object passed as --- the first argument is not evaluated by 'makeStableName'. -makeStableName :: a -> IO (StableName a) -makeStableName a = IO $ \ s -> - case makeStableName# a s of (# s', sn #) -> (# s', StableName sn #) - --- | Convert a 'StableName' to an 'Int'. The 'Int' returned is not --- necessarily unique; several 'StableName's may map to the same 'Int' --- (in practice however, the chances of this are small, so the result --- of 'hashStableName' makes a good hash key). -hashStableName :: StableName a -> Int -hashStableName (StableName sn) = I# (stableNameToInt# sn) - --- | @since 2.01 -instance Eq (StableName a) where - (StableName sn1) == (StableName sn2) = - case eqStableName# sn1 sn2 of - 0# -> False - _ -> True - --- | Equality on 'StableName' that does not require that the types of --- the arguments match. --- --- @since 4.7.0.0 -eqStableName :: StableName a -> StableName b -> Bool -eqStableName (StableName sn1) (StableName sn2) = - case eqStableName# sn1 sn2 of - 0# -> False - _ -> True - -- Requested by Emil Axelsson on glasgow-haskell-users, who wants to - -- use it for implementing observable sharing. - +import GHC.StableName diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index dbeec33..f02ff08 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -278,6 +278,7 @@ Library GHC.STRef GHC.Show GHC.Stable + GHC.StableName GHC.Stack GHC.Stack.CCS GHC.Stack.Types From git at git.haskell.org Fri Aug 24 03:24:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Aug 2018 03:24:56 +0000 (UTC) Subject: [commit: ghc] master: TcSimplify: Condense MASSERT2() usage onto a single line (8d72f87) Message-ID: <20180824032456.6986E3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8d72f87877fbc6e90ebeff12f71b69c44aea4875/ghc >--------------------------------------------------------------- commit 8d72f87877fbc6e90ebeff12f71b69c44aea4875 Author: Ben Gamari Date: Thu Aug 23 22:39:06 2018 -0400 TcSimplify: Condense MASSERT2() usage onto a single line Sadly macOS's C preprocessor gets angry at the sight of multi-line macro invocations. >--------------------------------------------------------------- 8d72f87877fbc6e90ebeff12f71b69c44aea4875 compiler/typecheck/TcSimplify.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index c2d7eb0..2a89ab2 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1558,9 +1558,7 @@ solveImplication imp@(Implic { ic_tclvl = tclvl -- remaining commented out for now. {- check_tc_level = do { cur_lvl <- TcS.getTcLevel - ; MASSERT2( tclvl == pushTcLevel cur_lvl - , text "Cur lvl =" <+> ppr cur_lvl $$ - text "Imp lvl =" <+> ppr tclvl ) } + ; MASSERT2( tclvl == pushTcLevel cur_lvl , text "Cur lvl =" <+> ppr cur_lvl $$ text "Imp lvl =" <+> ppr tclvl ) } -} ---------------------- From git at git.haskell.org Fri Aug 24 03:24:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Aug 2018 03:24:59 +0000 (UTC) Subject: [commit: ghc] master: Update unicode tables to v. 12 of the standard (14d8838) Message-ID: <20180824032459.5981F3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/14d88380ecb909e7032598aaad4efebb72561784/ghc >--------------------------------------------------------------- commit 14d88380ecb909e7032598aaad4efebb72561784 Author: Artem Pelenitsyn Date: Tue Aug 21 19:33:35 2018 -0400 Update unicode tables to v. 12 of the standard Reviewers: hvr, bgamari, Azel Reviewed By: bgamari Subscribers: thomie, Azel, rwbarton, carter GHC Trac Issues: #5518, #15525 Differential Revision: https://phabricator.haskell.org/D5066 >--------------------------------------------------------------- 14d88380ecb909e7032598aaad4efebb72561784 docs/users_guide/8.8.1-notes.rst | 2 + libraries/base/cbits/README.Unicode | 2 +- libraries/base/cbits/WCsubst.c | 2262 ++++++++++++++++++-------------- libraries/base/changelog.md | 6 + libraries/base/tests/T10412.stdout | 2 +- libraries/base/tests/unicode002.stdout | 466 +++---- 6 files changed, 1548 insertions(+), 1192 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 14d88380ecb909e7032598aaad4efebb72561784 From git at git.haskell.org Fri Aug 24 03:25:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Aug 2018 03:25:02 +0000 (UTC) Subject: [commit: ghc] master: docs: Add changelog and release notes entry for traceBinaryEvent# (edb4714) Message-ID: <20180824032502.30F623A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/edb471498149b9aae841b1b1ff8d2f418002a829/ghc >--------------------------------------------------------------- commit edb471498149b9aae841b1b1ff8d2f418002a829 Author: Ben Gamari Date: Tue Aug 21 19:08:12 2018 -0400 docs: Add changelog and release notes entry for traceBinaryEvent# >--------------------------------------------------------------- edb471498149b9aae841b1b1ff8d2f418002a829 docs/users_guide/8.8.1-notes.rst | 7 +++++++ libraries/ghc-prim/changelog.md | 7 +++++++ 2 files changed, 14 insertions(+) diff --git a/docs/users_guide/8.8.1-notes.rst b/docs/users_guide/8.8.1-notes.rst index 7ea2c87..7e54645 100644 --- a/docs/users_guide/8.8.1-notes.rst +++ b/docs/users_guide/8.8.1-notes.rst @@ -40,6 +40,13 @@ Template Haskell ~~~~~~~~~~~~~~~~ +``ghc-prim`` library +~~~~~~~~~~~~~~~~~~~~ + +- GHC now exposes a new primop, ``traceBinaryEvent#``. This primop writes + eventlog events similar to ``traceBinaryEvent#`` but allows the user to pass + the event payload as a binary blob instead of a ``String``. + ``ghc`` library ~~~~~~~~~~~~~~~ diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md index 53e77a0..76da3e0 100644 --- a/libraries/ghc-prim/changelog.md +++ b/libraries/ghc-prim/changelog.md @@ -1,3 +1,10 @@ +## 0.6.0 + +- Shipped with GHC 8.8.1 + +- Added to `GHC.Prim`: + traveBinaryEvent# :: Addr# -> Int# -> State# s -> State# s + ## 0.5.3 (edit as necessary) - Shipped with GHC 8.6.1 From git at git.haskell.org Fri Aug 24 09:55:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Aug 2018 09:55:49 +0000 (UTC) Subject: [commit: ghc] master: Clean up TcHsSyn.zonkEnv (184a569) Message-ID: <20180824095549.964A43A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/184a569c5f5fe6e2eed73b2cff35722918c44efd/ghc >--------------------------------------------------------------- commit 184a569c5f5fe6e2eed73b2cff35722918c44efd Author: Simon Peyton Jones Date: Fri Aug 24 08:14:15 2018 +0100 Clean up TcHsSyn.zonkEnv Triggered by Trac #15552, I'd been looking at ZonkEnv in TcHsSyn. This patch does some minor refactoring * Make ZonkEnv into a record with named fields, and use them. (I'm planning to add a new field, for TyCons, so this prepares the way.) * Replace UnboundTyVarZonker (a higer order function) with the simpler and more self-descriptive ZonkFlexi data type, below. It's just much more perspicuous and direct, and (I suspect) a tiny bit faster too -- no unknown function calls. data ZonkFlexi -- See Note [Un-unified unification variables] = DefaultFlexi -- Default unbound unificaiton variables to Any | SkolemiseFlexi -- Skolemise unbound unification variables -- See Note [Zonking the LHS of a RULE] | RuntimeUnkFlexi -- Used in the GHCi debugger There was one knock-on effect in the GHCi debugger -- the RuntimeUnkFlexi case. Somehow previously, these RuntimeUnk variables were sometimes getting SystemNames (and hence printed as 'a0', 'a1', etc) and sometimes not (and hence printed as 'a', 'b' etc). I'm not sure precisely why, but the new behaviour seems more uniform, so I just accepted the (small) renaming wibbles in some ghci.debugger tests. I had a quick look at perf: any changes are tiny. >--------------------------------------------------------------- 184a569c5f5fe6e2eed73b2cff35722918c44efd compiler/ghci/RtClosureInspect.hs | 15 +- compiler/typecheck/TcHsSyn.hs | 247 +++++++++++---------- compiler/typecheck/TcMType.hs | 21 +- .../tests/ghci.debugger/scripts/print003.stdout | 10 +- .../tests/ghci.debugger/scripts/print006.stdout | 6 +- .../tests/ghci.debugger/scripts/print008.stdout | 6 +- .../tests/ghci.debugger/scripts/print010.stdout | 4 +- .../tests/ghci.debugger/scripts/print012.stdout | 6 +- .../tests/ghci.debugger/scripts/print019.stdout | 2 +- .../tests/ghci.debugger/scripts/print034.stdout | 2 +- 10 files changed, 161 insertions(+), 158 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 184a569c5f5fe6e2eed73b2cff35722918c44efd From git at git.haskell.org Fri Aug 24 09:55:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Aug 2018 09:55:52 +0000 (UTC) Subject: [commit: ghc] master: Comments only (1cca442) Message-ID: <20180824095552.7D4CF3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1cca4423818399a640f11ab47219258700cce617/ghc >--------------------------------------------------------------- commit 1cca4423818399a640f11ab47219258700cce617 Author: Simon Peyton Jones Date: Fri Aug 24 10:29:40 2018 +0100 Comments only >--------------------------------------------------------------- 1cca4423818399a640f11ab47219258700cce617 compiler/typecheck/TcRnTypes.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 5a74587..41defc7 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -2943,7 +2943,9 @@ ctFlavourRole (CTyEqCan { cc_ev = ev, cc_eq_rel = eq_rel }) ctFlavourRole (CFunEqCan { cc_ev = ev }) = (ctEvFlavour ev, NomEq) ctFlavourRole (CHoleCan { cc_ev = ev }) - = (ctEvFlavour ev, NomEq) + = (ctEvFlavour ev, NomEq) -- NomEq: CHoleCans can be rewritten by + -- by nominal equalities but empahatically + -- not by representational equalities ctFlavourRole ct = ctEvFlavourRole (ctEvidence ct) From git at git.haskell.org Fri Aug 24 09:55:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Aug 2018 09:55:55 +0000 (UTC) Subject: [commit: ghc] master: Add comments about pretty-printing via IfaceSyn (4b79329) Message-ID: <20180824095555.88CAB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4b79329f24dfdf907f223ff9fc41c77d9df86e04/ghc >--------------------------------------------------------------- commit 4b79329f24dfdf907f223ff9fc41c77d9df86e04 Author: Simon Peyton Jones Date: Fri Aug 24 10:29:58 2018 +0100 Add comments about pretty-printing via IfaceSyn Provoked by discussion on Phab:D5097 (Trac #15546), I'm adding a big Note explaing the strategy of pretty-printing via IfaceSyn >--------------------------------------------------------------- 4b79329f24dfdf907f223ff9fc41c77d9df86e04 compiler/iface/IfaceSyn.hs | 1 + compiler/iface/IfaceType.hs | 28 ++------------- compiler/main/PprTyThing.hs | 87 ++++++++++++++++++++++++++++++--------------- compiler/types/TyCoRep.hs | 6 +++- 4 files changed, 67 insertions(+), 55 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4b79329f24dfdf907f223ff9fc41c77d9df86e04 From git at git.haskell.org Fri Aug 24 16:20:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Aug 2018 16:20:44 +0000 (UTC) Subject: [commit: ghc] master: Better error reporting for inaccessible code (ff29fc8) Message-ID: <20180824162044.684B63A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ff29fc84c03c800cfa04c2a00eb8edf6fa5f4183/ghc >--------------------------------------------------------------- commit ff29fc84c03c800cfa04c2a00eb8edf6fa5f4183 Author: Simon Peyton Jones Date: Fri Aug 24 16:40:28 2018 +0100 Better error reporting for inaccessible code This patch fixes Trac #15558. There turned out to be two distinct problems * In TcExpr.tc_poly_expr_nc we had tc_poly_expr_nc (L loc expr) res_ty = do { traceTc "tcPolyExprNC" (ppr res_ty) ; (wrap, expr') <- tcSkolemiseET GenSigCtxt res_ty $ \ res_ty -> setSrcSpan loc $ -- NB: setSrcSpan *after* skolemising, -- so we get better skolem locations tcExpr expr res_ty Putting the setSrcSpan inside the tcSkolemise means that the location on the Implication constraint is the /call/ to the function rather than the /argument/ to the call, and that is really quite wrong. I don't know what Richard's comment NB means -- I moved the setSrcSpan outside, and the "binding site" info in error messages actually improved. The reason I found this is that it affects the span reported for Trac #15558. * In TcErrors.mkGivenErrorReporter we carefully munge the location for an insoluble Given constraint (Note [Inaccessible code]). But the 'implic' passed in wasn't necesarily the immediately- enclosing implication -- but for location-munging purposes it jolly well should be. Solution: use the innermost implication. This actually simplifies the code -- no need to pass an implication in to mkGivenErrorReporter. >--------------------------------------------------------------- ff29fc84c03c800cfa04c2a00eb8edf6fa5f4183 compiler/typecheck/TcErrors.hs | 42 ++++++++++++---------- compiler/typecheck/TcExpr.hs | 6 ++-- .../tests/dependent/should_fail/T14066d.stderr | 2 +- testsuite/tests/gadt/T15558.hs | 14 ++++++++ testsuite/tests/gadt/T15558.stderr | 9 +++++ testsuite/tests/gadt/all.T | 1 + testsuite/tests/polykinds/T7594.stderr | 2 +- .../tests/typecheck/should_fail/tcfail068.stderr | 8 ++--- .../tests/typecheck/should_fail/tcfail076.stderr | 4 +-- 9 files changed, 58 insertions(+), 30 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ff29fc84c03c800cfa04c2a00eb8edf6fa5f4183 From git at git.haskell.org Sat Aug 25 10:24:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 25 Aug 2018 10:24:53 +0000 (UTC) Subject: [commit: ghc] master: ghc, ghc-pkg: use getExecutablePath on Windows when base >= 4.11.0 (c523525) Message-ID: <20180825102453.6B2DE3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c523525b0e434d848f6e47ea3f9a37485965fa79/ghc >--------------------------------------------------------------- commit c523525b0e434d848f6e47ea3f9a37485965fa79 Author: Tamar Christina Date: Sat Aug 11 19:25:09 2018 +0100 ghc, ghc-pkg: use getExecutablePath on Windows when base >= 4.11.0 Summary: This completes the work started in D4227 by using just 'getExecutablePath' in ghc and ghc-pkg when building with base >= 4.11.0. On the long term, we will be able to simply kill the existing code that follows (or not) symlinks and just get this behaviour for free from getExecutable. For now we however have to require base >= 4.11.0 to be able to just use getExecutablePath under Windows, and use the current code when building with an older base. Original code by @alpmestan commandeering since patch has been stale and bug remains open. Test Plan: Validate Reviewers: angerman, bgamari, erikd, alpmestan Reviewed By: bgamari Subscribers: carter, rwbarton, thomie GHC Trac Issues: #14483 Differential Revision: https://phabricator.haskell.org/D4229 >--------------------------------------------------------------- c523525b0e434d848f6e47ea3f9a37485965fa79 compiler/main/SysTools.hs | 6 +++--- compiler/main/SysTools/BaseDir.hs | 26 +++++++++++++++++++++++++- utils/ghc-pkg/Main.hs | 38 +++++++++++++++++++++++++------------- 3 files changed, 53 insertions(+), 17 deletions(-) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index ff36c04..9bbce19 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -141,12 +141,12 @@ initSysTools top_dir mtool_dir <- findToolDir top_dir -- see Note [tooldir: How GHC finds mingw and perl on Windows] - let settingsFile = top_dir "settings" - platformConstantsFile = top_dir "platformConstants" - installed :: FilePath -> FilePath + let installed :: FilePath -> FilePath installed file = top_dir file libexec :: FilePath -> FilePath libexec file = top_dir "bin" file + settingsFile = installed "settings" + platformConstantsFile = installed "platformConstants" settingsStr <- readFile settingsFile platformConstantsStr <- readFile platformConstantsFile diff --git a/compiler/main/SysTools/BaseDir.hs b/compiler/main/SysTools/BaseDir.hs index 625baec..f858c8f 100644 --- a/compiler/main/SysTools/BaseDir.hs +++ b/compiler/main/SysTools/BaseDir.hs @@ -33,7 +33,18 @@ import System.Environment (getExecutablePath) -- Windows #if defined(mingw32_HOST_OS) +# if MIN_VERSION_Win32(2,5,0) +# if !MIN_VERSION_base(4,11,0) import qualified System.Win32.Types as Win32 +# endif +# else +import qualified System.Win32.Info as Win32 +# endif +# if MIN_VERSION_base(4,11,0) +import System.Environment (getExecutablePath) +import System.Directory (doesDirectoryExist) +# else +import Data.Char import Exception import Foreign import Foreign.C.String @@ -42,6 +53,7 @@ import System.Win32.Types (DWORD, LPTSTR, HANDLE) import System.Win32.Types (failIfNull, failIf, iNVALID_HANDLE_VALUE) import System.Win32.File (createFile,closeHandle, gENERIC_READ, fILE_SHARE_READ, oPEN_EXISTING, fILE_ATTRIBUTE_NORMAL, fILE_FLAG_BACKUP_SEMANTICS ) import System.Win32.DLL (loadLibrary, getProcAddress) +# endif #endif #if defined(mingw32_HOST_OS) @@ -133,7 +145,18 @@ findTopDir Nothing Just dir -> return dir getBaseDir :: IO (Maybe String) + #if defined(mingw32_HOST_OS) + +-- locate the "base dir" when given the path +-- to the real ghc executable (as opposed to symlink) +-- that is running this function. +rootDir :: FilePath -> FilePath +rootDir = takeDirectory . takeDirectory . normalise + +#if MIN_VERSION_base(4,11,0) +getBaseDir = Just . (\p -> p "lib") . rootDir <$> getExecutablePath +#else -- Assuming we are running ghc, accessed by path $(stuff)//ghc.exe, -- return the path $(stuff)/lib. getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32. @@ -209,6 +232,7 @@ type GetFinalPath = HANDLE -> LPTSTR -> DWORD -> DWORD -> IO DWORD foreign import WINDOWS_CCONV unsafe "dynamic" makeGetFinalPathNameByHandle :: FunPtr GetFinalPath -> GetFinalPath +#endif #elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) -- on unix, this is a bit more confusing. -- The layout right now is something like @@ -242,7 +266,7 @@ findToolDir -> IO (Maybe FilePath) #if defined(mingw32_HOST_OS) findToolDir top_dir = go 0 (top_dir "..") - where maxDepth = 2 + where maxDepth = 3 go :: Int -> FilePath -> IO (Maybe FilePath) go k path | k == maxDepth = throwGhcExceptionIO $ diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 69137eb..3aa4186 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -17,6 +17,24 @@ #endif #endif +-- The SIMPLE_WIN_GETLIBDIR macro will only be set when +-- building on windows. +-- +-- Its purpose is to let us know whether the Windows implementation of +-- 'getExecutablePath' follows symlinks or not (it does follow them in +-- base >= 4.11). If it does, the implementation of getLibDir is straightforward +-- but if it does not follow symlinks, we need to follow them ourselves here. +-- Once we do not have to support building ghc-pkg with base < 4.11 anymore, +-- we can keep only the simple, straightforward implementation that just uses +-- 'getExecutablePath'. +#if defined(mingw32_HOST_OS) +#if MIN_VERSION_base(4,11,0) +#define SIMPLE_WIN_GETLIBDIR 1 +#else +#define SIMPLE_WIN_GETLIBDIR 0 +#endif +#endif + ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 2004-2009. @@ -66,7 +84,7 @@ import System.Directory ( doesDirectoryExist, getDirectoryContents, getCurrentDirectory ) import System.Exit ( exitWith, ExitCode(..) ) import System.Environment ( getArgs, getProgName, getEnv ) -#if defined(darwin_HOST_OS) || defined(linux_HOST_OS) +#if defined(darwin_HOST_OS) || defined(linux_HOST_OS) || SIMPLE_WIN_GETLIBDIR import System.Environment ( getExecutablePath ) #endif import System.IO @@ -80,10 +98,12 @@ import qualified Data.Set as Set import qualified Data.Map as Map #if defined(mingw32_HOST_OS) --- mingw32 needs these for getExecDir +#if !SIMPLE_WIN_GETLIBDIR +-- mingw32 needs these for getExecDir when base < 4.11 import Foreign import Foreign.C import System.Directory ( canonicalizePath ) +#endif import GHC.ConsoleHandler #else import System.Posix hiding (fdToHandle) @@ -2194,7 +2214,8 @@ dieForcible s = die (s ++ " (use --force to override)") -- Cut and pasted from ghc/compiler/main/SysTools getLibDir :: IO (Maybe String) -#if defined(mingw32_HOST_OS) + +#if defined(mingw32_HOST_OS) && !SIMPLE_WIN_GETLIBDIR subst :: Char -> Char -> String -> String subst a b ls = map (\ x -> if x == a then b else x) ls @@ -2233,16 +2254,7 @@ getExecPath = try_size 2048 -- plenty, PATH_MAX is 512 under Win32. foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW" c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32 -#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) --- TODO: a) this is copy-pasta from SysTools.hs / getBaseDir. Why can't we reuse --- this here? and parameterise getBaseDir over the executable (for --- windows)? --- Answer: we can not, because if we share `getBaseDir` via `ghc-boot`, --- that would add `base` as a dependency for windows. --- b) why is the windows getBaseDir logic, not part of getExecutablePath? --- it would be much wider available then and we could drop all the --- custom logic? --- Answer: yes this should happen. No one has found the time just yet. +#elif SIMPLE_WIN_GETLIBDIR || defined(darwin_HOST_OS) || defined(linux_HOST_OS) getLibDir = Just . (\p -> p "lib") . takeDirectory . takeDirectory <$> getExecutablePath #else getLibDir = return Nothing From git at git.haskell.org Mon Aug 27 13:39:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 27 Aug 2018 13:39:36 +0000 (UTC) Subject: [commit: ghc] master: Fix #15550 by quoting RULE names during TH conversion (5e6cf2a) Message-ID: <20180827133936.86A803A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5e6cf2a9301a5473ff9c5319b96de941b1ad72dd/ghc >--------------------------------------------------------------- commit 5e6cf2a9301a5473ff9c5319b96de941b1ad72dd Author: Ryan Scott Date: Mon Aug 27 14:02:42 2018 +0200 Fix #15550 by quoting RULE names during TH conversion Summary: When converting a `RuleP` to a GHC source `RuleD` during TH conversion, we were stupidly not double-quoting the name of the rule. Easily fixed. Test Plan: make test TEST=T15550 Reviewers: goldfire, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, carter GHC Trac Issues: #15550 Differential Revision: https://phabricator.haskell.org/D5090 >--------------------------------------------------------------- 5e6cf2a9301a5473ff9c5319b96de941b1ad72dd compiler/hsSyn/Convert.hs | 4 ++-- testsuite/tests/th/T15550.hs | 8 ++++++++ testsuite/tests/th/T15550.stderr | 11 +++++++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 22 insertions(+), 2 deletions(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 24b0b20..687c828 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -705,8 +705,8 @@ cvtPragmaD (RuleP nm bndrs lhs rhs phases) ; rhs' <- cvtl rhs ; returnJustL $ Hs.RuleD noExt $ HsRules noExt (SourceText "{-# RULES") - [noLoc $ HsRule noExt (noLoc (SourceText nm,nm')) act - bndrs' lhs' rhs'] + [noLoc $ HsRule noExt (noLoc (quotedSourceText nm,nm')) + act bndrs' lhs' rhs'] } cvtPragmaD (AnnP target exp) diff --git a/testsuite/tests/th/T15550.hs b/testsuite/tests/th/T15550.hs new file mode 100644 index 0000000..538064c --- /dev/null +++ b/testsuite/tests/th/T15550.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} +module T15550 where + +$([d| myId :: a -> a + myId x = x + {-# NOINLINE [1] myId #-} + {-# RULES "myId" forall x. myId x = x #-} + |]) diff --git a/testsuite/tests/th/T15550.stderr b/testsuite/tests/th/T15550.stderr new file mode 100644 index 0000000..8169d75 --- /dev/null +++ b/testsuite/tests/th/T15550.stderr @@ -0,0 +1,11 @@ +T15550.hs:(4,3)-(8,6): Splicing declarations + [d| {-# RULES "myId" forall x. myId x = x #-} + + myId :: a -> a + myId x = x + {-# NOINLINE [1] myId #-} |] + ======> + myId :: a -> a + myId x = x + {-# NOINLINE [1] myId #-} + {-# RULES "myId" forall x. myId x = x #-} diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 5c7037d..55724dc 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -425,4 +425,5 @@ test('T14471', normal, compile, ['']) test('TH_rebindableAdo', normal, compile, ['']) test('T14627', normal, compile_fail, ['']) test('TH_invalid_add_top_decl', normal, compile_fail, ['']) +test('T15550', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T15518', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) From git at git.haskell.org Mon Aug 27 13:39:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 27 Aug 2018 13:39:39 +0000 (UTC) Subject: [commit: ghc] master: Fix #15502 by not casting to Int during TH conversion (7a3cda5) Message-ID: <20180827133939.EC2AF3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a3cda534d1447c813aa37cdd86e20b8d782cb02/ghc >--------------------------------------------------------------- commit 7a3cda534d1447c813aa37cdd86e20b8d782cb02 Author: Ryan Scott Date: Mon Aug 27 14:02:49 2018 +0200 Fix #15502 by not casting to Int during TH conversion Summary: When turning an `IntegerL` to an `IntegralLit` during TH conversion, we were stupidly casting an `Integer` to an `Int` in order to determine how it should be pretty-printed. Unsurprisingly, this causes problems when the `Integer` doesn't lie within the bounds of an `Int`, as demonstrated in #15502. The fix is simple: don't cast to an `Int`. Test Plan: make test TEST=T15502 Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, carter GHC Trac Issues: #15502 Differential Revision: https://phabricator.haskell.org/D5089 >--------------------------------------------------------------- 7a3cda534d1447c813aa37cdd86e20b8d782cb02 compiler/basicTypes/BasicTypes.hs | 14 ++++++++++++-- testsuite/tests/th/T15502.hs | 9 +++++++++ testsuite/tests/th/T15502.stderr | 4 ++++ testsuite/tests/th/all.T | 1 + 4 files changed, 26 insertions(+), 2 deletions(-) diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index 93010b7..ce46962 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -1436,9 +1436,12 @@ data IntegralLit deriving (Data, Show) mkIntegralLit :: Integral a => a -> IntegralLit -mkIntegralLit i = IL { il_text = SourceText (show (fromIntegral i :: Int)) +mkIntegralLit i = IL { il_text = SourceText (show i_integer) , il_neg = i < 0 - , il_value = toInteger i } + , il_value = i_integer } + where + i_integer :: Integer + i_integer = toInteger i negateIntegralLit :: IntegralLit -> IntegralLit negateIntegralLit (IL text neg value) @@ -1463,6 +1466,13 @@ data FractionalLit mkFractionalLit :: Real a => a -> FractionalLit mkFractionalLit r = FL { fl_text = SourceText (show (realToFrac r::Double)) + -- Converting to a Double here may technically lose + -- precision (see #15502). We could alternatively + -- convert to a Rational for the most accuracy, but + -- it would cause Floats and Doubles to be displayed + -- strangely, so we opt not to do this. (In contrast + -- to mkIntegralLit, where we always convert to an + -- Integer for the highest accuracy.) , fl_neg = r < 0 , fl_value = toRational r } diff --git a/testsuite/tests/th/T15502.hs b/testsuite/tests/th/T15502.hs new file mode 100644 index 0000000..96800f8 --- /dev/null +++ b/testsuite/tests/th/T15502.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T15502 where + +import Language.Haskell.TH.Syntax (Lift(lift)) + +main = print ( $( lift (toInteger (maxBound :: Int) + 1) ) + , $( lift (minBound :: Int) ) + ) diff --git a/testsuite/tests/th/T15502.stderr b/testsuite/tests/th/T15502.stderr new file mode 100644 index 0000000..1177799 --- /dev/null +++ b/testsuite/tests/th/T15502.stderr @@ -0,0 +1,4 @@ +T15502.hs:7:19-56: Splicing expression + lift (toInteger (maxBound :: Int) + 1) ======> 9223372036854775808 +T15502.hs:8:19-40: Splicing expression + lift (minBound :: Int) ======> (-9223372036854775808) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 55724dc..296cec7 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -426,4 +426,5 @@ test('TH_rebindableAdo', normal, compile, ['']) test('T14627', normal, compile_fail, ['']) test('TH_invalid_add_top_decl', normal, compile_fail, ['']) test('T15550', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T15502', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T15518', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) From git at git.haskell.org Mon Aug 27 13:39:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 27 Aug 2018 13:39:44 +0000 (UTC) Subject: [commit: ghc] master: Take strict fields into account in coverage checking (744b034) Message-ID: <20180827133944.050DD3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/744b034dc2ea5b7b82b5586a263c12f231e803f1/ghc >--------------------------------------------------------------- commit 744b034dc2ea5b7b82b5586a263c12f231e803f1 Author: Ryan Scott Date: Mon Aug 27 14:05:45 2018 +0200 Take strict fields into account in coverage checking Summary: The current pattern-match coverage checker implements the formalism presented in the //GADTs Meet Their Match// paper in a fairly faithful matter. However, it was discovered recently that there is a class of unreachable patterns that //GADTs Meet Their Match// does not handle: unreachable code due to strict argument types, as demonstrated in #15305. This patch therefore goes off-script a little and implements an extension to the formalism presented in the paper to handle this case. Essentially, when determining if each constructor can be matched on, GHC checks if its associated term and type constraints are satisfiable. This patch introduces a new form of constraint, `NonVoid(ty)`, and checks if each constructor's strict argument types satisfy `NonVoid`. If any of them do not, then that constructor is deemed uninhabitable, and thus cannot be matched on. For the full story of how this works, see `Note [Extensions to GADTs Meet Their Match]`. Along the way, I did a little bit of much-needed refactoring. In particular, several functions in `Check` were passing a triple of `(ValAbs, ComplexEq, Bag EvVar)` around to represent a constructor and its constraints. Now that we're adding yet another form of constraint to the mix, I thought it appropriate to turn this into a proper data type, which I call `InhabitationCandidate`. Test Plan: make test TEST=T15305 Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, carter GHC Trac Issues: #15305 Differential Revision: https://phabricator.haskell.org/D5087 >--------------------------------------------------------------- 744b034dc2ea5b7b82b5586a263c12f231e803f1 compiler/deSugar/Check.hs | 317 +++++++++++++++++---- docs/users_guide/8.8.1-notes.rst | 13 + testsuite/tests/pmcheck/should_compile/T15305.hs | 58 ++++ .../tests/pmcheck/should_compile/T15305.stderr | 4 + testsuite/tests/pmcheck/should_compile/all.T | 2 + .../tests/simplCore/should_compile/T13990.stderr | 4 + 6 files changed, 338 insertions(+), 60 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 744b034dc2ea5b7b82b5586a263c12f231e803f1 From git at git.haskell.org Mon Aug 27 13:39:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 27 Aug 2018 13:39:46 +0000 (UTC) Subject: [commit: ghc] master: Don't reify redundant class method tyvars/contexts (6e765ae) Message-ID: <20180827133946.CCBAE3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6e765aebbe0a565f2476b522a49faf8edb9a93ee/ghc >--------------------------------------------------------------- commit 6e765aebbe0a565f2476b522a49faf8edb9a93ee Author: Ryan Scott Date: Mon Aug 27 14:06:17 2018 +0200 Don't reify redundant class method tyvars/contexts Summary: Currently, reifying classes produces class methods with redundant tyvars and class contexts in their type signatures, such as in the following: ```lang=haskell class C a where method :: forall a. C a => a ``` Fixing this is very straightforward: just apply `tcSplitMethodTy` to the type of each class method to lop off the redundant parts. It's possible that this could break some TH code in the wild that assumes the existence of these tyvars and class contexts, so I'll advertise this change in the release notes just to be safe. Test Plan: make test TEST="TH_reifyDecl1 T9064 T10891 T14888" Reviewers: goldfire, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, carter GHC Trac Issues: #15551 Differential Revision: https://phabricator.haskell.org/D5088 >--------------------------------------------------------------- 6e765aebbe0a565f2476b522a49faf8edb9a93ee compiler/typecheck/TcSplice.hs | 10 +++++++--- docs/users_guide/8.8.1-notes.rst | 15 +++++++++++++++ testsuite/tests/th/T10891.stderr | 6 ++---- testsuite/tests/th/T14888.stderr | 5 ++--- testsuite/tests/th/T9064.stderr | 3 +-- testsuite/tests/th/TH_reifyDecl1.stderr | 11 +++++------ 6 files changed, 32 insertions(+), 18 deletions(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index d57ec1c..5a26de5 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -1576,13 +1576,17 @@ reifyClass cls (_, fds, theta, _, ats, op_stuff) = classExtraBigSig cls fds' = map reifyFunDep fds reify_op (op, def_meth) - = do { ty <- reifyType (idType op) + = do { let (_, _, ty) = tcSplitMethodTy (idType op) + -- Use tcSplitMethodTy to get rid of the extraneous class + -- variables and predicates at the beginning of op's type + -- (see #15551). + ; ty' <- reifyType ty ; let nm' = reifyName op ; case def_meth of Just (_, GenericDM gdm_ty) -> do { gdm_ty' <- reifyType gdm_ty - ; return [TH.SigD nm' ty, TH.DefaultSigD nm' gdm_ty'] } - _ -> return [TH.SigD nm' ty] } + ; return [TH.SigD nm' ty', TH.DefaultSigD nm' gdm_ty'] } + _ -> return [TH.SigD nm' ty'] } reifyAT :: ClassATItem -> TcM [TH.Dec] reifyAT (ATI tycon def) = do diff --git a/docs/users_guide/8.8.1-notes.rst b/docs/users_guide/8.8.1-notes.rst index 0a095f0..da236f9 100644 --- a/docs/users_guide/8.8.1-notes.rst +++ b/docs/users_guide/8.8.1-notes.rst @@ -52,6 +52,21 @@ Runtime system Template Haskell ~~~~~~~~~~~~~~~~ +- Reifying type classes no longer shows redundant class type variables and + contexts in the type signature of each class method. For instance, + reifying the following class: :: + + class C a where + method :: a + + Used to produce the following: :: + + class C a where + method :: forall a. C a => a + + Where the ``forall a. C a =>`` part is entirely redundant. This part is no + longer included when reifying ``C``. It's possible that this may break some + code which assumes the existence of ``forall a. C a =>``. ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ diff --git a/testsuite/tests/th/T10891.stderr b/testsuite/tests/th/T10891.stderr index 874f4f0..6b382e6 100644 --- a/testsuite/tests/th/T10891.stderr +++ b/testsuite/tests/th/T10891.stderr @@ -1,11 +1,9 @@ class T10891.C (a_0 :: *) - where T10891.f :: forall (a_0 :: *) . T10891.C a_0 => - a_0 -> GHC.Types.Int + where T10891.f :: a_0 -> GHC.Types.Int class T10891.C' (a_0 :: *) where type T10891.F (a_0 :: *) :: * type T10891.F a_0 = a_0 - T10891.f' :: forall (a_0 :: *) . T10891.C' a_0 => - a_0 -> GHC.Types.Int + T10891.f' :: a_0 -> GHC.Types.Int instance T10891.C' GHC.Types.Int class T10891.C'' (a_0 :: *) where data T10891.Fd (a_0 :: *) :: * diff --git a/testsuite/tests/th/T14888.stderr b/testsuite/tests/th/T14888.stderr index 963937f..e6d6325 100644 --- a/testsuite/tests/th/T14888.stderr +++ b/testsuite/tests/th/T14888.stderr @@ -5,7 +5,6 @@ T14888.hs:18:23-59: Splicing expression reify ''Functor' >>= stringE . pprint ======> "class T14888.Functor' (f_0 :: * -> *) - where T14888.fmap' :: forall (f_0 :: * -> - *) . T14888.Functor' f_0 => - forall (a_1 :: *) (b_2 :: *) . (a_1 -> b_2) -> f_0 a_1 -> f_0 b_2 + where T14888.fmap' :: forall (a_1 :: *) (b_2 :: *) . + (a_1 -> b_2) -> f_0 a_1 -> f_0 b_2 instance T14888.Functor' ((->) r_3 :: * -> *)" diff --git a/testsuite/tests/th/T9064.stderr b/testsuite/tests/th/T9064.stderr index f118e20..c7f3df1 100644 --- a/testsuite/tests/th/T9064.stderr +++ b/testsuite/tests/th/T9064.stderr @@ -1,5 +1,4 @@ class T9064.C (a_0 :: *) - where T9064.foo :: forall (a_0 :: *) . T9064.C a_0 => - a_0 -> GHC.Base.String + where T9064.foo :: a_0 -> GHC.Base.String default T9064.foo :: GHC.Show.Show a_0 => a_0 -> GHC.Base.String instance T9064.C T9064.Bar diff --git a/testsuite/tests/th/TH_reifyDecl1.stderr b/testsuite/tests/th/TH_reifyDecl1.stderr index e655587..b18089b 100644 --- a/testsuite/tests/th/TH_reifyDecl1.stderr +++ b/testsuite/tests/th/TH_reifyDecl1.stderr @@ -9,15 +9,14 @@ data TH_reifyDecl1.Tree (a_0 :: *) | (TH_reifyDecl1.Tree a_0) TH_reifyDecl1.:+: (TH_reifyDecl1.Tree a_0) type TH_reifyDecl1.IntList = [GHC.Types.Int] newtype TH_reifyDecl1.Length = TH_reifyDecl1.Length GHC.Types.Int -Constructor from TH_reifyDecl1.Tree: TH_reifyDecl1.Leaf :: forall (a_0 :: *) . TH_reifyDecl1.Tree a_0 +Constructor from TH_reifyDecl1.Tree: TH_reifyDecl1.Leaf :: forall (a_0 :: *) . + TH_reifyDecl1.Tree a_0 Class op from TH_reifyDecl1.C1: TH_reifyDecl1.m1 :: forall (a_0 :: *) . TH_reifyDecl1.C1 a_0 => - a_0 -> GHC.Types.Int + a_0 -> GHC.Types.Int class TH_reifyDecl1.C1 (a_0 :: *) - where TH_reifyDecl1.m1 :: forall (a_0 :: *) . TH_reifyDecl1.C1 a_0 => - a_0 -> GHC.Types.Int + where TH_reifyDecl1.m1 :: a_0 -> GHC.Types.Int class TH_reifyDecl1.C2 (a_0 :: *) - where TH_reifyDecl1.m2 :: forall (a_0 :: *) . TH_reifyDecl1.C2 a_0 => - a_0 -> GHC.Types.Int + where TH_reifyDecl1.m2 :: a_0 -> GHC.Types.Int instance TH_reifyDecl1.C2 GHC.Types.Int class TH_reifyDecl1.C3 (a_0 :: *) where type TH_reifyDecl1.AT1 (a_0 :: *) :: * From git at git.haskell.org Mon Aug 27 13:39:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 27 Aug 2018 13:39:49 +0000 (UTC) Subject: [commit: ghc] master: Fix #10859 by using foldr1 while deriving Eq instances (2d953a6) Message-ID: <20180827133949.99EB93A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2d953a60489ba30433e5f2fe27c50aa9da75f802/ghc >--------------------------------------------------------------- commit 2d953a60489ba30433e5f2fe27c50aa9da75f802 Author: Chaitanya Koparkar Date: Mon Aug 27 14:07:08 2018 +0200 Fix #10859 by using foldr1 while deriving Eq instances Summary: Previously, we were using foldl1 instead, which led to the derived code to be wrongly associated. Test Plan: ./validate Reviewers: RyanGlScott, nomeata, simonpj, bgamari Reviewed By: RyanGlScott, nomeata Subscribers: rwbarton, carter GHC Trac Issues: #10859 Differential Revision: https://phabricator.haskell.org/D5104 >--------------------------------------------------------------- 2d953a60489ba30433e5f2fe27c50aa9da75f802 compiler/typecheck/TcGenDeriv.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index e74ae32..1debddd 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -214,7 +214,9 @@ gen_Eq_binds loc tycon = do where nested_eq_expr [] [] [] = true_Expr nested_eq_expr tys as bs - = foldl1 and_Expr (zipWith3Equal "nested_eq" nested_eq tys as bs) + = foldr1 and_Expr (zipWith3Equal "nested_eq" nested_eq tys as bs) + -- Using 'foldr1' here ensures that the derived code is correctly + -- associated. See Trac #10859. where nested_eq ty a b = nlHsPar (eq_Expr tycon ty (nlHsVar a) (nlHsVar b)) From git at git.haskell.org Mon Aug 27 14:38:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 27 Aug 2018 14:38:15 +0000 (UTC) Subject: [commit: nofib] master: Don't warn about tabs (a80baac) Message-ID: <20180827143815.76D383A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a80baacfc29cc2e7ed50e94f3cd2648d11b1d7d5/nofib >--------------------------------------------------------------- commit a80baacfc29cc2e7ed50e94f3cd2648d11b1d7d5 Author: klebinger.andreas at gmx.at Date: Mon Aug 27 16:37:19 2018 +0200 Don't warn about tabs Summary: This removes a lot of noise from the nofib output. Test Plan: running nofib Reviewers: O26 nofib, alpmestan Reviewed By: alpmestan Subscribers: alpmestan Differential Revision: https://phabricator.haskell.org/D4952 >--------------------------------------------------------------- a80baacfc29cc2e7ed50e94f3cd2648d11b1d7d5 mk/boilerplate.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mk/boilerplate.mk b/mk/boilerplate.mk index 9d0b6c6..324f689 100644 --- a/mk/boilerplate.mk +++ b/mk/boilerplate.mk @@ -42,7 +42,7 @@ endif NoFibSubDirs = imaginary spectral real shootout # Haskell compiler options for nofib -NoFibHcOpts = -O2 +NoFibHcOpts = -O2 -Wno-tabs # Number of times to run each program NoFibRuns = 5 From git at git.haskell.org Mon Aug 27 14:40:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 27 Aug 2018 14:40:34 +0000 (UTC) Subject: [commit: ghc] master: Bump nofib submodule (b1f5d2f) Message-ID: <20180827144034.2C5633A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b1f5d2fdbfe8339640e86e6b482f892426bc2797/ghc >--------------------------------------------------------------- commit b1f5d2fdbfe8339640e86e6b482f892426bc2797 Author: Krzysztof Gogolewski Date: Mon Aug 27 16:39:13 2018 +0200 Bump nofib submodule >--------------------------------------------------------------- b1f5d2fdbfe8339640e86e6b482f892426bc2797 nofib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nofib b/nofib index a3b0f2b..a80baac 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit a3b0f2b2cff8babbb85cbbe1e7515905ffb444a8 +Subproject commit a80baacfc29cc2e7ed50e94f3cd2648d11b1d7d5 From git at git.haskell.org Mon Aug 27 15:21:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 27 Aug 2018 15:21:19 +0000 (UTC) Subject: [commit: ghc] master: Remove dph, vector, primitive and random from .gitmodules (154d4e2) Message-ID: <20180827152119.BE9AB3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/154d4e219cc0cebbef8a845609bd63ec45fdbea6/ghc >--------------------------------------------------------------- commit 154d4e219cc0cebbef8a845609bd63ec45fdbea6 Author: Chaitanya Koparkar Date: Mon Aug 27 17:19:57 2018 +0200 Remove dph, vector, primitive and random from .gitmodules Summary: These packages were removed from the GHC source tree in Phab:D4761 and 0905fec089b3270f540c7ee33959cbf8ecfcb4d7. Reviewers: RyanGlScott, bgamari Reviewed By: RyanGlScott Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5095 >--------------------------------------------------------------- 154d4e219cc0cebbef8a845609bd63ec45fdbea6 .gitmodules | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/.gitmodules b/.gitmodules index 2125a92..830b5c4 100644 --- a/.gitmodules +++ b/.gitmodules @@ -38,22 +38,10 @@ path = libraries/Win32 url = ../packages/Win32.git ignore = untracked -[submodule "libraries/primitive"] - path = libraries/primitive - url = ../packages/primitive.git - ignore = untracked -[submodule "libraries/vector"] - path = libraries/vector - url = ../packages/vector.git - ignore = untracked [submodule "libraries/time"] path = libraries/time url = ../packages/time.git ignore = untracked -[submodule "libraries/random"] - path = libraries/random - url = ../packages/random.git - ignore = untracked [submodule "libraries/array"] path = libraries/array url = ../packages/array.git @@ -102,10 +90,6 @@ path = libraries/stm url = ../packages/stm.git ignore = untracked -[submodule "libraries/dph"] - path = libraries/dph - url = ../packages/dph.git - ignore = untracked [submodule "utils/haddock"] path = utils/haddock url = ../haddock.git From git at git.haskell.org Mon Aug 27 23:01:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 27 Aug 2018 23:01:34 +0000 (UTC) Subject: [commit: ghc] master: rts: Handle SMALL_MUT_ARR_PTRS in retainer profilter (2cf98e2) Message-ID: <20180827230134.2D80A3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2cf98e2207421200fc73c25a08f6435859cdff92/ghc >--------------------------------------------------------------- commit 2cf98e2207421200fc73c25a08f6435859cdff92 Author: Ben Gamari Date: Tue Aug 28 00:59:17 2018 +0200 rts: Handle SMALL_MUT_ARR_PTRS in retainer profilter Summary: These can be treated similarly to MUT_ARRY_PTRS. Fixes #15529. Reviewers: erikd, simonmar Reviewed By: simonmar Subscribers: RyanGlScott, rwbarton, carter GHC Trac Issues: #15529 Differential Revision: https://phabricator.haskell.org/D5075 >--------------------------------------------------------------- 2cf98e2207421200fc73c25a08f6435859cdff92 rts/RetainerProfile.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index 9458b13..8a64de9 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -811,6 +811,10 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN_CLEAN: case MUT_ARR_PTRS_FROZEN_DIRTY: + case SMALL_MUT_ARR_PTRS_CLEAN: + case SMALL_MUT_ARR_PTRS_DIRTY: + case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN: + case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY: *c = find_ptrs(&se->info); if (*c == NULL) { popOff(); From git at git.haskell.org Tue Aug 28 10:53:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Aug 2018 10:53:12 +0000 (UTC) Subject: [commit: ghc] master: Remove dead code for commandline parsing (c18b525) Message-ID: <20180828105312.CF0873A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c18b525a6f226187a12ed907fa5d3b200daab914/ghc >--------------------------------------------------------------- commit c18b525a6f226187a12ed907fa5d3b200daab914 Author: Krzysztof Gogolewski Date: Tue Aug 28 12:52:47 2018 +0200 Remove dead code for commandline parsing Summary: PrefixPred and AnySuffixPred are not used since static flags were removed in bbd3c399939. Test Plan: validate Reviewers: bgamari, tdammers Reviewed By: tdammers Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5111 >--------------------------------------------------------------- c18b525a6f226187a12ed907fa5d3b200daab914 compiler/main/CmdLineParser.hs | 8 -------- compiler/main/DynFlags.hs | 9 +-------- 2 files changed, 1 insertion(+), 16 deletions(-) diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs index c876f58..cb30b6f 100644 --- a/compiler/main/CmdLineParser.hs +++ b/compiler/main/CmdLineParser.hs @@ -79,8 +79,6 @@ data OptKind m -- Suppose the flag is -f | FloatSuffix (Float -> EwM m ()) -- -f or -f=n; pass n to fn | PassFlag (String -> EwM m ()) -- -f; pass "-f" fn | AnySuffix (String -> EwM m ()) -- -f or -farg; pass entire "-farg" to fn - | PrefixPred (String -> Bool) (String -> EwM m ()) - | AnySuffixPred (String -> Bool) (String -> EwM m ()) -------------------------------------------------------- @@ -246,9 +244,6 @@ processOneArg opt_kind rest arg args Prefix f | notNull rest_no_eq -> Right (f rest_no_eq, args) | otherwise -> missingArgErr dash_arg - PrefixPred _ f | notNull rest_no_eq -> Right (f rest_no_eq, args) - | otherwise -> unknownFlagErr dash_arg - PassFlag f | notNull rest -> unknownFlagErr dash_arg | otherwise -> Right (f dash_arg, args) @@ -264,7 +259,6 @@ processOneArg opt_kind rest arg args OptPrefix f -> Right (f rest_no_eq, args) AnySuffix f -> Right (f dash_arg, args) - AnySuffixPred _ f -> Right (f dash_arg, args) findArg :: [Flag m] -> String -> Maybe (String, OptKind m) findArg spec arg = @@ -284,14 +278,12 @@ arg_ok (HasArg _) _ _ = True arg_ok (SepArg _) rest _ = null rest arg_ok (Prefix _) _ _ = True -- Missing argument checked for in processOneArg t -- to improve error message (Trac #12625) -arg_ok (PrefixPred p _) rest _ = notNull rest && p (dropEq rest) arg_ok (OptIntSuffix _) _ _ = True arg_ok (IntSuffix _) _ _ = True arg_ok (FloatSuffix _) _ _ = True arg_ok (OptPrefix _) _ _ = True arg_ok (PassFlag _) rest _ = null rest arg_ok (AnySuffix _) _ _ = True -arg_ok (AnySuffixPred p _) _ arg = p arg -- | Parse an Int -- diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index be14879..9f0ba57 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2698,11 +2698,8 @@ allNonDeprecatedFlags = allFlagsDeps False allFlagsDeps :: Bool -> [String] allFlagsDeps keepDeprecated = [ '-':flagName flag | (deprecated, flag) <- flagsAllDeps - , ok (flagOptKind flag) , keepDeprecated || not (isDeprecated deprecated)] - where ok (PrefixPred _ _) = False - ok _ = True - isDeprecated Deprecated = True + where isDeprecated Deprecated = True isDeprecated _ = False {- @@ -2762,10 +2759,6 @@ add_dep_message (PassFlag f) message = PassFlag $ \s -> f s >> deprecate message add_dep_message (AnySuffix f) message = AnySuffix $ \s -> f s >> deprecate message -add_dep_message (PrefixPred pred f) message = - PrefixPred pred $ \s -> f s >> deprecate message -add_dep_message (AnySuffixPred pred f) message = - AnySuffixPred pred $ \s -> f s >> deprecate message ----------------------- The main flags themselves ------------------------------ -- See Note [Updating flag description in the User's Guide] From git at git.haskell.org Tue Aug 28 20:00:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Aug 2018 20:00:24 +0000 (UTC) Subject: [commit: ghc] master: Fix #15572 by checking for promoted names in ConT (c46a5f2) Message-ID: <20180828200024.997203A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c46a5f2002f6694ea58f79f505d57f3b7bd450e7/ghc >--------------------------------------------------------------- commit c46a5f2002f6694ea58f79f505d57f3b7bd450e7 Author: Ryan Scott Date: Tue Aug 28 20:54:28 2018 +0200 Fix #15572 by checking for promoted names in ConT Summary: When converting `ConT`s to `HsTyVar`s in `Convert`, we were failing to account for the possibility of promoted data constructor names appearing in a `ConT`, which could result in improper pretty-printing results (as observed in #15572). The fix is straightforward: use `Promoted` instead of `NotPromoted` when the name of a `ConT` is a data constructor name. Test Plan: make test TEST=T15572 Reviewers: goldfire, bgamari, simonpj, monoidal Reviewed By: goldfire, simonpj Subscribers: monoidal, rwbarton, carter GHC Trac Issues: #15572 Differential Revision: https://phabricator.haskell.org/D5112 >--------------------------------------------------------------- c46a5f2002f6694ea58f79f505d57f3b7bd450e7 compiler/hsSyn/Convert.hs | 9 ++++++++- testsuite/tests/th/T15572.hs | 8 ++++++++ testsuite/tests/th/T15572.stderr | 6 ++++++ testsuite/tests/th/all.T | 1 + 4 files changed, 23 insertions(+), 1 deletion(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 687c828..832a513 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -1305,7 +1305,14 @@ cvtTypeKind ty_str ty VarT nm -> do { nm' <- tNameL nm ; mk_apps (HsTyVar noExt NotPromoted nm') tys' } ConT nm -> do { nm' <- tconName nm - ; mk_apps (HsTyVar noExt NotPromoted (noLoc nm')) tys'} + ; -- ConT can contain both data constructor (i.e., + -- promoted) names and other (i.e, unpromoted) + -- names, as opposed to PromotedT, which can only + -- contain data constructor names. See #15572. + let prom = if isRdrDataCon nm' + then Promoted + else NotPromoted + ; mk_apps (HsTyVar noExt prom (noLoc nm')) tys'} ForallT tvs cxt ty | null tys' diff --git a/testsuite/tests/th/T15572.hs b/testsuite/tests/th/T15572.hs new file mode 100644 index 0000000..7bbbcac --- /dev/null +++ b/testsuite/tests/th/T15572.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +module T15572 where + +import Language.Haskell.TH + +$([d| type AbsoluteUnit1 = '() |]) +$(pure [TySynD (mkName "AbsoluteUnit2") [] (ConT '())]) diff --git a/testsuite/tests/th/T15572.stderr b/testsuite/tests/th/T15572.stderr new file mode 100644 index 0000000..27132d69 --- /dev/null +++ b/testsuite/tests/th/T15572.stderr @@ -0,0 +1,6 @@ +T15572.hs:7:3-33: Splicing declarations + [d| type AbsoluteUnit1 = '() |] ======> type AbsoluteUnit1 = '() +T15572.hs:8:3-54: Splicing declarations + pure [TySynD (mkName "AbsoluteUnit2") [] (ConT '())] + ======> + type AbsoluteUnit2 = '() diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 296cec7..cf9153e 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -428,3 +428,4 @@ test('TH_invalid_add_top_decl', normal, compile_fail, ['']) test('T15550', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T15502', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T15518', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T15572', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) From git at git.haskell.org Tue Aug 28 20:31:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Aug 2018 20:31:44 +0000 (UTC) Subject: [commit: ghc] master: Fix typo in 8.6.1 notes (34b8e61) Message-ID: <20180828203144.1B3F83A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/34b8e613606653187f1ffae36a83e33f0c673720/ghc >--------------------------------------------------------------- commit 34b8e613606653187f1ffae36a83e33f0c673720 Author: Krzysztof Gogolewski Date: Tue Aug 28 22:31:22 2018 +0200 Fix typo in 8.6.1 notes >--------------------------------------------------------------- 34b8e613606653187f1ffae36a83e33f0c673720 docs/users_guide/8.6.1-notes.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/8.6.1-notes.rst b/docs/users_guide/8.6.1-notes.rst index 7faef04..cfa2880 100644 --- a/docs/users_guide/8.6.1-notes.rst +++ b/docs/users_guide/8.6.1-notes.rst @@ -35,7 +35,7 @@ Language the common ``MonadTrans`` typeclass could now make the expectation that an applied transformer is must be a ``Monad`` :: - class (forall a. Monad m => Monad (t m)) => MonadTrans t where {- ... -} + class (forall m. Monad m => Monad (t m)) => MonadTrans t where {- ... -} Additionally, quantification can enable terminating instance resolution where this previously was not possible. See :ref:`quantified-constraints` for From git at git.haskell.org Tue Aug 28 22:12:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Aug 2018 22:12:24 +0000 (UTC) Subject: [commit: ghc] master: Rename kind vars in left-to-right order in bindHsQTyVars (102284e) Message-ID: <20180828221224.191933A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/102284e72f8d29599803aa72ccec180db28e72c8/ghc >--------------------------------------------------------------- commit 102284e72f8d29599803aa72ccec180db28e72c8 Author: Ryan Scott Date: Tue Aug 28 22:58:52 2018 +0200 Rename kind vars in left-to-right order in bindHsQTyVars Summary: When renaming kind variables in an `LHsQTyVars`, we were erroneously putting all of the kind variables in the binders //after// the kind variables in the body, resulting in #15568. The fix is simple: just swap the order of these two around. Test Plan: make test TEST=T15568 Reviewers: simonpj, bgamari, goldfire Reviewed By: goldfire Subscribers: goldfire, rwbarton, carter GHC Trac Issues: #15568 Differential Revision: https://phabricator.haskell.org/D5108 >--------------------------------------------------------------- 102284e72f8d29599803aa72ccec180db28e72c8 compiler/hsSyn/HsTypes.hs | 17 ++++- compiler/rename/RnTypes.hs | 86 +++++++++++++++++++--- compiler/typecheck/TcHsType.hs | 2 +- compiler/types/Type.hs | 2 +- docs/users_guide/glasgow_exts.rst | 11 +++ testsuite/tests/ghci/scripts/T15568.hs | 7 ++ testsuite/tests/ghci/scripts/T15568.script | 4 + testsuite/tests/ghci/scripts/T15568.stdout | 2 + testsuite/tests/ghci/scripts/T6018ghcifail.stderr | 2 +- testsuite/tests/ghci/scripts/all.T | 1 + testsuite/tests/polykinds/T11821a.stderr | 2 +- testsuite/tests/polykinds/T14520.stderr | 2 +- .../tests/typecheck/should_fail/T6018fail.stderr | 2 +- 13 files changed, 123 insertions(+), 17 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 102284e72f8d29599803aa72ccec180db28e72c8 From git at git.haskell.org Wed Aug 29 09:33:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 29 Aug 2018 09:33:30 +0000 (UTC) Subject: [commit: ghc] master: Fixed typo in exponent example (36c1431) Message-ID: <20180829093330.0F8873A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/36c1431d9d2d06049190cc0888dbfaee8e2179d6/ghc >--------------------------------------------------------------- commit 36c1431d9d2d06049190cc0888dbfaee8e2179d6 Author: chris-bacon Date: Mon Aug 27 13:45:47 2018 +0100 Fixed typo in exponent example >--------------------------------------------------------------- 36c1431d9d2d06049190cc0888dbfaee8e2179d6 libraries/base/GHC/Natural.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs index 0408ce6..71511d3 100644 --- a/libraries/base/GHC/Natural.hs +++ b/libraries/base/GHC/Natural.hs @@ -124,7 +124,7 @@ divZeroError = raise# divZeroException -- | Type representing arbitrary-precision non-negative integers. -- --- >>> 2^20 :: Natural +-- >>> 2^100 :: Natural -- 1267650600228229401496703205376 -- -- Operations whose result would be negative @'Control.Exception.throw' From git at git.haskell.org Wed Aug 29 14:46:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 29 Aug 2018 14:46:15 +0000 (UTC) Subject: [commit: ghc] master: Fix a constant folding rule (65eec9c) Message-ID: <20180829144615.9CED43A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/65eec9cfd4410c0e30b0ed06116c15f8ce3de49d/ghc >--------------------------------------------------------------- commit 65eec9cfd4410c0e30b0ed06116c15f8ce3de49d Author: Andrey Mokhov Date: Wed Aug 29 15:16:51 2018 +0200 Fix a constant folding rule Summary: One of the constant folding rules introduced in D2858 is: ``` (L y :-: v) :-: (L x :-: w) -> return $ mkL (y-x) `add` (w `add` v) ``` Or, after removing syntactic noise: `(y - v) - (x - w) ==> (y - x) + (w + v)`. This is incorrect, since the sign of `v` is changed from negative to positive. As a consequence, the following program prints `3` when compiled with `-O`: ``` -- This is just subtraction in disguise minus :: Int -> Int -> Int minus x y = (8 - y) - (8 - x) {-# NOINLINE minus #-} main :: IO () main = print (2 `minus` 1) ``` The correct rule is: `(y - v) - (x - w) ==> (y - x) + (w - v)`. This commit does the fix. I haven't found any other issues with the constant folding code, but it's difficult to be certain without some automated checking. Reviewers: bgamari, tdammers Subscribers: hsyl20, tdammers, rwbarton, carter GHC Trac Issues: #15569 Differential Revision: https://phabricator.haskell.org/D5109 >--------------------------------------------------------------- 65eec9cfd4410c0e30b0ed06116c15f8ce3de49d compiler/prelude/PrelRules.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index 695e879..80cfa20 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -1783,7 +1783,7 @@ numFoldingRules op dict = do (v :-: L y) :-: (w :-: L x) -> return $ mkL (x-y) `add` (v `sub` w) (v :-: L y) :-: (L x :-: w) -> return $ mkL (0-x-y) `add` (v `add` w) (L y :-: v) :-: (w :-: L x) -> return $ mkL (x+y) `sub` (v `add` w) - (L y :-: v) :-: (L x :-: w) -> return $ mkL (y-x) `add` (w `add` v) + (L y :-: v) :-: (L x :-: w) -> return $ mkL (y-x) `add` (w `sub` v) (x :++: w) :-: (y :++: v) -> return $ mkL (x-y) `add` (w `sub` v) (w :-: L x) :-: (y :++: v) -> return $ mkL (0-y-x) `add` (w `sub` v) (L x :-: w) :-: (y :++: v) -> return $ mkL (x-y) `sub` (v `add` w) From git at git.haskell.org Wed Aug 29 20:35:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 29 Aug 2018 20:35:20 +0000 (UTC) Subject: [commit: ghc] master: Finish stable split (f48e276) Message-ID: <20180829203520.C7ADE3A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f48e276a5ba68d8b6fcb4a558022581fb30f9326/ghc >--------------------------------------------------------------- commit f48e276a5ba68d8b6fcb4a558022581fb30f9326 Author: David Feuer Date: Wed Aug 29 16:34:21 2018 -0400 Finish stable split Long ago, the stable name table and stable pointer tables were one. Now, they are separate, and have significantly different implementations. I believe the time has come to finish the split that began in #7674. * Divide `rts/Stable` into `rts/StableName` and `rts/StablePtr`. * Give each table its own mutex. * Add FFI functions `hs_lock_stable_ptr_table` and `hs_unlock_stable_ptr_table` and document them. These are intended to replace the previously undocumented `hs_lock_stable_tables` and `hs_lock_stable_tables`, which are now documented as deprecated synonyms. * Make `eqStableName#` use pointer equality instead of unnecessarily comparing stable name table indices. Reviewers: simonmar, bgamari, erikd Reviewed By: bgamari Subscribers: rwbarton, carter GHC Trac Issues: #15555 Differential Revision: https://phabricator.haskell.org/D5084 >--------------------------------------------------------------- f48e276a5ba68d8b6fcb4a558022581fb30f9326 compiler/codeGen/StgCmmPrim.hs | 21 ++- docs/users_guide/8.8.1-notes.rst | 8 + docs/users_guide/ffi-chap.rst | 40 ++++ includes/HsFFI.h | 18 ++ includes/Rts.h | 3 +- includes/rts/{Stable.h => StableName.h} | 18 +- includes/rts/{Stable.h => StablePtr.h} | 13 -- includes/stg/MiscClosures.h | 4 +- rts/Adjustor.c | 2 +- rts/Globals.c | 2 +- rts/HsFFI.c | 20 +- rts/Interpreter.c | 2 +- rts/Linker.c | 2 +- rts/RetainerProfile.c | 7 +- rts/RtsAPI.c | 2 +- rts/RtsStartup.c | 13 +- rts/RtsSymbols.c | 2 + rts/Schedule.c | 12 +- rts/{Stable.c => StableName.c} | 287 +++------------------------- rts/StableName.h | 31 +++ rts/{Stable.c => StablePtr.c} | 324 +++----------------------------- rts/{Stable.h => StablePtr.h} | 27 ++- rts/StaticPtrTable.c | 2 +- rts/TopHandler.c | 2 +- rts/TopHandler.h | 1 - rts/posix/Signals.c | 1 - rts/rts.cabal.in | 6 +- rts/sm/Compact.c | 8 +- rts/sm/GC.c | 23 ++- utils/deriveConstants/Main.hs | 2 +- 30 files changed, 244 insertions(+), 659 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 f48e276a5ba68d8b6fcb4a558022581fb30f9326 From git at git.haskell.org Thu Aug 30 13:35:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Aug 2018 13:35:19 +0000 (UTC) Subject: [commit: ghc] master: Fix the __GLASGOW_HASKELL__ comparison (97826e3) Message-ID: <20180830133519.A3B353A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/97826e343c482f1c2fb7c74fbbe6958682608ac7/ghc >--------------------------------------------------------------- commit 97826e343c482f1c2fb7c74fbbe6958682608ac7 Author: Krzysztof Gogolewski Date: Thu Aug 30 15:34:39 2018 +0200 Fix the __GLASGOW_HASKELL__ comparison Summary: GHC 8.4 corresponds to 804, not 840. Found by Gabor Greif. Test Plan: Harbormaster Reviewers: ggreif, bgamari, mpickering Reviewed By: ggreif Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5064 >--------------------------------------------------------------- 97826e343c482f1c2fb7c74fbbe6958682608ac7 compiler/iface/MkIface.hs | 5 ++--- compiler/main/Plugins.hs | 4 +--- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 7469c4e..59a396e 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -119,11 +119,10 @@ import Data.IORef import System.Directory import System.FilePath import Plugins ( PluginRecompile(..), Plugin(..), LoadedPlugin(..)) -#if __GLASGOW_HASKELL__ < 840 + --Qualified import so we can define a Semigroup instance -- but it doesn't clash with Outputable.<> import qualified Data.Semigroup -#endif {- ************************************************************************ @@ -1113,7 +1112,7 @@ instance Semigroup RecompileRequired where instance Monoid RecompileRequired where mempty = UpToDate -#if __GLASGOW_HASKELL__ < 840 +#if __GLASGOW_HASKELL__ < 804 mappend = (Data.Semigroup.<>) #endif diff --git a/compiler/main/Plugins.hs b/compiler/main/Plugins.hs index 8ead643..e83ec08 100644 --- a/compiler/main/Plugins.hs +++ b/compiler/main/Plugins.hs @@ -23,11 +23,9 @@ import Fingerprint import Data.List import Outputable (Outputable(..), text, (<+>)) -#if __GLASGOW_HASKELL__ < 840 --Qualified import so we can define a Semigroup instance -- but it doesn't clash with Outputable.<> import qualified Data.Semigroup -#endif import Control.Monad @@ -125,7 +123,7 @@ instance Semigroup PluginRecompile where instance Monoid PluginRecompile where mempty = NoForceRecompile -#if __GLASGOW_HASKELL__ < 840 +#if __GLASGOW_HASKELL__ < 804 mappend = (Data.Semigroup.<>) #endif From git at git.haskell.org Thu Aug 30 16:49:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Aug 2018 16:49:03 +0000 (UTC) Subject: [commit: ghc] master: A few typos [ci skip] (12e6e19) Message-ID: <20180830164903.E96D73A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/12e6e194f6c533e0d41bc1942dce9176a3bccf1c/ghc >--------------------------------------------------------------- commit 12e6e194f6c533e0d41bc1942dce9176a3bccf1c Author: Gabor Greif Date: Thu Aug 30 18:38:38 2018 +0200 A few typos [ci skip] >--------------------------------------------------------------- 12e6e194f6c533e0d41bc1942dce9176a3bccf1c compiler/cmm/CmmSink.hs | 2 +- compiler/deSugar/DsBinds.hs | 2 +- compiler/typecheck/ClsInst.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs index 7bfc075..6317cfe 100644 --- a/compiler/cmm/CmmSink.hs +++ b/compiler/cmm/CmmSink.hs @@ -477,7 +477,7 @@ into (a != b) but there's one case it can't handle: when the comparison is over floating-point values, we can't invert it, because floating-point -comparisions aren't invertible (because NaN). +comparisons aren't invertible (because of NaNs). But we *can* optimise this conditional by swapping the true and false branches. Given diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 6524e10..421adca 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -1282,7 +1282,7 @@ ds_ev_typeable ty (EvTypeableTrFun ev1 ev2) ds_ev_typeable ty (EvTypeableTyLit ev) = -- See Note [Typeable for Nat and Symbol] in TcInteract do { fun <- dsLookupGlobalId tr_fun - ; dict <- dsEvTerm ev -- Of type KnownNat/KnownSym + ; dict <- dsEvTerm ev -- Of type KnownNat/KnownSymbol ; let proxy = mkTyApps (Var proxyHashId) [ty_kind, ty] ; return (mkApps (mkTyApps (Var fun) [ty]) [ dict, proxy ]) } where diff --git a/compiler/typecheck/ClsInst.hs b/compiler/typecheck/ClsInst.hs index de957b7..0af1965 100644 --- a/compiler/typecheck/ClsInst.hs +++ b/compiler/typecheck/ClsInst.hs @@ -427,7 +427,7 @@ Note [Typeable for Nat and Symbol] We have special Typeable instances for Nat and Symbol. Roughly we have this instance, implemented here by doTyLit: instance KnownNat n => Typeable (n :: Nat) where - typeRep = tyepNatTypeRep @n + typeRep = typeNatTypeRep @n where Data.Typeable.Internals.typeNatTypeRep :: KnownNat a => TypeRep a From git at git.haskell.org Thu Aug 30 19:11:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Aug 2018 19:11:11 +0000 (UTC) Subject: [commit: ghc] master: fix -ddump-asm description (140563f) Message-ID: <20180830191111.7A4593A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/140563ff30ac3d36604d31409547bf229008552e/ghc >--------------------------------------------------------------- commit 140563ff30ac3d36604d31409547bf229008552e Author: Alp Mestanogullari Date: Thu Aug 30 20:57:17 2018 +0200 fix -ddump-asm description Summary: It was missing some words. Test Plan: None (docs only) Reviewers: bgamari, monoidal Reviewed By: monoidal Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5102 >--------------------------------------------------------------- 140563ff30ac3d36604d31409547bf229008552e docs/users_guide/debugging.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index 2039e12..6a4c7fe 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -543,7 +543,7 @@ assembler. :shortdesc: Dump final assembly :type: dynamic - Dump assembly language produced by the + Dump the final assembly produced by the native code generator. Miscellaneous backend dumps From git at git.haskell.org Fri Aug 31 02:46:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 31 Aug 2018 02:46:18 +0000 (UTC) Subject: [commit: ghc] master: Minor improvements to comments [skip ci] (5d3eb64) Message-ID: <20180831024618.4E0553A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5d3eb646b08433587aa38694afcaee6863160e40/ghc >--------------------------------------------------------------- commit 5d3eb646b08433587aa38694afcaee6863160e40 Author: Richard Eisenberg Date: Thu Aug 30 22:33:40 2018 -0400 Minor improvements to comments [skip ci] >--------------------------------------------------------------- 5d3eb646b08433587aa38694afcaee6863160e40 compiler/typecheck/TcHsType.hs | 12 +++++++----- compiler/types/FamInstEnv.hs | 6 ------ 2 files changed, 7 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index a70db2e..65c97da 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1464,7 +1464,7 @@ kind-generalize correctly. In Step 4, we have to deal with the fact that metatyvars generated in the type may have a bumped TcLevel, because explicit foralls -raise the TcLevel. To avoid these variables from every being visible +raise the TcLevel. To avoid these variables from ever being visible in the surrounding context, we must obey the following dictum: Every metavariable in a type must either be @@ -1476,18 +1476,20 @@ has a proper TcLevel. (I'm ignoring the TcLevel on a skolem here, as it's not really in play here.) On the other hand, if it is not generalized (because we're not generalizing the construct -- e.g., pattern sig -- or because the metavars are constrained -- see kindGeneralizeLocal) -we need to promote to (MetaTvInv) of Note [TcLevel and untouchable type variables] +we need to promote to maintain (MetaTvInv) of Note [TcLevel and untouchable type variables] in TcType. After promoting/generalizing, we need to zonk *again* because both promoting and generalizing fill in metavariables. To avoid the double-zonk, we do two things: - 1. zonkPromoteType and friends zonk and promote at the same time. - Accordingly, the function does setps 3-5 all at once, preventing + 1. When we're not generalizing: + zonkPromoteType and friends zonk and promote at the same time. + Accordingly, the function does steps 3-5 all at once, preventing the need for multiple traversals. - 2. kindGeneralize does not require a zonked type -- it zonks as it + 2. When we are generalizing: + kindGeneralize does not require a zonked type -- it zonks as it gathers free variables. So this way effectively sidesteps step 3. -} diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index a59f9a6..636c0da 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -1273,12 +1273,6 @@ topNormaliseType_maybe env ty tyFamStepper rec_nts tc tys -- Try to step a type/data family = let (args_co, ntys) = normaliseTcArgs env Representational tc tys in - -- NB: It's OK to use normaliseTcArgs here instead of - -- normalise_tc_args (which takes the LiftingContext described - -- in Note [Normalising types]) because the reduceTyFamApp below - -- works only at top level. We'll never recur in this function - -- after reducing the kind of a bound tyvar. - case reduceTyFamApp_maybe env Representational tc ntys of Just (co, rhs) -> NS_Step rec_nts rhs (args_co `mkTransCo` co) _ -> NS_Done From git at git.haskell.org Fri Aug 31 18:05:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 31 Aug 2018 18:05:50 +0000 (UTC) Subject: [commit: ghc] master: Commets on flatten_args_tc (fda2ea5) Message-ID: <20180831180550.585983A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fda2ea5830176236380a6976dfd0d5802395c6a9/ghc >--------------------------------------------------------------- commit fda2ea5830176236380a6976dfd0d5802395c6a9 Author: Simon Peyton Jones Date: Thu Aug 30 11:55:31 2018 +0100 Commets on flatten_args_tc >--------------------------------------------------------------- fda2ea5830176236380a6976dfd0d5802395c6a9 compiler/typecheck/TcFlatten.hs | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 79ffc4d..4129b87 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1129,10 +1129,17 @@ TODO: a step-by-step replay of the refactor to analyze the performance. -} {-# INLINE flatten_args_tc #-} -flatten_args_tc :: TyCon - -> [Role] - -> [Type] - -> FlatM ([Xi], [Coercion], CoercionN) +flatten_args_tc + :: TyCon -- T + -> [Role] -- Role r + -> [Type] -- Arg types [t1,..,tn] + -> FlatM ( [Xi] -- List of flattened args [x1,..,xn] + -- 1-1 corresp with [t1,..,tn] + , [Coercion] -- List of arg coercions [co1,..,con] + -- 1-1 corresp with [t1,..,tn] + -- coi :: xi ~r ti + , CoercionN) -- Result coercion, rco + -- rco : (T t1..tn) ~N (T (x1 |> co1) .. (xn |> con)) flatten_args_tc tc = flatten_args all_bndrs any_named_bndrs inner_ki emptyVarSet -- NB: TyCon kinds are always closed where From git at git.haskell.org Fri Aug 31 18:05:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 31 Aug 2018 18:05:54 +0000 (UTC) Subject: [commit: ghc] master: Remove knot-tying bug in TcHsSyn.zonkTyVarOcc (565ef4c) Message-ID: <20180831180554.0F9563A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/565ef4cc036905f9f9801c1e775236bb007b026c/ghc >--------------------------------------------------------------- commit 565ef4cc036905f9f9801c1e775236bb007b026c Author: Simon Peyton Jones Date: Fri Aug 31 11:33:08 2018 +0100 Remove knot-tying bug in TcHsSyn.zonkTyVarOcc There was a subtle knot-tying bug in TcHsSyn.zonkTyVarOcc, revealed in Trac #15552. I fixed it by * Eliminating the short-circuiting optimisation in zonkTyVarOcc, instead adding a finite map to get sharing of zonked unification variables. See Note [Sharing when zonking to Type] in TcHsSyn * On the way I /added/ the short-circuiting optimisation to TcMType.zonkTcTyVar, which has no such problem. This turned out (based on non-systematic measurements) to be a modest win. See Note [Sharing in zonking] in TcMType On the way I renamed some of the functions in TcHsSyn: * Ones ending in "X" (like zonkTcTypeToTypeX) take a ZonkEnv * Ones that do not end in "x" (like zonkTcTypeToType), don't. Instead they whiz up an empty ZonkEnv. >--------------------------------------------------------------- 565ef4cc036905f9f9801c1e775236bb007b026c compiler/ghci/RtClosureInspect.hs | 5 +- compiler/typecheck/TcDefaults.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 277 ++++++++++++++------- compiler/typecheck/TcHsType.hs | 8 +- compiler/typecheck/TcInstDcls.hs | 11 +- compiler/typecheck/TcMType.hs | 28 ++- compiler/typecheck/TcPatSyn.hs | 13 +- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcSplice.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 42 ++-- testsuite/tests/typecheck/should_fail/T15552.hs | 17 ++ testsuite/tests/typecheck/should_fail/T15552a.hs | 28 +++ .../tests/typecheck/should_fail/T15552a.stderr | 21 ++ testsuite/tests/typecheck/should_fail/all.T | 2 + 14 files changed, 321 insertions(+), 137 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 565ef4cc036905f9f9801c1e775236bb007b026c From git at git.haskell.org Fri Aug 31 18:05:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 31 Aug 2018 18:05:56 +0000 (UTC) Subject: [commit: ghc] master: Comments only (5851885) Message-ID: <20180831180556.DDA983A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/585188529d6a8b98f5e0f1985bce23a022dd8b7e/ghc >--------------------------------------------------------------- commit 585188529d6a8b98f5e0f1985bce23a022dd8b7e Author: Simon Peyton Jones Date: Thu Aug 30 11:54:49 2018 +0100 Comments only >--------------------------------------------------------------- 585188529d6a8b98f5e0f1985bce23a022dd8b7e compiler/specialise/SpecConstr.hs | 2 +- compiler/types/Type.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs index 2f6821c..0d57860 100644 --- a/compiler/specialise/SpecConstr.hs +++ b/compiler/specialise/SpecConstr.hs @@ -507,7 +507,7 @@ sc_force to True when calling specLoop. This flag does four things: * Ignore specConstrCount, to make arbitrary numbers of specialisations (see specialise) * Specialise even for arguments that are not scrutinised in the loop - (see argToPat; Trac #4488) + (see argToPat; Trac #4448) * Only specialise on recursive types a finite number of times (see is_too_recursive; Trac #5550; Note [Limit recursive specialisation]) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 33cdae3..2529bfb 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1056,7 +1056,7 @@ piResultTys ty orig_args@(arg:args) | otherwise = -- We have not run out of arguments, but the function doesn't -- have the right kind to apply to them; so panic. - -- Without hte explicit isEmptyVarEnv test, an ill-kinded type + -- Without the explicit isEmptyVarEnv test, an ill-kinded type -- would give an infniite loop, which is very unhelpful -- c.f. Trac #15473 pprPanic "piResultTys2" (ppr ty $$ ppr orig_args $$ ppr all_args) @@ -1090,7 +1090,7 @@ So In other words wwe must intantiate the forall! -Similarly (Trac #154218) +Similarly (Trac #15428) S :: forall k f. k -> f k and we are finding the kind of S * (* ->) Int Bool From git at git.haskell.org Fri Aug 31 18:06:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 31 Aug 2018 18:06:54 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T1448-accum' created Message-ID: <20180831180654.83DD13A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T1448-accum Referencing: a4e7a912ff426ef9cb968ea21d1a514f203a7ea5 From git at git.haskell.org Fri Aug 31 18:06:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 31 Aug 2018 18:06:57 +0000 (UTC) Subject: [commit: ghc] wip/T1448-accum: Use an accumulator version of tyCoVarsOfType (a4e7a91) Message-ID: <20180831180657.5A0C43A8E4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T1448-accum Link : http://ghc.haskell.org/trac/ghc/changeset/a4e7a912ff426ef9cb968ea21d1a514f203a7ea5/ghc >--------------------------------------------------------------- commit a4e7a912ff426ef9cb968ea21d1a514f203a7ea5 Author: Simon Peyton Jones Date: Fri Aug 31 14:18:55 2018 +0100 Use an accumulator version of tyCoVarsOfType In TyCoRep we now have tyCoVarsOfType implemented 1) Using FV -- this is the baseline version in GHC today 2) Using VarSets via unionVarSet 3) Using VarSets in accumulator-style In this patch (3) is enabled. When compiling perf/compiler/T5631 we get Compiler allocs (1) 1,144M (2) 1,175M (3) 1,142M The key new insight in (3) is this: ty_co_vars_of_type (TyVarTy v) is acc | v `elemVarSet` is = acc | v `elemVarSet` acc = acc <---- NB! | otherwise = ty_co_vars_of_type (tyVarKind v) is (extendVarSet acc v) Notice the second line! If the variable is already in the accumulator, don't re-add it. This makes big difference. Without it, allocation is 1,169M or so. One cause is that we only take the free vars of its kind once; that problem will go away when we do the main part of #14088 and close over kinds /afterwards/. But still, another cause is perhaps that every insert into a set overwrites the previous item, and so allocates a new path to the item; it's not a no-op even if the item is there already. Why use (3) rather than (1)? Becuase it just /has/ to be better; * FV carries around an InterestingVarFun, which does nothing useful here, but is tested at every variable * FV carries around a [Var] for the deterministic version. For this very hot operation (finding free vars) I think it makes sense to have speical purpose code. On the way I also simplified the (less used) coVarsOfType/Co family to use FV, by making serious use of the InterestingVarFun! >--------------------------------------------------------------- a4e7a912ff426ef9cb968ea21d1a514f203a7ea5 compiler/types/TyCoRep.hs | 369 ++++++++++++++++++++++++++++++---------------- 1 file changed, 239 insertions(+), 130 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 a4e7a912ff426ef9cb968ea21d1a514f203a7ea5