From git at git.haskell.org Thu Jun 2 09:26:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Jun 2016 09:26:16 +0000 (UTC) Subject: [commit: ghc] master: Use nameSetAny in findUses (cb2c042) Message-ID: <20160602092616.5C3643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cb2c042947ccc4d13bd11d3e4bce47059c3471de/ghc >--------------------------------------------------------------- commit cb2c042947ccc4d13bd11d3e4bce47059c3471de Author: Bartosz Nitka Date: Thu Jun 2 02:17:37 2016 -0700 Use nameSetAny in findUses This kills one use of nameSetElems which is nondeterministic >--------------------------------------------------------------- cb2c042947ccc4d13bd11d3e4bce47059c3471de compiler/basicTypes/NameSet.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/basicTypes/NameSet.hs b/compiler/basicTypes/NameSet.hs index 1400775..559f439 100644 --- a/compiler/basicTypes/NameSet.hs +++ b/compiler/basicTypes/NameSet.hs @@ -195,7 +195,7 @@ findUses dus uses = rhs_uses `unionNameSet` uses get (Just defs, rhs_uses) uses | defs `intersectsNameSet` uses -- Used - || any (startsWithUnderscore . nameOccName) (nameSetElems defs) + || nameSetAny (startsWithUnderscore . nameOccName) defs -- At least one starts with an "_", -- so treat the group as used = rhs_uses `unionNameSet` uses From git at git.haskell.org Thu Jun 2 09:44:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Jun 2016 09:44:55 +0000 (UTC) Subject: [commit: ghc] master: Improve failed knot-tying error message. (f2b3be0) Message-ID: <20160602094455.421633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f2b3be031075156cf128aba127bdddb84f8b2eb8/ghc >--------------------------------------------------------------- commit f2b3be031075156cf128aba127bdddb84f8b2eb8 Author: Edward Z. Yang Date: Mon May 30 14:21:36 2016 +0200 Improve failed knot-tying error message. Test Plan: validate Reviewers: simonpj, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2207 >--------------------------------------------------------------- f2b3be031075156cf128aba127bdddb84f8b2eb8 compiler/deSugar/DsMonad.hs | 3 ++- compiler/iface/TcIface.hs | 24 ++++++++++++++++++++---- compiler/typecheck/TcRnMonad.hs | 7 ++++++- compiler/typecheck/TcRnTypes.hs | 3 +++ 4 files changed, 31 insertions(+), 6 deletions(-) diff --git a/compiler/deSugar/DsMonad.hs b/compiler/deSugar/DsMonad.hs index de14107..69aa0f9 100644 --- a/compiler/deSugar/DsMonad.hs +++ b/compiler/deSugar/DsMonad.hs @@ -261,7 +261,8 @@ initTcDsForSolver thing_inside mkDsEnvs :: DynFlags -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv -> IORef Messages -> IORef Int -> (DsGblEnv, DsLclEnv) mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var pmvar - = let if_genv = IfGblEnv { if_rec_types = Just (mod, return type_env) } + = let if_genv = IfGblEnv { if_doc = text "mkDsEnvs", + if_rec_types = Just (mod, return type_env) } if_lenv = mkIfLclEnv mod (text "GHC error in desugarer lookup in" <+> ppr mod) real_span = realSrcLocSpan (mkRealSrcLoc (moduleNameFS (moduleName mod)) 1 1) gbl_env = DsGblEnv { ds_mod = mod diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index 8bc0dd1..1298047 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -1319,9 +1319,11 @@ tcIfaceGlobal name -> do -- It's defined in the module being compiled { type_env <- setLclEnv () get_type_env -- yuk ; case lookupNameEnv type_env name of - Just thing -> return thing - Nothing -> pprPanic "tcIfaceGlobal (local): not found:" - (ppr name $$ ppr type_env) } + Just thing -> return thing + Nothing -> + pprPanic "tcIfaceGlobal (local): not found" + (ifKnotErr name (if_doc env) type_env) + } ; _ -> do @@ -1337,11 +1339,25 @@ tcIfaceGlobal name Succeeded thing -> return thing }}}}} +ifKnotErr :: Name -> SDoc -> TypeEnv -> SDoc +ifKnotErr name env_doc type_env = vcat + [ text "You are in a maze of twisty little passages, all alike." + , text "While forcing the thunk for TyThing" <+> ppr name + , text "which was lazily initialized by" <+> env_doc <> text "," + , text "I tried to tie the knot, but I couldn't find" <+> ppr name + , text "in the current type environment." + , text "If you are developing GHC, please read Note [Tying the knot]" + , text "and Note [Type-checking inside the knot]." + , text "Consider rebuilding GHC with profiling for a better stack trace." + , hang (text "Contents of current type environment:") + 2 (ppr type_env) + ] + -- Note [Tying the knot] -- ~~~~~~~~~~~~~~~~~~~~~ -- The if_rec_types field is used in two situations: -- --- a) Compiling M.hs, which indiretly imports Foo.hi, which mentions M.T +-- a) Compiling M.hs, which indirectly imports Foo.hi, which mentions M.T -- Then we look up M.T in M's type environment, which is splatted into if_rec_types -- after we've built M's type envt. -- diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 88c63f9..cd99b7c 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -1474,6 +1474,7 @@ initIfaceTcRn :: IfG a -> TcRn a initIfaceTcRn thing_inside = do { tcg_env <- getGblEnv ; let { if_env = IfGblEnv { + if_doc = text "initIfaceTcRn", if_rec_types = Just (tcg_mod tcg_env, get_type_env) } ; get_type_env = readTcRef (tcg_type_env_var tcg_env) } @@ -1486,7 +1487,10 @@ initIfaceCheck hsc_env do_this = do let rec_types = case hsc_type_env_var hsc_env of Just (mod,var) -> Just (mod, readTcRef var) Nothing -> Nothing - gbl_env = IfGblEnv { if_rec_types = rec_types } + gbl_env = IfGblEnv { + if_doc = text "initIfaceCheck", + if_rec_types = rec_types + } initTcRnIf 'i' hsc_env gbl_env () do_this initIfaceTc :: ModIface @@ -1496,6 +1500,7 @@ initIfaceTc :: ModIface initIfaceTc iface do_this = do { tc_env_var <- newTcRef emptyTypeEnv ; let { gbl_env = IfGblEnv { + if_doc = text "initIfaceTc", if_rec_types = Just (mod, readTcRef tc_env_var) } ; ; if_lenv = mkIfLclEnv mod doc diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index da9878f..4017688 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -254,6 +254,9 @@ instance ContainsModule gbl => ContainsModule (Env gbl lcl) where data IfGblEnv = IfGblEnv { + -- Some information about where this environment came from; + -- useful for debugging. + if_doc :: SDoc, -- The type environment for the module being compiled, -- in case the interface refers back to it via a reference that -- was originally a hi-boot file. From git at git.haskell.org Thu Jun 2 13:15:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Jun 2016 13:15:25 +0000 (UTC) Subject: [commit: ghc] master: Kill nameSetElems in getInfo (99ace83) Message-ID: <20160602131525.7DF783A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/99ace837a364a5faa207280576c6ffbda4fe262a/ghc >--------------------------------------------------------------- commit 99ace837a364a5faa207280576c6ffbda4fe262a Author: Bartosz Nitka Date: Thu Jun 2 06:18:03 2016 -0700 Kill nameSetElems in getInfo nameSetAll is more precise here >--------------------------------------------------------------- 99ace837a364a5faa207280576c6ffbda4fe262a compiler/main/InteractiveEval.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index e564288..6ca5d24 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -785,7 +785,7 @@ getInfo allInfo name plausible rdr_env names -- Dfun involving only names that are in ic_rn_glb_env = allInfo - || all ok (nameSetElems names) + || nameSetAll ok names where -- A name is ok if it's in the rdr_env, -- whether qualified or not ok n | n == name = True From git at git.haskell.org Thu Jun 2 15:34:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Jun 2016 15:34:04 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: run tests in /tmp/ghctest-xxx instead of /tmp/ghctest/xxx (36d254a) Message-ID: <20160602153404.7F14E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/36d254afadb49a855dea031c036b1a371a567f16/ghc >--------------------------------------------------------------- commit 36d254afadb49a855dea031c036b1a371a567f16 Author: Thomas Miedema Date: Thu Jun 2 15:10:28 2016 +0200 Testsuite: run tests in /tmp/ghctest-xxx instead of /tmp/ghctest/xxx This fixes a bug of not being able to create files or directories in /tmp/ghctest if it was created by a different user. Trac ticket #11980. >--------------------------------------------------------------- 36d254afadb49a855dea031c036b1a371a567f16 testsuite/driver/runtests.py | 16 +--------------- 1 file changed, 1 insertion(+), 15 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 629a85e..c62c5a7 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -276,25 +276,11 @@ else: # set stdout to unbuffered (is this the best way to do it?) sys.stdout = os.fdopen(sys.__stdout__.fileno(), "w", 0) -# Create a unique temporary directory inside '/tmp/ghctest'. -ghctestdir = os.path.join(tempfile.gettempdir(), 'ghctest') -# Don't start from scratch (i.e. don't rmtree(ghctestdir)). Running -# 'make test' while another 'make test' hasn't completed yet should work. -#shutil.rmtree(ghctestdir, ignore_errors=True) -mkdirp(ghctestdir) -tempdir = normalise_slashes_(tempfile.mkdtemp('', '', dir=ghctestdir)) +tempdir = normalise_slashes_(tempfile.mkdtemp('', 'ghctest-')) def cleanup_and_exit(exitcode): if config.cleanup: shutil.rmtree(tempdir, ignore_errors=True) - try: - os.rmdir(ghctestdir) - except OSError as e: - if e.errno == errno.ENOTEMPTY: - # Only delete ghctestdir if it is empty. - pass - else: - raise exit(exitcode) # First collect all the tests to be run From git at git.haskell.org Thu Jun 2 15:34:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Jun 2016 15:34:07 +0000 (UTC) Subject: [commit: ghc] master: Travis: llvm's apt repository is offline (940229c) Message-ID: <20160602153407.3C6673A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/940229c280fcc986003ad60d3ff2a2643c7c4363/ghc >--------------------------------------------------------------- commit 940229c280fcc986003ad60d3ff2a2643c7c4363 Author: Thomas Miedema Date: Thu Jun 2 15:29:39 2016 +0200 Travis: llvm's apt repository is offline >--------------------------------------------------------------- 940229c280fcc986003ad60d3ff2a2643c7c4363 .travis.yml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index 1006503..0f80ece 100644 --- a/.travis.yml +++ b/.travis.yml @@ -8,18 +8,20 @@ env: - DEBUG_STAGE2=YES - DEBUG_STAGE2=NO +# TODO. Install llvm once llvm's APT repository is working again. +# See http://lists.llvm.org/pipermail/llvm-dev/2016-May/100303.html. addons: apt: sources: - hvr-ghc - - llvm-toolchain-precise-3.7 + #- llvm-toolchain-precise-3.7 - ubuntu-toolchain-r-test packages: - cabal-install-1.18 - ghc-7.10.3 - alex-3.1.3 - happy-1.19.4 - - llvm-3.7 + #- llvm-3.7 before_install: - export PATH=/opt/ghc/7.10.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.7/bin:$PATH From git at git.haskell.org Thu Jun 2 16:46:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Jun 2016 16:46:34 +0000 (UTC) Subject: [commit: ghc] master: Localize orphan-related nondeterminism (cb9f635) Message-ID: <20160602164634.66B353A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cb9f635eae76c61f189b9b55af4ed7628ccafda1/ghc >--------------------------------------------------------------- commit cb9f635eae76c61f189b9b55af4ed7628ccafda1 Author: Bartosz Nitka Date: Thu Jun 2 09:39:47 2016 -0700 Localize orphan-related nondeterminism chooseOrphanAnchor now takes a NameSet, relieving the callers from the burden of converting it to a list Test Plan: ./validate Reviewers: bgamari, ezyang, austin, simonmar, simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2294 GHC Trac Issues: #4012 >--------------------------------------------------------------- cb9f635eae76c61f189b9b55af4ed7628ccafda1 compiler/coreSyn/CoreSyn.hs | 11 +++++++---- compiler/iface/MkIface.hs | 2 +- compiler/specialise/Rules.hs | 4 ++-- compiler/types/InstEnv.hs | 2 +- 4 files changed, 11 insertions(+), 8 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 8a34c35..6fb1a33 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -95,6 +95,7 @@ import Var import Type import Coercion import Name +import NameSet import NameEnv( NameEnv, emptyNameEnv ) import Literal import DataCon @@ -104,6 +105,7 @@ import BasicTypes import DynFlags import Outputable import Util +import UniqFM import SrcLoc ( RealSrcSpan, containsSpan ) import Binary @@ -741,7 +743,7 @@ notOrphan :: IsOrphan -> Bool notOrphan NotOrphan{} = True notOrphan _ = False -chooseOrphanAnchor :: [Name] -> IsOrphan +chooseOrphanAnchor :: NameSet -> IsOrphan -- Something (rule, instance) is relate to all the Names in this -- list. Choose one of them to be an "anchor" for the orphan. We make -- the choice deterministic to avoid gratuitious changes in the ABI @@ -751,10 +753,11 @@ chooseOrphanAnchor :: [Name] -> IsOrphan -- NB: 'minimum' use Ord, and (Ord OccName) works lexicographically -- chooseOrphanAnchor local_names - | null local_names = IsOrphan - | otherwise = NotOrphan (minimum occs) + | isEmptyNameSet local_names = IsOrphan + | otherwise = NotOrphan (minimum occs) where - occs = map nameOccName local_names + occs = map nameOccName $ nonDetEltsUFM local_names + -- It's OK to use nonDetEltsUFM here, see comments above instance Binary IsOrphan where put_ bh IsOrphan = putByte bh 0 diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 64c7831..7652421 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -1641,7 +1641,7 @@ famInstToIfaceFamInst (FamInst { fi_axiom = axiom, orph | is_local fam_decl = NotOrphan (nameOccName fam_decl) | otherwise - = chooseOrphanAnchor $ nameSetElems lhs_names + = chooseOrphanAnchor lhs_names -------------------------- toIfaceLetBndr :: Id -> IfaceLetBndr diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs index e11de97..4868424 100644 --- a/compiler/specialise/Rules.hs +++ b/compiler/specialise/Rules.hs @@ -181,13 +181,13 @@ mkRule this_mod is_auto is_local name act fn bndrs args rhs -- Compute orphanhood. See Note [Orphans] in InstEnv -- A rule is an orphan only if none of the variables -- mentioned on its left-hand side are locally defined - lhs_names = nameSetElems (extendNameSet (exprsOrphNames args) fn) + lhs_names = extendNameSet (exprsOrphNames args) fn -- Since rules get eventually attached to one of the free names -- from the definition when compiling the ABI hash, we should make -- it deterministic. This chooses the one with minimal OccName -- as opposed to uniq value. - local_lhs_names = filter (nameIsLocalOrFrom this_mod) lhs_names + local_lhs_names = filterNameSet (nameIsLocalOrFrom this_mod) lhs_names orph = chooseOrphanAnchor local_lhs_names -------------- diff --git a/compiler/types/InstEnv.hs b/compiler/types/InstEnv.hs index ec6babc..e214f12 100644 --- a/compiler/types/InstEnv.hs +++ b/compiler/types/InstEnv.hs @@ -255,7 +255,7 @@ mkLocalInstance dfun oflag tvs cls tys do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- cls_tvs `zip` arg_names , not (tv `elem` rtvs)] - choose_one nss = chooseOrphanAnchor (nameSetElems (unionNameSets nss)) + choose_one nss = chooseOrphanAnchor (unionNameSets nss) mkImportedInstance :: Name -> [Maybe Name] From git at git.haskell.org Thu Jun 2 16:48:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Jun 2016 16:48:11 +0000 (UTC) Subject: [commit: ghc] master: Serialize vParallelTyCons in a stable order (d348acd) Message-ID: <20160602164811.D11273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d348acd527548fc71a59e239a963e982c69af1f8/ghc >--------------------------------------------------------------- commit d348acd527548fc71a59e239a963e982c69af1f8 Author: Bartosz Nitka Date: Thu Jun 2 09:51:04 2016 -0700 Serialize vParallelTyCons in a stable order nameSetElems can introduce nondeterminism and while I haven't observed this being a problem in practice (possibly because this is dead code) there's no downside to doing this. Test Plan: ./validate Reviewers: bgamari, austin, simonpj, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2296 GHC Trac Issues: #4012 >--------------------------------------------------------------- d348acd527548fc71a59e239a963e982c69af1f8 compiler/iface/MkIface.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 7652421..ebdf74d 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -327,7 +327,7 @@ mkIface_ hsc_env maybe_old_fingerprint , ifaceVectInfoTyCon = [tyConName t | (t, t_v) <- nameEnvElts vTyCon, t /= t_v] , ifaceVectInfoTyConReuse = [tyConName t | (t, t_v) <- nameEnvElts vTyCon, t == t_v] , ifaceVectInfoParallelVars = [Var.varName v | v <- varSetElems vParallelVars] - , ifaceVectInfoParallelTyCons = nameSetElems vParallelTyCons + , ifaceVectInfoParallelTyCons = nameSetElemsStable vParallelTyCons } ----------------------------- From git at git.haskell.org Thu Jun 2 17:32:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Jun 2016 17:32:13 +0000 (UTC) Subject: [commit: ghc] master: Add nameSetElemsStable and fix the build (3eac3a0) Message-ID: <20160602173213.DE0713A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3eac3a0e9f74ad936375e3ba65f5d8454ea9d408/ghc >--------------------------------------------------------------- commit 3eac3a0e9f74ad936375e3ba65f5d8454ea9d408 Author: Bartosz Nitka Date: Thu Jun 2 10:34:57 2016 -0700 Add nameSetElemsStable and fix the build >--------------------------------------------------------------- 3eac3a0e9f74ad936375e3ba65f5d8454ea9d408 compiler/basicTypes/NameSet.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/compiler/basicTypes/NameSet.hs b/compiler/basicTypes/NameSet.hs index 559f439..27a2c3b 100644 --- a/compiler/basicTypes/NameSet.hs +++ b/compiler/basicTypes/NameSet.hs @@ -13,7 +13,7 @@ module NameSet ( minusNameSet, elemNameSet, nameSetElems, extendNameSet, extendNameSetList, delFromNameSet, delListFromNameSet, isEmptyNameSet, filterNameSet, intersectsNameSet, intersectNameSet, - nameSetAny, nameSetAll, + nameSetAny, nameSetAll, nameSetElemsStable, -- * Free variables FreeVars, @@ -35,6 +35,8 @@ module NameSet ( import Name import UniqSet +import UniqFM +import Data.List (sortBy) {- ************************************************************************ @@ -90,6 +92,14 @@ nameSetAny = uniqSetAny nameSetAll :: (Name -> Bool) -> NameSet -> Bool nameSetAll = uniqSetAll +-- | Get the elements of a NameSet with some stable ordering. +-- See Note [Deterministic UniqFM] to learn about nondeterminism +nameSetElemsStable :: NameSet -> [Name] +nameSetElemsStable ns = + sortBy stableNameCmp $ nonDetEltsUFM ns + -- It's OK to use nonDetEltsUFM here because we immediately sort + -- with stableNameCmp + {- ************************************************************************ * * From git at git.haskell.org Thu Jun 2 18:25:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Jun 2016 18:25:58 +0000 (UTC) Subject: [commit: packages/binary] ghc-head: Use explicit import-list for `GHC.Base` import (f5f6fe7) Message-ID: <20160602182558.AF13A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : ghc-head Link : http://git.haskell.org/packages/binary.git/commitdiff/f5f6fe72bd069a2b56dd52e645aad406c6195526 >--------------------------------------------------------------- commit f5f6fe72bd069a2b56dd52e645aad406c6195526 Author: Herbert Valerio Riedel Date: Thu Sep 18 00:02:54 2014 +0200 Use explicit import-list for `GHC.Base` import submitted upstream as https://github.com/kolmodin/binary/pull/59 >--------------------------------------------------------------- f5f6fe72bd069a2b56dd52e645aad406c6195526 src/Data/Binary/Builder/Base.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Binary/Builder/Base.hs b/src/Data/Binary/Builder/Base.hs index d6bb32a..cc40272 100644 --- a/src/Data/Binary/Builder/Base.hs +++ b/src/Data/Binary/Builder/Base.hs @@ -81,7 +81,7 @@ import qualified Data.ByteString.Lazy.Internal as L #endif #if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) -import GHC.Base +import GHC.Base (ord,Int(..),uncheckedShiftRL#) import GHC.Word (Word32(..),Word16(..),Word64(..)) # if WORD_SIZE_IN_BITS < 64 import GHC.Word (uncheckedShiftRL64#) From git at git.haskell.org Thu Jun 2 18:26:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Jun 2016 18:26:00 +0000 (UTC) Subject: [commit: packages/binary] ghc-head: Remove INLINEs from GBinary/GSum methods (03adb0a) Message-ID: <20160602182600.B4CEC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : ghc-head Link : http://git.haskell.org/packages/binary.git/commitdiff/03adb0aa2c17ce044586e3a30edc13e5cc83f69e >--------------------------------------------------------------- commit 03adb0aa2c17ce044586e3a30edc13e5cc83f69e Author: Herbert Valerio Riedel Date: Thu Sep 25 22:07:13 2014 +0200 Remove INLINEs from GBinary/GSum methods These interact very badly with GHC 7.9.x's simplifier See also - https://ghc.haskell.org/trac/ghc/ticket/9630 and - https://ghc.haskell.org/trac/ghc/ticket/9583 Submitted upstream as https://github.com/kolmodin/binary/pull/62 >--------------------------------------------------------------- 03adb0aa2c17ce044586e3a30edc13e5cc83f69e src/Data/Binary/Generic.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/Data/Binary/Generic.hs b/src/Data/Binary/Generic.hs index 03ce711..a2eb6ea 100644 --- a/src/Data/Binary/Generic.hs +++ b/src/Data/Binary/Generic.hs @@ -72,13 +72,11 @@ instance ( GSum a, GSum b | otherwise = sizeError "encode" size where size = unTagged (sumSize :: Tagged (a :+: b) Word64) - {-# INLINE gput #-} gget | GETSUM(Word8) | GETSUM(Word16) | GETSUM(Word32) | GETSUM(Word64) | otherwise = sizeError "decode" size where size = unTagged (sumSize :: Tagged (a :+: b) Word64) - {-# INLINE gget #-} sizeError :: Show size => String -> size -> error sizeError s size = @@ -102,7 +100,6 @@ instance (GSum a, GSum b, GBinary a, GBinary b) => GSum (a :+: b) where where sizeL = size `shiftR` 1 sizeR = size - sizeL - {-# INLINE getSum #-} putSum !code !size s = case s of L1 x -> putSum code sizeL x @@ -110,14 +107,11 @@ instance (GSum a, GSum b, GBinary a, GBinary b) => GSum (a :+: b) where where sizeL = size `shiftR` 1 sizeR = size - sizeL - {-# INLINE putSum #-} instance GBinary a => GSum (C1 c a) where getSum _ _ = gget - {-# INLINE getSum #-} putSum !code _ x = put code *> gput x - {-# INLINE putSum #-} ------------------------------------------------------------------------ From git at git.haskell.org Thu Jun 2 18:59:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Jun 2016 18:59:12 +0000 (UTC) Subject: [commit: ghc] master: Remove dead generics-related code from OccName (dad39ff) Message-ID: <20160602185912.351E63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dad39ff04a6585ab9cf3a2572ea922e309e6385f/ghc >--------------------------------------------------------------- commit dad39ff04a6585ab9cf3a2572ea922e309e6385f Author: Ryan Scott Date: Thu Jun 2 15:00:22 2016 -0400 Remove dead generics-related code from OccName Before #9766 was fixed, GHC would generate auxiliary datatypes for every Generic instance, and it would use functions from OccName to prefix the generated names. GHC no longer generates any auxiliary datatypes for Generic instances, but the accompanying code was never removed from OccName (until now). >--------------------------------------------------------------- dad39ff04a6585ab9cf3a2572ea922e309e6385f compiler/basicTypes/OccName.hs | 29 ++--------------------------- 1 file changed, 2 insertions(+), 27 deletions(-) diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs index 868fff8..4410bd1 100644 --- a/compiler/basicTypes/OccName.hs +++ b/compiler/basicTypes/OccName.hs @@ -60,7 +60,7 @@ module OccName ( mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkRepEqOcc, - mkGenD, mkGenR, mkGen1R, mkGenRCo, mkGenC, mkGenS, + mkGenR, mkGen1R, mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkSuperDictSelOcc, mkSuperDictAuxOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc, @@ -112,7 +112,6 @@ import FastStringEnv import Outputable import Lexeme import Binary -import Module import Data.Char import Data.Data @@ -585,7 +584,7 @@ mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkRepEqOcc, - mkGenR, mkGen1R, mkGenRCo, + mkGenR, mkGen1R, mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc, mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc, mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, @@ -621,32 +620,8 @@ mkTyConRepOcc occ = mk_simple_deriv varName prefix occ | otherwise = "$tc" -- Generic deriving mechanism - --- | Generate a module-unique name, to be used e.g. while generating new names --- for Generics types. We use module unit id to avoid name clashes when --- package imports is used. -mkModPrefix :: Module -> String -mkModPrefix mod = pk ++ "_" ++ mn - where - pk = unitIdString (moduleUnitId mod) - mn = moduleNameString (moduleName mod) - -mkGenD :: Module -> OccName -> OccName -mkGenD mod = mk_simple_deriv tcName ("D1_" ++ mkModPrefix mod ++ "_") - -mkGenC :: Module -> OccName -> Int -> OccName -mkGenC mod occ m = - mk_deriv tcName ("C1_" ++ show m) $ - mkModPrefix mod ++ "_" ++ occNameString occ - -mkGenS :: Module -> OccName -> Int -> Int -> OccName -mkGenS mod occ m n = - mk_deriv tcName ("S1_" ++ show m ++ "_" ++ show n) $ - mkModPrefix mod ++ "_" ++ occNameString occ - mkGenR = mk_simple_deriv tcName "Rep_" mkGen1R = mk_simple_deriv tcName "Rep1_" -mkGenRCo = mk_simple_deriv tcName "CoRep_" -- data T = MkT ... deriving( Data ) needs definitions for -- $tT :: Data.Generics.Basics.DataType From git at git.haskell.org Thu Jun 2 19:46:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Jun 2016 19:46:40 +0000 (UTC) Subject: [commit: ghc] master: Kill nameSetElems in findImportUsage (e2446c0) Message-ID: <20160602194640.7F7533A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e2446c0d688d63e66fb1ae81cd2ebfa321ebc913/ghc >--------------------------------------------------------------- commit e2446c0d688d63e66fb1ae81cd2ebfa321ebc913 Author: Bartosz Nitka Date: Thu Jun 2 11:37:41 2016 -0700 Kill nameSetElems in findImportUsage nameSetElems is nondeterministic and while I think we don't need determinism here it doesn't hurt. Test Plan: ./validate Reviewers: ezyang, bgamari, austin, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2293 GHC Trac Issues: #4012 >--------------------------------------------------------------- e2446c0d688d63e66fb1ae81cd2ebfa321ebc913 compiler/rename/RnNames.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 40049bf..2fc6263 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -1655,7 +1655,7 @@ findImportUsage imports used_gres = foldr extendImportMap Map.empty used_gres unused_decl decl@(L loc (ImportDecl { ideclHiding = imps })) - = (decl, nubAvails used_avails, nameSetElems unused_imps) + = (decl, nubAvails used_avails, nameSetElemsStable unused_imps) where used_avails = Map.lookup (srcSpanEnd loc) import_usage `orElse` [] -- srcSpanEnd: see Note [The ImportMap] From git at git.haskell.org Thu Jun 2 19:46:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Jun 2016 19:46:43 +0000 (UTC) Subject: [commit: ghc] master: Use UniqDSet for finding free names in the Linker (d753ea2) Message-ID: <20160602194643.48A123A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d753ea2a546733cb29c2970232ac870023aee22f/ghc >--------------------------------------------------------------- commit d753ea2a546733cb29c2970232ac870023aee22f Author: Bartosz Nitka Date: Thu Jun 2 11:36:44 2016 -0700 Use UniqDSet for finding free names in the Linker This is not necessary for determinism, but it's a choice between making this deterministic and using `nonDetEltsUFM` and a comment explaining that it doesn't matter. Test Plan: ./validate Reviewers: austin, hvr, bgamari, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2295 GHC Trac Issues: #4012 >--------------------------------------------------------------- d753ea2a546733cb29c2970232ac870023aee22f compiler/ghci/ByteCodeAsm.hs | 11 ++++++----- compiler/ghci/Linker.hs | 7 ++++--- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/compiler/ghci/ByteCodeAsm.hs b/compiler/ghci/ByteCodeAsm.hs index f765a7d..817e379 100644 --- a/compiler/ghci/ByteCodeAsm.hs +++ b/compiler/ghci/ByteCodeAsm.hs @@ -34,6 +34,7 @@ import Outputable import Platform import Util import Unique +import UniqDSet -- From iserv import SizedSeq @@ -65,14 +66,14 @@ import qualified Data.Map as Map -- | Finds external references. Remember to remove the names -- defined by this group of BCOs themselves -bcoFreeNames :: UnlinkedBCO -> NameSet +bcoFreeNames :: UnlinkedBCO -> UniqDSet Name bcoFreeNames bco - = bco_refs bco `minusNameSet` mkNameSet [unlinkedBCOName bco] + = bco_refs bco `uniqDSetMinusUniqSet` mkNameSet [unlinkedBCOName bco] where bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs) - = unionNameSets ( - mkNameSet [ n | BCOPtrName n <- ssElts ptrs ] : - mkNameSet [ n | BCONPtrItbl n <- ssElts nonptrs ] : + = unionManyUniqDSets ( + mkUniqDSet [ n | BCOPtrName n <- ssElts ptrs ] : + mkUniqDSet [ n | BCONPtrItbl n <- ssElts nonptrs ] : map bco_refs [ bco | BCOPtrBCO bco <- ssElts ptrs ] ) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 5042136..0f15ea2 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -37,7 +37,6 @@ import Finder import HscTypes import Name import NameEnv -import NameSet import UniqFM import Module import ListSetOps @@ -50,6 +49,7 @@ import ErrUtils import SrcLoc import qualified Maybes import UniqSet +import UniqDSet import FastString import Platform import SysTools @@ -504,7 +504,7 @@ linkExpr hsc_env span root_ul_bco ; return (pls, fhv) }}} where - free_names = nameSetElems (bcoFreeNames root_ul_bco) + free_names = uniqDSetToList (bcoFreeNames root_ul_bco) needed_mods :: [Module] needed_mods = [ nameModule n | n <- free_names, @@ -730,7 +730,8 @@ linkDecls hsc_env span cbc at CompiledByteCode{..} = do , itbl_env = ie } return (pls2, ()) where - free_names = concatMap (nameSetElems . bcoFreeNames) bc_bcos + free_names = uniqDSetToList $ + foldr (unionUniqDSets . bcoFreeNames) emptyUniqDSet bc_bcos needed_mods :: [Module] needed_mods = [ nameModule n | n <- free_names, From git at git.haskell.org Thu Jun 2 19:46:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Jun 2016 19:46:46 +0000 (UTC) Subject: [commit: ghc] master: Kill nameSetElems in rnCmdTop (be47085) Message-ID: <20160602194646.11ED33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/be4708513fc04dd9c9c99fe652503866ecd85c15/ghc >--------------------------------------------------------------- commit be4708513fc04dd9c9c99fe652503866ecd85c15 Author: Bartosz Nitka Date: Thu Jun 2 11:38:11 2016 -0700 Kill nameSetElems in rnCmdTop This change isn't necessary for determinism. appAName, choiceAName, loopAName all have pre-allocated Uniques and their relative order can't change. I opted to use nameSetElemsStable here because: * the cost is negligible * it's less fragile than just documenting Test Plan: ./validate Reviewers: simonpj, austin, bgamari, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2292 GHC Trac Issues: #4012 >--------------------------------------------------------------- be4708513fc04dd9c9c99fe652503866ecd85c15 compiler/rename/RnExpr.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index af58135..32277b4 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -441,7 +441,7 @@ rnCmdTop = wrapLocFstM rnCmdTop' rnCmdTop' (HsCmdTop cmd _ _ _) = do { (cmd', fvCmd) <- rnLCmd cmd ; let cmd_names = [arrAName, composeAName, firstAName] ++ - nameSetElems (methodNamesCmd (unLoc cmd')) + nameSetElemsStable (methodNamesCmd (unLoc cmd')) -- Generate the rebindable syntax for the monad ; (cmd_names', cmd_fvs) <- lookupSyntaxNames cmd_names From git at git.haskell.org Fri Jun 3 07:36:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Jun 2016 07:36:26 +0000 (UTC) Subject: [commit: ghc] master: Whitespace only (060c176) Message-ID: <20160603073626.4B8743A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/060c1763e2560095088a214d30ef77339f486b10/ghc >--------------------------------------------------------------- commit 060c1763e2560095088a214d30ef77339f486b10 Author: ?mer Sinan A?acan Date: Fri Jun 3 03:38:34 2016 -0400 Whitespace only >--------------------------------------------------------------- 060c1763e2560095088a214d30ef77339f486b10 compiler/codeGen/StgCmmExpr.hs | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Fri Jun 3 08:02:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Jun 2016 08:02:26 +0000 (UTC) Subject: [commit: ghc] master: HscMain: Minor simplification (1d1987e) Message-ID: <20160603080226.65C273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1d1987e088052eefd25dbc693846222499899749/ghc >--------------------------------------------------------------- commit 1d1987e088052eefd25dbc693846222499899749 Author: ?mer Sinan A?acan Date: Fri Jun 3 04:05:48 2016 -0400 HscMain: Minor simplification >--------------------------------------------------------------- 1d1987e088052eefd25dbc693846222499899749 compiler/main/HscMain.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 71f2ce2..7cbc6e7 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -665,9 +665,8 @@ hscIncrementalCompile always_do_basic_recompilation_check m_tc_result hm_iface = iface, hm_linkable = Nothing }) - Right (result, mb_old_hash) -> do - (status, hmi, no_change) <- case result of - FrontendTypecheck tc_result -> + Right (FrontendTypecheck tc_result, mb_old_hash) -> do + (status, hmi, no_change) <- if hscTarget dflags /= HscNothing && ms_hsc_src mod_summary == HsSrcFile then finish hsc_env mod_summary tc_result mb_old_hash From git at git.haskell.org Fri Jun 3 16:45:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Jun 2016 16:45:14 +0000 (UTC) Subject: [commit: ghc] master: Make FieldLabelEnv a deterministic set (9cc6fac) Message-ID: <20160603164514.086A83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9cc6fac5c096eb4120173495faf2c948f7a28487/ghc >--------------------------------------------------------------- commit 9cc6fac5c096eb4120173495faf2c948f7a28487 Author: Bartosz Nitka Date: Fri Jun 3 09:11:10 2016 -0700 Make FieldLabelEnv a deterministic set This lets us kill fsEnvElts function which is nondeterministic. We also get better guarantees than just comments. We don't do lookups, but I believe a set is needed for deduplication. Test Plan: ./validate Reviewers: bgamari, mpickering, austin, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2297 GHC Trac Issues: #4012 >--------------------------------------------------------------- 9cc6fac5c096eb4120173495faf2c948f7a28487 compiler/basicTypes/FieldLabel.hs | 3 ++- compiler/iface/MkIface.hs | 11 ++--------- compiler/types/TyCon.hs | 10 +++++----- compiler/utils/FastStringEnv.hs | 31 ++++++++++++++++++++++++++++--- compiler/utils/UniqDFM.hs | 4 ++++ 5 files changed, 41 insertions(+), 18 deletions(-) diff --git a/compiler/basicTypes/FieldLabel.hs b/compiler/basicTypes/FieldLabel.hs index db9e968..8548fd2 100644 --- a/compiler/basicTypes/FieldLabel.hs +++ b/compiler/basicTypes/FieldLabel.hs @@ -73,6 +73,7 @@ import OccName import Name import FastString +import FastStringEnv import Outputable import Binary @@ -83,7 +84,7 @@ import Data.Data type FieldLabelString = FastString -- | A map from labels to all the auxiliary information -type FieldLabelEnv = FastStringEnv FieldLabel +type FieldLabelEnv = DFastStringEnv FieldLabel type FieldLabel = FieldLbl Name diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index ebdf74d..88bc662 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -1506,17 +1506,10 @@ tyConToIfaceDecl env tycon (con_env2, ex_bndrs') = tidyTyBinders con_env1 ex_bndrs to_eq_spec (tv,ty) = (toIfaceTyVar (tidyTyVar con_env2 tv), tidyToIfaceType con_env2 ty) - ifaceOverloaded flds = case fsEnvElts flds of + ifaceOverloaded flds = case dFsEnvElts flds of fl:_ -> flIsOverloaded fl [] -> False - ifaceFields flds = sort $ map flLabel $ fsEnvElts flds - -- We need to sort the labels because they come out - -- of FastStringEnv in arbitrary order, because - -- FastStringEnv is keyed on Uniques. - -- Sorting FastString is ok here, because Uniques - -- are only used for equality checks in the Ord - -- instance for FastString. - -- See Note [Unique Determinism] in Unique. + ifaceFields flds = map flLabel $ dFsEnvElts flds toIfaceBang :: TidyEnv -> HsImplBang -> IfaceBang toIfaceBang _ HsLazy = IfNoBang diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 73d898f..c60e410 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -1195,20 +1195,20 @@ primRepIsFloat _ = Just False -- | The labels for the fields of this particular 'TyCon' tyConFieldLabels :: TyCon -> [FieldLabel] -tyConFieldLabels tc = fsEnvElts $ tyConFieldLabelEnv tc +tyConFieldLabels tc = dFsEnvElts $ tyConFieldLabelEnv tc -- | The labels for the fields of this particular 'TyCon' tyConFieldLabelEnv :: TyCon -> FieldLabelEnv tyConFieldLabelEnv tc | isAlgTyCon tc = algTcFields tc - | otherwise = emptyFsEnv + | otherwise = emptyDFsEnv -- | Make a map from strings to FieldLabels from all the data -- constructors of this algebraic tycon fieldsOfAlgTcRhs :: AlgTyConRhs -> FieldLabelEnv -fieldsOfAlgTcRhs rhs = mkFsEnv [ (flLabel fl, fl) - | fl <- dataConsFields (visibleDataCons rhs) ] +fieldsOfAlgTcRhs rhs = mkDFsEnv [ (flLabel fl, fl) + | fl <- dataConsFields (visibleDataCons rhs) ] where -- Duplicates in this list will be removed by 'mkFsEnv' dataConsFields dcs = concatMap dataConFieldLabels dcs @@ -1314,7 +1314,7 @@ mkTupleTyCon name binders res_kind arity tyvars con sort parent algTcStupidTheta = [], algTcRhs = TupleTyCon { data_con = con, tup_sort = sort }, - algTcFields = emptyFsEnv, + algTcFields = emptyDFsEnv, algTcParent = parent, algTcRec = NonRecursive, algTcGadtSyntax = False diff --git a/compiler/utils/FastStringEnv.hs b/compiler/utils/FastStringEnv.hs index fea627e..a3336ae 100644 --- a/compiler/utils/FastStringEnv.hs +++ b/compiler/utils/FastStringEnv.hs @@ -12,25 +12,36 @@ module FastStringEnv ( -- ** Manipulating these environments mkFsEnv, - emptyFsEnv, unitFsEnv, fsEnvElts, + emptyFsEnv, unitFsEnv, extendFsEnv_C, extendFsEnv_Acc, extendFsEnv, extendFsEnvList, extendFsEnvList_C, filterFsEnv, plusFsEnv, plusFsEnv_C, alterFsEnv, lookupFsEnv, lookupFsEnv_NF, delFromFsEnv, delListFromFsEnv, elemFsEnv, mapFsEnv, + + -- * Deterministic FastString environments (maps) + DFastStringEnv, + + -- ** Manipulating these environments + mkDFsEnv, emptyDFsEnv, dFsEnvElts, ) where import UniqFM +import UniqDFM import Maybes import FastString +-- | A non-deterministic set of FastStrings. +-- See Note [Deterministic UniqFM] in UniqDFM for explanation why it's not +-- deterministic and why it matters. Use DFastStringEnv if the set eventually +-- gets converted into a list or folded over in a way where the order +-- changes the generated code. type FastStringEnv a = UniqFM a -- Domain is FastString emptyFsEnv :: FastStringEnv a mkFsEnv :: [(FastString,a)] -> FastStringEnv a -fsEnvElts :: FastStringEnv a -> [a] alterFsEnv :: (Maybe a-> Maybe a) -> FastStringEnv a -> FastString -> FastStringEnv a extendFsEnv_C :: (a->a->a) -> FastStringEnv a -> FastString -> a -> FastStringEnv a extendFsEnv_Acc :: (a->b->b) -> (a->b) -> FastStringEnv b -> FastString -> a -> FastStringEnv b @@ -48,7 +59,6 @@ lookupFsEnv_NF :: FastStringEnv a -> FastString -> a filterFsEnv :: (elt -> Bool) -> FastStringEnv elt -> FastStringEnv elt mapFsEnv :: (elt1 -> elt2) -> FastStringEnv elt1 -> FastStringEnv elt2 -fsEnvElts x = eltsUFM x emptyFsEnv = emptyUFM unitFsEnv x y = unitUFM x y extendFsEnv x y z = addToUFM x y z @@ -68,3 +78,18 @@ delListFromFsEnv x y = delListFromUFM x y filterFsEnv x y = filterUFM x y lookupFsEnv_NF env n = expectJust "lookupFsEnv_NF" (lookupFsEnv env n) + +-- Deterministic FastStringEnv +-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need +-- DFastStringEnv. + +type DFastStringEnv a = UniqDFM a -- Domain is FastString + +emptyDFsEnv :: DFastStringEnv a +emptyDFsEnv = emptyUDFM + +dFsEnvElts :: DFastStringEnv a -> [a] +dFsEnvElts = eltsUDFM + +mkDFsEnv :: [(FastString,a)] -> DFastStringEnv a +mkDFsEnv l = listToUDFM l diff --git a/compiler/utils/UniqDFM.hs b/compiler/utils/UniqDFM.hs index d8efde8..8bd19ad 100644 --- a/compiler/utils/UniqDFM.hs +++ b/compiler/utils/UniqDFM.hs @@ -46,6 +46,7 @@ module UniqDFM ( intersectsUDFM, disjointUDFM, disjointUdfmUfm, minusUDFM, + listToUDFM, udfmMinusUFM, partitionUDFM, anyUDFM, @@ -313,6 +314,9 @@ udfmToUfm :: UniqDFM elt -> UniqFM elt udfmToUfm (UDFM m _i) = listToUFM_Directly [(getUnique k, taggedFst tv) | (k, tv) <- M.toList m] +listToUDFM :: Uniquable key => [(key,elt)] -> UniqDFM elt +listToUDFM = foldl (\m (k, v) -> addToUDFM m k v) emptyUDFM + listToUDFM_Directly :: [(Unique, elt)] -> UniqDFM elt listToUDFM_Directly = foldl (\m (u, v) -> addToUDFM_Directly m u v) emptyUDFM From git at git.haskell.org Fri Jun 3 16:45:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Jun 2016 16:45:16 +0000 (UTC) Subject: [commit: ghc] master: Document putSymbolTable determinism (2046297) Message-ID: <20160603164516.AE7413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2046297ec03bdcd4901f69cd6ae03e84dc974683/ghc >--------------------------------------------------------------- commit 2046297ec03bdcd4901f69cd6ae03e84dc974683 Author: Bartosz Nitka Date: Fri Jun 3 09:11:50 2016 -0700 Document putSymbolTable determinism Like explained in the comment it's OK here. Test Plan: ./validate Reviewers: bgamari, austin, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2298 GHC Trac Issues: #4012 >--------------------------------------------------------------- 2046297ec03bdcd4901f69cd6ae03e84dc974683 compiler/iface/BinIface.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 0b70e8c..4290704 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -254,7 +254,9 @@ binaryInterfaceMagic dflags putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off - let names = elems (array (0,next_off-1) (eltsUFM symtab)) + let names = elems (array (0,next_off-1) (nonDetEltsUFM symtab)) + -- It's OK to use nonDetEltsUFM here because the elements have + -- indices that array uses to create order mapM_ (\n -> serialiseName bh n symtab) names getSymbolTable :: BinHandle -> NameCacheUpdater -> IO SymbolTable From git at git.haskell.org Fri Jun 3 18:45:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Jun 2016 18:45:03 +0000 (UTC) Subject: [commit: ghc] master: Derive instances in Data.Data (4842a80) Message-ID: <20160603184503.11E6A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4842a8050058bb571db861be3fc5ec03a1b4274b/ghc >--------------------------------------------------------------- commit 4842a8050058bb571db861be3fc5ec03a1b4274b Author: Ryan Scott Date: Fri Jun 3 14:48:16 2016 -0400 Derive instances in Data.Data Summary: Currently, none of the `Data` instances in `Data.Data` are derived, which has resulted in hundreds of lines of laboriously hand-written `Data` instances. This cleans it up by using `DeriveDataTypeable` to derive all of the boring instances. Note that previously, `tcTopSrcDecls` in `TcRnDriver` was typechecking the variables generated in `deriving` statements before other top-level variables, which causes an error when `DeriveDataTypeable` is used in `Data.Data`, since the `deriving`-generated variable definitions refer to top-level definitions in `Data.Data` itself. To fix this, the order in which these two groups are typechecked was reversed. Test Plan: ./validate Reviewers: rwbarton, bgamari, hvr, austin Reviewed By: austin Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D2291 >--------------------------------------------------------------- 4842a8050058bb571db861be3fc5ec03a1b4274b compiler/typecheck/TcRnDriver.hs | 17 +- libraries/base/Data/Data.hs | 755 +++------------------------------------ 2 files changed, 69 insertions(+), 703 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 4842a8050058bb571db861be3fc5ec03a1b4274b From git at git.haskell.org Fri Jun 3 20:12:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Jun 2016 20:12:17 +0000 (UTC) Subject: [commit: ghc] master: Refactored SymbolInfo to lower memory usage in RTS (3747372) Message-ID: <20160603201217.B12483A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/37473722960a1066c3b45c94377ba08769b1375b/ghc >--------------------------------------------------------------- commit 37473722960a1066c3b45c94377ba08769b1375b Author: Tamar Christina Date: Fri Jun 3 21:42:16 2016 +0200 Refactored SymbolInfo to lower memory usage in RTS Previously as part of #11223 a new struct `SymbolInfo` was introduced to keep track it the weak symbol status of a symbol. This structure also kept a copy of the calculated address of the symbol which turns out was useful in ignoring non-weak zero-valued symbols. The information was kept in an array so it means for every symbol two extra bytes were kept even though the vast majority of symbols are non-weak and non-zero valued. This changes the array into a sparse map keeping this information only for the symbols that are weak or zero-valued. This allows for a reduction in the amount of information needed to be kept while giving up a small (negligable) hit in performance as this information now has to be looked up in hashmaps. Test Plan: ./validate on all platforms that use the runtime linker. For unix platforms please ensure `DYNAMIC_GHC_PROGRAMS=NO` is added to your validate file. Reviewers: simonmar, austin, erikd, bgamari Reviewed By: simonmar, bgamari Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2184 GHC Trac Issues: #11816 >--------------------------------------------------------------- 37473722960a1066c3b45c94377ba08769b1375b rts/Linker.c | 93 ++++++++++++++-------- rts/LinkerInternals.h | 23 ++---- rts/RtsSymbolInfo.c | 72 +++++++++++++++++ rts/RtsSymbolInfo.h | 17 ++++ .../T11223_simple_duplicate_lib.stderr-mingw32 | 2 +- 5 files changed, 155 insertions(+), 52 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 37473722960a1066c3b45c94377ba08769b1375b From git at git.haskell.org Fri Jun 3 20:12:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Jun 2016 20:12:14 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Mark broken tests on powerpc64le (1dadd9a) Message-ID: <20160603201214.2B0DF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1dadd9a91454bb098e9c47d6c034b07e2e1e2529/ghc >--------------------------------------------------------------- commit 1dadd9a91454bb098e9c47d6c034b07e2e1e2529 Author: Peter Trommler Date: Fri Jun 3 21:39:31 2016 +0200 testsuite: Mark broken tests on powerpc64le Mark all failing tests that have a ticket for powerpc64 as broken. Most of these failures are due to the lack of linker support in the runtime system. Test Plan: validate on powerpc and AIX Reviewers: erikd, bgamari, simonmar, hvr, austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2289 GHC Trac Issues: #11261, #11259, #11260, #11323 >--------------------------------------------------------------- 1dadd9a91454bb098e9c47d6c034b07e2e1e2529 testsuite/tests/codeGen/should_compile/all.T | 6 ++++-- testsuite/tests/driver/all.T | 2 +- testsuite/tests/driver/recomp011/all.T | 2 +- testsuite/tests/driver/recomp015/all.T | 2 +- testsuite/tests/ghc-api/T10052/all.T | 3 ++- testsuite/tests/ghc-api/all.T | 9 ++++++--- testsuite/tests/ghc-api/dynCompileExpr/all.T | 2 +- testsuite/tests/ghci/linking/all.T | 2 +- testsuite/tests/ghci/prog001/prog001.T | 3 ++- testsuite/tests/ghci/scripts/all.T | 6 ++++-- testsuite/tests/rts/all.T | 10 +++++++--- 11 files changed, 30 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 1dadd9a91454bb098e9c47d6c034b07e2e1e2529 From git at git.haskell.org Fri Jun 3 20:12:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Jun 2016 20:12:20 +0000 (UTC) Subject: [commit: ghc] master: Use useful names for Symbol Addr and Names in Linker.c (079c1b8) Message-ID: <20160603201220.664FB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/079c1b8caed22db2be24f3304c56db56292670e1/ghc >--------------------------------------------------------------- commit 079c1b8caed22db2be24f3304c56db56292670e1 Author: Tamar Christina Date: Fri Jun 3 21:42:45 2016 +0200 Use useful names for Symbol Addr and Names in Linker.c Replace `char*` and `void*` with `SymbolName` and `SymbolAddr` in `Linker.c`. Gives some useful information about what the variables are used for and also normalizes the types used in Mac, Linux and Windows Test Plan: ./validate on all platforms that use the runtime linker. For unix platforms please ensure `DYNAMIC_GHC_PROGRAMS=NO` is added to your validate file. This is a continuation from D2184 Reviewers: austin, erikd, simonmar, bgamari Reviewed By: bgamari Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2250 GHC Trac Issues: #11816 >--------------------------------------------------------------- 079c1b8caed22db2be24f3304c56db56292670e1 rts/Linker.c | 104 +++++++++++++++++++++++++++---------------------------- rts/RtsSymbols.h | 7 ++-- 2 files changed, 57 insertions(+), 54 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 079c1b8caed22db2be24f3304c56db56292670e1 From git at git.haskell.org Sat Jun 4 07:32:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Jun 2016 07:32:58 +0000 (UTC) Subject: [commit: ghc] master: RTS SMP: Use compiler built-ins on all platforms. (eda73a3) Message-ID: <20160604073258.9D56F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eda73a3ad3fdd98cf877b25c3c984c6e1b2217fc/ghc >--------------------------------------------------------------- commit eda73a3ad3fdd98cf877b25c3c984c6e1b2217fc Author: Peter Trommler Date: Fri Jun 3 22:22:23 2016 +0200 RTS SMP: Use compiler built-ins on all platforms. Use C compiler builtins for atomic SMP primitives. This saves a lot of CPP ifdefs. Add test for atomic xchg: Test if __sync_lock_test_and_set() builtin stores the second argument. The gcc manual says the actual value stored is implementation defined. Test Plan: validate and eyeball generated assembler code Reviewers: kgardas, simonmar, hvr, bgamari, austin, erikd Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2233 >--------------------------------------------------------------- eda73a3ad3fdd98cf877b25c3c984c6e1b2217fc includes/stg/SMP.h | 189 +++------------------- testsuite/tests/rts/all.T | 2 + testsuite/tests/rts/{atomicinc.c => atomicxchg.c} | 8 +- 3 files changed, 27 insertions(+), 172 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 eda73a3ad3fdd98cf877b25c3c984c6e1b2217fc From git at git.haskell.org Sat Jun 4 07:33:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Jun 2016 07:33:01 +0000 (UTC) Subject: [commit: ghc] master: integer-gmp: Make minusInteger more efficient (02f893e) Message-ID: <20160604073301.946953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/02f893eb4fe3f75f0a9dc7e723568f4c75de5785/ghc >--------------------------------------------------------------- commit 02f893eb4fe3f75f0a9dc7e723568f4c75de5785 Author: Alan Mock Date: Fri Jun 3 22:16:27 2016 +0200 integer-gmp: Make minusInteger more efficient Give `minusInteger` its own implementation. Previously `minusInteger` used `plusInteger` and `negateInteger`, which meant it always allocated. Now it works more like `plusInteger`. Reviewers: goldfire, hvr, bgamari, austin Reviewed By: hvr, bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2278 GHC Trac Issues: #12129 >--------------------------------------------------------------- 02f893eb4fe3f75f0a9dc7e723568f4c75de5785 libraries/integer-gmp/changelog.md | 4 +++ libraries/integer-gmp/src/GHC/Integer/Type.hs | 40 ++++++++++++++++++++-- testsuite/tests/lib/integer/all.T | 2 +- testsuite/tests/lib/integer/plusMinusInteger.hs | 36 +++++++++++++++++++ .../tests/lib/integer/plusMinusInteger.stdout | 1 + testsuite/tests/perf/should_run/all.T | 3 +- 6 files changed, 81 insertions(+), 5 deletions(-) diff --git a/libraries/integer-gmp/changelog.md b/libraries/integer-gmp/changelog.md index 5245e23..cdee847 100644 --- a/libraries/integer-gmp/changelog.md +++ b/libraries/integer-gmp/changelog.md @@ -1,5 +1,9 @@ # Changelog for [`integer-gmp` package](http://hackage.haskell.org/package/integer-gmp) +## 1.0.0.2 *TBA* + + * Optimize `minusInteger` + ## 1.0.0.1 *Feb 2016* * Bundled with GHC 8.0.1 diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs index 9ed17fc..6506ebf 100644 --- a/libraries/integer-gmp/src/GHC/Integer/Type.hs +++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs @@ -418,10 +418,44 @@ plusInteger (Jp# x) (Jn# y) GT -> bigNatToInteger (minusBigNat x y) {-# CONSTANT_FOLDED plusInteger #-} --- TODO --- | Subtract two 'Integer's from each other. +-- | Subtract one 'Integer' from another. minusInteger :: Integer -> Integer -> Integer -minusInteger x y = inline plusInteger x (inline negateInteger y) +minusInteger x (S# 0#) = x +minusInteger (S# 0#) (S# INT_MINBOUND#) = Jp# (wordToBigNat ABS_INT_MINBOUND##) +minusInteger (S# 0#) (S# y#) = S# (negateInt# y#) +minusInteger (S# x#) (S# y#) + = case subIntC# x# y# of + (# z#, 0# #) -> S# z# + (# 0#, _ #) -> Jn# (wordToBigNat2 1## 0##) + (# z#, _ #) + | isTrue# (z# ># 0#) -> Jn# (wordToBigNat ( (int2Word# (negateInt# z#)))) + | True -> Jp# (wordToBigNat ( (int2Word# z#))) +minusInteger (S# x#) (Jp# y) + | isTrue# (x# >=# 0#) = bigNatToNegInteger (minusBigNatWord y (int2Word# x#)) + | True = Jn# (plusBigNatWord y (int2Word# (negateInt# x#))) +minusInteger (S# x#) (Jn# y) + | isTrue# (x# >=# 0#) = Jp# (plusBigNatWord y (int2Word# x#)) + | True = bigNatToInteger (minusBigNatWord y (int2Word# + (negateInt# x#))) +minusInteger (Jp# x) (Jp# y) + = case compareBigNat x y of + LT -> bigNatToNegInteger (minusBigNat y x) + EQ -> S# 0# + GT -> bigNatToInteger (minusBigNat x y) +minusInteger (Jp# x) (Jn# y) = Jp# (plusBigNat x y) +minusInteger (Jn# x) (Jp# y) = Jn# (plusBigNat x y) +minusInteger (Jn# x) (Jn# y) + = case compareBigNat x y of + LT -> bigNatToInteger (minusBigNat y x) + EQ -> S# 0# + GT -> bigNatToNegInteger (minusBigNat x y) +minusInteger (Jp# x) (S# y#) + | isTrue# (y# >=# 0#) = bigNatToInteger (minusBigNatWord x (int2Word# y#)) + | True = Jp# (plusBigNatWord x (int2Word# (negateInt# y#))) +minusInteger (Jn# x) (S# y#) + | isTrue# (y# >=# 0#) = Jn# (plusBigNatWord x (int2Word# y#)) + | True = bigNatToNegInteger (minusBigNatWord x + (int2Word# (negateInt# y#))) {-# CONSTANT_FOLDED minusInteger #-} -- | Multiply two 'Integer's diff --git a/testsuite/tests/lib/integer/all.T b/testsuite/tests/lib/integer/all.T index c0b39b0..327f577 100644 --- a/testsuite/tests/lib/integer/all.T +++ b/testsuite/tests/lib/integer/all.T @@ -2,6 +2,7 @@ test('integerBits', normal, compile_and_run, ['']) test('integerConversions', normal, compile_and_run, ['']) # skip ghci as it doesn't support unboxed tuples test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways('ghci')], compile_and_run, ['']) +test('plusMinusInteger', [reqlib('integer-gmp'), omit_ways('ghci')], compile_and_run, ['']) test('integerConstantFolding', [extra_clean(['integerConstantFolding.simpl']), when(compiler_debugged(), expect_broken(11006))], @@ -16,4 +17,3 @@ test('IntegerConversionRules', run_command, ['$MAKE -s --no-print-directory IntegerConversionRules']) test('gcdInteger', normal, compile_and_run, ['']) - diff --git a/testsuite/tests/lib/integer/plusMinusInteger.hs b/testsuite/tests/lib/integer/plusMinusInteger.hs new file mode 100644 index 0000000..ec8d7e6 --- /dev/null +++ b/testsuite/tests/lib/integer/plusMinusInteger.hs @@ -0,0 +1,36 @@ +module Main (main) where + + +main :: IO () +main = do + print $ length vals + + where + boundaries :: [Integer] + boundaries = [fromIntegral (maxBound :: Int) - 3, + fromIntegral (maxBound :: Int) - 2, + fromIntegral (maxBound :: Int) - 1, + fromIntegral (maxBound :: Int), + fromIntegral (maxBound :: Int) + 1, + fromIntegral (maxBound :: Int) + 2, + fromIntegral (maxBound :: Int) + 3, + + fromIntegral (minBound :: Int) - 3, + fromIntegral (minBound :: Int) - 2, + fromIntegral (minBound :: Int) - 1, + fromIntegral (minBound :: Int), + fromIntegral (minBound :: Int) + 1, + fromIntegral (minBound :: Int) + 2, + fromIntegral (minBound :: Int) + 3, + + fromIntegral (maxBound :: Word) - 3, + fromIntegral (maxBound :: Word) - 2, + fromIntegral (maxBound :: Word) - 1, + fromIntegral (maxBound :: Word), + fromIntegral (maxBound :: Word) + 1, + fromIntegral (maxBound :: Word) + 2, + fromIntegral (maxBound :: Word) + 3, + + -3, -2, -1, 0, 1, 2, 3] + vals = filter (\(x, y) -> x /= y) [(x - y, x + negate y) | + x <- boundaries, y <- boundaries] diff --git a/testsuite/tests/lib/integer/plusMinusInteger.stdout b/testsuite/tests/lib/integer/plusMinusInteger.stdout new file mode 100644 index 0000000..c227083 --- /dev/null +++ b/testsuite/tests/lib/integer/plusMinusInteger.stdout @@ -0,0 +1 @@ +0 \ No newline at end of file diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 81a5535..d039f68 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -204,9 +204,10 @@ test('T5549', # expected value: 3362958676 (Windows) # 2014-12-01: 4096606332 (Windows) integer-gmp2 - (wordsize(64), 8193140752, 5)]), + (wordsize(64), 5793140200, 5)]), # expected value: 6725846120 (amd64/Linux) # 8193140752 (amd64/Linux) integer-gmp2 + # 5793140200 (amd64/Linux) integer-gmp2 only_ways(['normal']) ], compile_and_run, From git at git.haskell.org Sat Jun 4 07:33:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Jun 2016 07:33:04 +0000 (UTC) Subject: [commit: ghc] master: PrelInfo: Ensure that tuple promoted datacon names are in knownKeyNames (4aa299d) Message-ID: <20160604073304.4913F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4aa299db6b1025822673713a110b17c002ddcfaf/ghc >--------------------------------------------------------------- commit 4aa299db6b1025822673713a110b17c002ddcfaf Author: Ben Gamari Date: Fri Jun 3 22:19:17 2016 +0200 PrelInfo: Ensure that tuple promoted datacon names are in knownKeyNames Previously the promoted datacons of the boxed tuple types were not included in knownKeyNames, which lead to #12132. Test Plan: Test with included TypeOf testcase Reviewers: austin, simonpj Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2279 GHC Trac Issues: #12132 >--------------------------------------------------------------- 4aa299db6b1025822673713a110b17c002ddcfaf compiler/iface/LoadIface.hs | 2 +- compiler/prelude/PrelInfo.hs | 7 ++++--- testsuite/tests/typecheck/should_run/TypeOf.hs | 1 + testsuite/tests/typecheck/should_run/TypeOf.stdout | 1 + 4 files changed, 7 insertions(+), 4 deletions(-) diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index 64d100f..ba58c9e 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -169,7 +169,7 @@ for any module with an instance decl or RULE that we might want. * BUT, if the TyCon is a wired-in TyCon, we don't really need its interface; but we must make sure we read its interface in case it has instances or - rules. That is what LoadIface.loadWiredInHomeInterface does. It's called + rules. That is what LoadIface.loadWiredInHomeIface does. It's called from TcIface.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing} * HOWEVER, only do this for TyCons. There are no wired-in Classes. There diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs index 74005ed..52493b4 100644 --- a/compiler/prelude/PrelInfo.hs +++ b/compiler/prelude/PrelInfo.hs @@ -85,19 +85,20 @@ knownKeyNames , concatMap tycon_kk_names typeNatTyCons - , concatMap (rep_names . tupleTyCon Boxed) [2..mAX_TUPLE_SIZE] -- Yuk + , concatMap (tycon_kk_names . tupleTyCon Boxed) [2..mAX_TUPLE_SIZE] -- Yuk , cTupleTyConNames -- Constraint tuples are known-key but not wired-in -- They can't show up in source code, but can appear - -- in intreface files + -- in interface files , map idName wiredInIds , map (idName . primOpId) allThePrimOps , basicKnownKeyNames ] where - -- "kk" short for "known-key" + -- All of the names associated with a known-key thing. + -- This includes TyCons, DataCons and promoted TyCons. tycon_kk_names :: TyCon -> [Name] tycon_kk_names tc = tyConName tc : (rep_names tc ++ concatMap thing_kk_names (implicitTyConThings tc)) diff --git a/testsuite/tests/typecheck/should_run/TypeOf.hs b/testsuite/tests/typecheck/should_run/TypeOf.hs index efd26f9..53e0359 100644 --- a/testsuite/tests/typecheck/should_run/TypeOf.hs +++ b/testsuite/tests/typecheck/should_run/TypeOf.hs @@ -31,4 +31,5 @@ main = do print $ typeOf (Proxy :: Proxy *) print $ typeOf (Proxy :: Proxy ?) print $ typeOf (Proxy :: Proxy 'PtrRepLifted) + print $ typeOf (Proxy :: Proxy '(1, "hello")) print $ typeOf (Proxy :: Proxy (~~)) diff --git a/testsuite/tests/typecheck/should_run/TypeOf.stdout b/testsuite/tests/typecheck/should_run/TypeOf.stdout index 6f160f5..3e3396f 100644 --- a/testsuite/tests/typecheck/should_run/TypeOf.stdout +++ b/testsuite/tests/typecheck/should_run/TypeOf.stdout @@ -20,4 +20,5 @@ Proxy Constraint Constraint Proxy Constraint Constraint Proxy Constraint Constraint Proxy RuntimeRep 'PtrRepLifted +Proxy (Nat,Symbol) ('(,) Nat Symbol 1 "hello") Proxy (Constraint -> Constraint -> Constraint) ~~ From git at git.haskell.org Sat Jun 4 07:33:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Jun 2016 07:33:06 +0000 (UTC) Subject: [commit: ghc] master: Rename isPinnedByteArray# to isByteArrayPinned# (4dbacbc) Message-ID: <20160604073306.E8E823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4dbacbc89a999bf371d51194b4662a209ac907f1/ghc >--------------------------------------------------------------- commit 4dbacbc89a999bf371d51194b4662a209ac907f1 Author: Ben Gamari Date: Fri Jun 3 22:22:42 2016 +0200 Rename isPinnedByteArray# to isByteArrayPinned# Reviewers: simonmar, duncan, erikd, austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2290 GHC Trac Issues: #12059 >--------------------------------------------------------------- 4dbacbc89a999bf371d51194b4662a209ac907f1 compiler/prelude/primops.txt.pp | 10 +++++++-- docs/users_guide/8.2.1-notes.rst | 2 +- includes/stg/MiscClosures.h | 3 ++- rts/PrimOps.cmm | 12 ++++++++--- rts/RtsSymbols.c | 3 ++- testsuite/tests/codeGen/should_run/T12059.hs | 27 +++++++++++++++++++++--- testsuite/tests/codeGen/should_run/T12059.stdout | 2 ++ 7 files changed, 48 insertions(+), 11 deletions(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 53bc8a4..bfeb785 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -1077,9 +1077,15 @@ primop NewAlignedPinnedByteArrayOp_Char "newAlignedPinnedByteArray#" GenPrimOp with out_of_line = True has_side_effects = True -primop ByteArrayIsPinnedOp "isPinnedByteArray#" GenPrimOp +primop MutableByteArrayIsPinnedOp "isMutableByteArrayPinned#" GenPrimOp MutableByteArray# s -> Int# - {Determine whether a {\tt MutableByteArray\#} is guaranteed not to move.} + {Determine whether a {\tt MutableByteArray\#} is guaranteed not to move + during GC.} + with out_of_line = True + +primop ByteArrayIsPinnedOp "isByteArrayPinned#" GenPrimOp + ByteArray# -> Int# + {Determine whether a {\tt ByteArray\#} is guaranteed not to move during GC.} with out_of_line = True primop ByteArrayContents_Char "byteArrayContents#" GenPrimOp diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst index 60f17cf..b671f6d 100644 --- a/docs/users_guide/8.2.1-notes.rst +++ b/docs/users_guide/8.2.1-notes.rst @@ -131,7 +131,7 @@ ghc-prim - Version number XXXXX (was 0.3.1.0) -- Added new ``isPinnedbyteArray#`` operation. +- Added new ``isByteArrayPinned#`` and ``isMutableByteArrayPinned#`` operation. haskell98 ~~~~~~~~~ diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index 337f586..731893e 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -347,7 +347,8 @@ RTS_FUN_DECL(stg_casArrayzh); RTS_FUN_DECL(stg_newByteArrayzh); RTS_FUN_DECL(stg_newPinnedByteArrayzh); RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh); -RTS_FUN_DECL(stg_isPinnedByteArrayzh); +RTS_FUN_DECL(stg_isByteArrayPinnedzh); +RTS_FUN_DECL(stg_isMutableByteArrayPinnedzh); RTS_FUN_DECL(stg_shrinkMutableByteArrayzh); RTS_FUN_DECL(stg_resizzeMutableByteArrayzh); RTS_FUN_DECL(stg_casIntArrayzh); diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index a8e2a1b..160bccd 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -141,17 +141,23 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment ) return (p); } -stg_isPinnedByteArrayzh ( gcptr mba ) -// MutableByteArray# s -> Int# +stg_isByteArrayPinnedzh ( gcptr ba ) +// ByteArray# s -> Int# { W_ bd, flags; - bd = Bdescr(mba); + bd = Bdescr(ba); // pinned byte arrays live in blocks with the BF_PINNED flag set. // See the comment in Storage.c:allocatePinned. flags = TO_W_(bdescr_flags(bd)); return (flags & BF_PINNED != 0); } +stg_isMutableByteArrayPinnedzh ( gcptr mba ) +// MutableByteArray# s -> Int# +{ + jump stg_isByteArrayPinnedzh(mba); +} + // shrink size of MutableByteArray in-place stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size ) // MutableByteArray# s -> Int# -> State# s -> State# s diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c index f420c01..e66b4d8 100644 --- a/rts/RtsSymbols.c +++ b/rts/RtsSymbols.c @@ -514,7 +514,8 @@ SymI_HasProto(stg_casMutVarzh) \ SymI_HasProto(stg_newPinnedByteArrayzh) \ SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \ - SymI_HasProto(stg_isPinnedByteArrayzh) \ + SymI_HasProto(stg_isByteArrayPinnedzh) \ + SymI_HasProto(stg_isMutableByteArrayPinnedzh) \ SymI_HasProto(stg_shrinkMutableByteArrayzh) \ SymI_HasProto(stg_resizzeMutableByteArrayzh) \ SymI_HasProto(newSpark) \ diff --git a/testsuite/tests/codeGen/should_run/T12059.hs b/testsuite/tests/codeGen/should_run/T12059.hs index 0b99bd3..3d815fc 100644 --- a/testsuite/tests/codeGen/should_run/T12059.hs +++ b/testsuite/tests/codeGen/should_run/T12059.hs @@ -8,20 +8,41 @@ import GHC.IO main :: IO () main = do + -- Unpinned MutableByteArray r <- IO $ \s0 -> case newByteArray# 1024# s0 of (# s1, mba #) -> - (# s1, isTrue# (isPinnedByteArray# mba) #) + (# s1, isTrue# (isMutableByteArrayPinned# mba) #) print r + -- Pinned MutableByteArray r <- IO $ \s0 -> case newPinnedByteArray# 1024# s0 of (# s1, mba #) -> - (# s1, isTrue# (isPinnedByteArray# mba) #) + (# s1, isTrue# (isMutableByteArrayPinned# mba) #) print r + -- Pinned, Aligned MutableByteArray r <- IO $ \s0 -> case newAlignedPinnedByteArray# 1024# 16# s0 of (# s1, mba #) -> - (# s1, isTrue# (isPinnedByteArray# mba) #) + (# s1, isTrue# (isMutableByteArrayPinned# mba) #) + print r + + -- Unpinned ByteArray + r <- IO $ \s0 -> + case newByteArray# 1024# s0 of + (# s1, mba #) -> + case unsafeFreezeByteArray# mba s1 of + (# s2, ba #) -> + (# s2, isTrue# (isByteArrayPinned# ba) #) + print r + + -- Pinned ByteArray + r <- IO $ \s0 -> + case newPinnedByteArray# 1024# s0 of + (# s1, mba #) -> + case unsafeFreezeByteArray# mba s1 of + (# s2, ba #) -> + (# s2, isTrue# (isByteArrayPinned# ba) #) print r diff --git a/testsuite/tests/codeGen/should_run/T12059.stdout b/testsuite/tests/codeGen/should_run/T12059.stdout index 70cea9e..8a39f7a 100644 --- a/testsuite/tests/codeGen/should_run/T12059.stdout +++ b/testsuite/tests/codeGen/should_run/T12059.stdout @@ -1,3 +1,5 @@ False True True +False +True \ No newline at end of file From git at git.haskell.org Sat Jun 4 07:35:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Jun 2016 07:35:51 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: rel-notes: Fix Trac reference (4a55457) Message-ID: <20160604073551.68FAB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/4a55457d16eea654c892ccb474fd319744f7fb7b/ghc >--------------------------------------------------------------- commit 4a55457d16eea654c892ccb474fd319744f7fb7b Author: Ben Gamari Date: Sat May 21 20:56:32 2016 +0200 rel-notes: Fix Trac reference >--------------------------------------------------------------- 4a55457d16eea654c892ccb474fd319744f7fb7b docs/users_guide/8.0.1-notes.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/8.0.1-notes.rst b/docs/users_guide/8.0.1-notes.rst index 6e552be..3035e77 100644 --- a/docs/users_guide/8.0.1-notes.rst +++ b/docs/users_guide/8.0.1-notes.rst @@ -200,7 +200,7 @@ Language explicit export list in ``Bar``. - GHC has grown a :ghc-flag:`-XUndecidableSuperClasses` language extension, - which relaxes GHC's recursive superclass check (see :ghc-ticket:`11318`). + which relaxes GHC's recursive superclass check (see :ghc-ticket:`10318`). This allows class definitions which have mutually recursive superclass constraints at the expense of potential non-termination in the solver. From git at git.haskell.org Sat Jun 4 07:35:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Jun 2016 07:35:54 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: PrelInfo: Ensure that tuple promoted datacon names are in knownKeyNames (f7b6adc) Message-ID: <20160604073554.110793A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/f7b6adccec14cd4d8d4854e01b9f78b80f533b4d/ghc >--------------------------------------------------------------- commit f7b6adccec14cd4d8d4854e01b9f78b80f533b4d Author: Ben Gamari Date: Fri Jun 3 22:19:17 2016 +0200 PrelInfo: Ensure that tuple promoted datacon names are in knownKeyNames Previously the promoted datacons of the boxed tuple types were not included in knownKeyNames, which lead to #12132. Test Plan: Test with included TypeOf testcase Reviewers: austin, simonpj Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2279 GHC Trac Issues: #12132 (cherry picked from commit 4aa299db6b1025822673713a110b17c002ddcfaf) >--------------------------------------------------------------- f7b6adccec14cd4d8d4854e01b9f78b80f533b4d compiler/iface/LoadIface.hs | 2 +- compiler/prelude/PrelInfo.hs | 7 ++++--- testsuite/tests/typecheck/should_run/TypeOf.hs | 1 + testsuite/tests/typecheck/should_run/TypeOf.stdout | 1 + 4 files changed, 7 insertions(+), 4 deletions(-) diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index 32c7b22..26e0539 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -169,7 +169,7 @@ for any module with an instance decl or RULE that we might want. * BUT, if the TyCon is a wired-in TyCon, we don't really need its interface; but we must make sure we read its interface in case it has instances or - rules. That is what LoadIface.loadWiredInHomeInterface does. It's called + rules. That is what LoadIface.loadWiredInHomeIface does. It's called from TcIface.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing} * HOWEVER, only do this for TyCons. There are no wired-in Classes. There diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs index 74005ed..52493b4 100644 --- a/compiler/prelude/PrelInfo.hs +++ b/compiler/prelude/PrelInfo.hs @@ -85,19 +85,20 @@ knownKeyNames , concatMap tycon_kk_names typeNatTyCons - , concatMap (rep_names . tupleTyCon Boxed) [2..mAX_TUPLE_SIZE] -- Yuk + , concatMap (tycon_kk_names . tupleTyCon Boxed) [2..mAX_TUPLE_SIZE] -- Yuk , cTupleTyConNames -- Constraint tuples are known-key but not wired-in -- They can't show up in source code, but can appear - -- in intreface files + -- in interface files , map idName wiredInIds , map (idName . primOpId) allThePrimOps , basicKnownKeyNames ] where - -- "kk" short for "known-key" + -- All of the names associated with a known-key thing. + -- This includes TyCons, DataCons and promoted TyCons. tycon_kk_names :: TyCon -> [Name] tycon_kk_names tc = tyConName tc : (rep_names tc ++ concatMap thing_kk_names (implicitTyConThings tc)) diff --git a/testsuite/tests/typecheck/should_run/TypeOf.hs b/testsuite/tests/typecheck/should_run/TypeOf.hs index efd26f9..53e0359 100644 --- a/testsuite/tests/typecheck/should_run/TypeOf.hs +++ b/testsuite/tests/typecheck/should_run/TypeOf.hs @@ -31,4 +31,5 @@ main = do print $ typeOf (Proxy :: Proxy *) print $ typeOf (Proxy :: Proxy ?) print $ typeOf (Proxy :: Proxy 'PtrRepLifted) + print $ typeOf (Proxy :: Proxy '(1, "hello")) print $ typeOf (Proxy :: Proxy (~~)) diff --git a/testsuite/tests/typecheck/should_run/TypeOf.stdout b/testsuite/tests/typecheck/should_run/TypeOf.stdout index 6f160f5..3e3396f 100644 --- a/testsuite/tests/typecheck/should_run/TypeOf.stdout +++ b/testsuite/tests/typecheck/should_run/TypeOf.stdout @@ -20,4 +20,5 @@ Proxy Constraint Constraint Proxy Constraint Constraint Proxy Constraint Constraint Proxy RuntimeRep 'PtrRepLifted +Proxy (Nat,Symbol) ('(,) Nat Symbol 1 "hello") Proxy (Constraint -> Constraint -> Constraint) ~~ From git at git.haskell.org Sat Jun 4 15:04:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Jun 2016 15:04:47 +0000 (UTC) Subject: [commit: ghc] master: Refactor the SymbolName and SymbolAddr types to be pointers (b948a1d) Message-ID: <20160604150447.8DCC13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b948a1da7a3929160cb7cb8d6cf2fe79c3081d0a/ghc >--------------------------------------------------------------- commit b948a1da7a3929160cb7cb8d6cf2fe79c3081d0a Author: Tamar Christina Date: Sat Jun 4 13:07:32 2016 +0200 Refactor the SymbolName and SymbolAddr types to be pointers Take the pointer notation out of the typedef such that it preserves the fact that these are pointers at the use site. Test Plan: ./validate on all platforms that use the runtime linker. For unix platforms please ensure `DYNAMIC_GHC_PROGRAMS=NO` is added to your validate file. Continuation of D2250 Reviewers: austin, bgamari, simonmar, erikd Reviewed By: erikd Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2302 GHC Trac Issues: #11816 >--------------------------------------------------------------- b948a1da7a3929160cb7cb8d6cf2fe79c3081d0a rts/Linker.c | 90 ++++++++++++++++++++++++++++---------------------------- rts/RtsSymbols.h | 8 ++--- 2 files changed, 49 insertions(+), 49 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b948a1da7a3929160cb7cb8d6cf2fe79c3081d0a From git at git.haskell.org Sat Jun 4 21:56:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Jun 2016 21:56:26 +0000 (UTC) Subject: [commit: ghc] master: Replace hand-written Bounded instances with derived ones (5965117) Message-ID: <20160604215626.A46A43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/59651173a52e2400f965e38acd0beb9d0cc14cfe/ghc >--------------------------------------------------------------- commit 59651173a52e2400f965e38acd0beb9d0cc14cfe Author: Ryan Scott Date: Sat Jun 4 17:59:47 2016 -0400 Replace hand-written Bounded instances with derived ones Summary: The spiritual successor to D2291, since deriving `Bounded` instances in `GHC.Enum` wasn't possible prior to changes made in that Diff. This Diff finds every manually implemented `Bounded` instance in `base` that is completely equivalent to the derived instances, and replaces it. Reviewers: bgamari, goldfire, austin, hvr Reviewed By: austin, hvr Subscribers: thomie, rwbarton Differential Revision: https://phabricator.haskell.org/D2301 >--------------------------------------------------------------- 59651173a52e2400f965e38acd0beb9d0cc14cfe libraries/base/Data/Proxy.hs | 6 +- libraries/base/Data/Semigroup.hs | 30 ++----- libraries/base/Data/Type/Coercion.hs | 4 +- libraries/base/Data/Type/Equality.hs | 4 +- libraries/base/GHC/Enum.hs | 150 ++++++++++++----------------------- 5 files changed, 58 insertions(+), 136 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 59651173a52e2400f965e38acd0beb9d0cc14cfe From git at git.haskell.org Sun Jun 5 08:46:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Jun 2016 08:46:38 +0000 (UTC) Subject: [commit: ghc] master: Add relocation type R_X86_64_REX_GOTPCRELX (0d963ca) Message-ID: <20160605084638.8852B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0d963caf40da4391028a3beb95b5082c87985e7d/ghc >--------------------------------------------------------------- commit 0d963caf40da4391028a3beb95b5082c87985e7d Author: Tamar Christina Date: Sun Jun 5 09:59:05 2016 +0200 Add relocation type R_X86_64_REX_GOTPCRELX Summary: Adding support for the `R_X86_64_REX_GOTPCRELX` relocation type. This relocation is treated by the linker the same as the `R_X86_64_GOTPCRELX` type `G + GOT + A - P` to generate relative offsets to the GOT. The `REX` prefix has no influence in this stage. This is based on https://github.com/hjl-tools/x86-psABI/wiki/x86-64-psABI-r252.pdf Test Plan: ./validate Reviewers: erikd, austin, bgamari, simonmar Reviewed By: erikd Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2303 GHC Trac Issues: #12147 >--------------------------------------------------------------- 0d963caf40da4391028a3beb95b5082c87985e7d rts/Linker.c | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/rts/Linker.c b/rts/Linker.c index 5a6a8c2..a1f72e5 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -5681,7 +5681,13 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, *(Elf64_Sword *)P = (Elf64_Sword)value; #endif break; - +/* These two relocations were introduced in glibc 2.23 and binutils 2.26. + But in order to use them the system which compiles the bindist for GHC needs + to have glibc >= 2.23. So only use them if they're defined. */ +#if defined(R_X86_64_REX_GOTPCRELX) && defined(R_X86_64_GOTPCRELX) + case R_X86_64_REX_GOTPCRELX: + case R_X86_64_GOTPCRELX: +#endif case R_X86_64_GOTPCREL: { StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr; From git at git.haskell.org Sun Jun 5 11:51:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Jun 2016 11:51:38 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: fixup comments for T9872d [skip ci] (4848ab9) Message-ID: <20160605115138.92C543A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4848ab9ce3c4491935888d405412d451294b74ee/ghc >--------------------------------------------------------------- commit 4848ab9ce3c4491935888d405412d451294b74ee Author: Thomas Miedema Date: Sun Jun 5 13:29:34 2016 +0200 Testsuite: fixup comments for T9872d [skip ci] Resolve confusion resulting from: * 6746549772c5cc0ac66c0fce562f297f4d4b80a2 (typo in 64 + 32 bit numbers) * ae86eb9f72fa7220fe47ac54d6d21395691c1308 (corrects 64 bit number) * 1a8d61ca1a54820d2bc30c6a964312faf76d0635 (corrects 32 bit number) >--------------------------------------------------------------- 4848ab9ce3c4491935888d405412d451294b74ee testsuite/tests/perf/compiler/all.T | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index a39e6fa..7435a33 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -742,13 +742,13 @@ test('T9872d', # 2014-12-18 739189056 Reduce type families even more eagerly # 2015-01-07 687562440 TrieMap leaf compression # 2015-03-17 726679784 tweak to solver; probably flattens more + # 2015-12-11 566134504 TypeInType; see #11196 # 2016-02-08 534693648 Improved a bit by tyConRolesRepresentational # 2016-03-18 506691240 optimize Unify & zonking (wordsize(32), 264566040, 5) # some date 328810212 # 2015-07-11 350369584 - # 2015-12-11 566134504 TypeInType; see #11196 - # 2016-04-06 264566040 x86/Linux, no idea, opened #11800 + # 2016-04-06 264566040 x86/Linux ]), ], compile, From git at git.haskell.org Sun Jun 5 18:23:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Jun 2016 18:23:04 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T5642' created Message-ID: <20160605182304.4206E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T5642 Referencing: 5bfbdf4ce91a66a79d86a0a89e8f9077cc9b2de6 From git at git.haskell.org Sun Jun 5 18:23:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Jun 2016 18:23:06 +0000 (UTC) Subject: [commit: ghc] wip/T5642: Refactor derived Generic instances to reduce allocations (5bfbdf4) Message-ID: <20160605182306.EDD933A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T5642 Link : http://ghc.haskell.org/trac/ghc/changeset/5bfbdf4ce91a66a79d86a0a89e8f9077cc9b2de6/ghc >--------------------------------------------------------------- commit 5bfbdf4ce91a66a79d86a0a89e8f9077cc9b2de6 Author: Ryan Scott Date: Sun Jun 5 14:24:27 2016 -0400 Refactor derived Generic instances to reduce allocations Summary: Previously, derived implementations of `to`/`from` in `Generic` instances were wastefully putting extra `M1`s in every case, which led to an O(n) increase in the number of coercions, resulting in a slowdown during the typechecker phase. This factors out the common `M1` in every case of a `to`/`from` definition so that the typechecker has far fewer coercions to deal with. For a datatype with 300 constructors, this change has been observed to save almost 3 seconds of compilation time. This is one step towards coming up with a solution for #5642. Test Plan: ./validate Reviewers: simonpj, hvr, bgamari, austin Subscribers: basvandijk, carter, thomie, osa1 Differential Revision: https://phabricator.haskell.org/D2304 GHC Trac Issues: #5642 >--------------------------------------------------------------- 5bfbdf4ce91a66a79d86a0a89e8f9077cc9b2de6 compiler/typecheck/TcGenGenerics.hs | 83 ++++- testsuite/tests/generics/GenDerivOutput.stderr | 144 ++++---- testsuite/tests/generics/GenDerivOutput1_0.stderr | 35 +- testsuite/tests/generics/GenDerivOutput1_1.stderr | 264 +++++++------- .../tests/generics/T10604/T10604_deriving.stderr | 253 +++++++------ testsuite/tests/perf/compiler/T5642.hs | 402 +++++++++++---------- 6 files changed, 646 insertions(+), 535 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 5bfbdf4ce91a66a79d86a0a89e8f9077cc9b2de6 From git at git.haskell.org Sun Jun 5 18:38:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Jun 2016 18:38:34 +0000 (UTC) Subject: [commit: ghc] branch 'ghc-quick3' created Message-ID: <20160605183834.5E8923A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : ghc-quick3 Referencing: f91d87df889fb612183b8f2d42b29d2edd7c1dbc From git at git.haskell.org Sun Jun 5 18:38:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Jun 2016 18:38:37 +0000 (UTC) Subject: [commit: ghc] ghc-quick3: Better comment for orIfNotFound. (886f4c1) Message-ID: <20160605183837.0EBE63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-quick3 Link : http://ghc.haskell.org/trac/ghc/changeset/886f4c1b1c8ad5b850d3703a48d92975ed615627/ghc >--------------------------------------------------------------- commit 886f4c1b1c8ad5b850d3703a48d92975ed615627 Author: Edward Z. Yang Date: Mon May 16 11:31:12 2016 -0700 Better comment for orIfNotFound. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 886f4c1b1c8ad5b850d3703a48d92975ed615627 compiler/main/Finder.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/compiler/main/Finder.hs b/compiler/main/Finder.hs index e11480c..446cdf8 100644 --- a/compiler/main/Finder.hs +++ b/compiler/main/Finder.hs @@ -141,7 +141,11 @@ findExactModule hsc_env mod = -- ----------------------------------------------------------------------------- -- Helpers -orIfNotFound :: IO FindResult -> IO FindResult -> IO FindResult +-- | Given a monadic actions @this@ and @or_this@, first execute +-- @this at . If the returned 'FindResult' is successful, return +-- it; otherwise, execute @or_this at . If both failed, this function +-- also combines their failure messages in a reasonable way. +orIfNotFound :: Monad m => m FindResult -> m FindResult -> m FindResult orIfNotFound this or_this = do res <- this case res of From git at git.haskell.org Sun Jun 5 18:38:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Jun 2016 18:38:40 +0000 (UTC) Subject: [commit: ghc] ghc-quick3: Failing test-case for #12135. (f91d87d) Message-ID: <20160605183840.2C2B53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-quick3 Link : http://ghc.haskell.org/trac/ghc/changeset/f91d87df889fb612183b8f2d42b29d2edd7c1dbc/ghc >--------------------------------------------------------------- commit f91d87df889fb612183b8f2d42b29d2edd7c1dbc Author: Edward Z. Yang Date: Sun Jun 5 11:40:35 2016 -0700 Failing test-case for #12135. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- f91d87df889fb612183b8f2d42b29d2edd7c1dbc testsuite/.gitignore | 3 +++ testsuite/tests/driver/Makefile | 11 +++++++++++ testsuite/tests/driver/T12135.hs | 3 +++ testsuite/tests/driver/T12135.stdout | 4 ++++ testsuite/tests/driver/T12135a.h | 1 + testsuite/tests/driver/T12135b.h | 1 + testsuite/tests/driver/all.T | 6 ++++++ 7 files changed, 29 insertions(+) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index e1f1822..87e3558 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -572,6 +572,9 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/driver/T8602/t8602.sh /tests/driver/T9562/Main /tests/driver/T11763 +/tests/driver/T12135 +/tests/driver/T12135a +/tests/driver/T12135b /tests/driver/Test.081b /tests/driver/Test.081b.hs /tests/driver/Test_081a diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile index 51fb71a..41a1891 100644 --- a/testsuite/tests/driver/Makefile +++ b/testsuite/tests/driver/Makefile @@ -621,3 +621,14 @@ T10320: [ -s T10320.dump-rule-rewrites ] "$(TEST_HC)" $(TEST_HC_OPTS) -ddump-to-file -ddump-rule-rewrites T10320.hs [ -f T10320.dump-rule-rewrites ] && [ ! -s T10320.dump-rule-rewrites ] + +.PHONY: T12135 +T12135: + $(RM) -rf T12135.o T12135.hi T12135 T12135a T12135b + mkdir T12135a T12135b + cp T12135a.h T12135a/T12135.h + "$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) -IT12135b -IT12135a --make T12135.hs + ./T12135 + cp T12135b.h T12135b/T12135.h + "$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) -IT12135b -IT12135a --make T12135.hs + ./T12135 diff --git a/testsuite/tests/driver/T12135.hs b/testsuite/tests/driver/T12135.hs new file mode 100644 index 0000000..f6ea19d --- /dev/null +++ b/testsuite/tests/driver/T12135.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE CPP #-} +#include "T12135.h" +main = print message diff --git a/testsuite/tests/driver/T12135.stdout b/testsuite/tests/driver/T12135.stdout new file mode 100644 index 0000000..8da4f15 --- /dev/null +++ b/testsuite/tests/driver/T12135.stdout @@ -0,0 +1,4 @@ +[1 of 1] Compiling Main ( T12135.hs, T12135.o ) +Linking T12135 ... +1 +2 diff --git a/testsuite/tests/driver/T12135a.h b/testsuite/tests/driver/T12135a.h new file mode 100644 index 0000000..3603079 --- /dev/null +++ b/testsuite/tests/driver/T12135a.h @@ -0,0 +1 @@ +message = 1 diff --git a/testsuite/tests/driver/T12135b.h b/testsuite/tests/driver/T12135b.h new file mode 100644 index 0000000..cefcf6b --- /dev/null +++ b/testsuite/tests/driver/T12135b.h @@ -0,0 +1 @@ +message = 2 diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 1adf482..54c84bc 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -482,3 +482,9 @@ test('T10320', , extra_clean(['T10320', 'T10320.o', 'T10320.hi'])], run_command, ['$MAKE -s --no-print-directory T10320']) + +test('T12135', + [expect_broken(12135), + extra_clean(['T12135.o', 'T12135.hi', 'T12135', 'T12135a/T12135.h', 'T12135b/T12135.h'])], + run_command, + ['$MAKE -s --no-print-directory T12135']) From git at git.haskell.org Sun Jun 5 18:38:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Jun 2016 18:38:59 +0000 (UTC) Subject: [commit: ghc] master's head updated: Failing test-case for #12135. (f91d87d) Message-ID: <20160605183859.672913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'master' now includes: 886f4c1 Better comment for orIfNotFound. f91d87d Failing test-case for #12135. From git at git.haskell.org Sun Jun 5 20:17:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 5 Jun 2016 20:17:11 +0000 (UTC) Subject: [commit: ghc] wip/T5642: Update expected allocations for perf tests (c2d5736) Message-ID: <20160605201711.3E2BD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T5642 Link : http://ghc.haskell.org/trac/ghc/changeset/c2d573669331d2a53308a9a97fdcedbe62583121/ghc >--------------------------------------------------------------- commit c2d573669331d2a53308a9a97fdcedbe62583121 Author: Ryan Scott Date: Sun Jun 5 16:18:00 2016 -0400 Update expected allocations for perf tests >--------------------------------------------------------------- c2d573669331d2a53308a9a97fdcedbe62583121 testsuite/tests/perf/compiler/all.T | 5 +++-- testsuite/tests/perf/haddock/all.T | 3 ++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 7435a33..2cd628b 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -545,7 +545,7 @@ test('T5642', # 2014-12-10: 641085256 Improvements in constraints solver # 2016-04-06: 462677300 - (wordsize(64), 1300685592, 10)]) + (wordsize(64), 916484672, 10)]) # prev: 1300000000 # 2014-07-17: 1358833928 (general round of updates) # 2014-08-07: 1402242360 (caused by 1fc60ea) @@ -558,8 +558,9 @@ test('T5642', # 2014-12-10: 1282916024 Improvements in constraints solver # 2015-10-28: 1412808976 Emit Typeable at definition site # 2015-11-22: 1071915072 Use TypeLits in the metadata encoding - # 2016-02-08: 950004816 Pattern match checker re-rework + # 2016-02-08: 950004816 Pattern match checker re-rework # 2016-05-12: 1300685592 Make Generic1 poly-kinded + # 2016-06-05: 916484672 Refactor derived Generic instances to reduce allocations ], compile,['-O']) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index b4600d4..f239981 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -52,7 +52,7 @@ test('haddock.base', test('haddock.Cabal', [unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 11805238152, 5) + [(wordsize(64), 10997887320, 5) # 2012-08-14: 3255435248 (amd64/Linux) # 2012-08-29: 3324606664 (amd64/Linux, new codegen) # 2012-10-08: 3373401360 (amd64/Linux) @@ -81,6 +81,7 @@ test('haddock.Cabal', # 2016-04-06: 11542374816 (amd64/Linux) - CSE improvements and others # 2016-04-07: 10963514352 (amd64/Linux) - Revert to what phabricator claims # 2016-05-22: 11805238152 (amd64/Linux) - Make Generic1 poly-kinded + # 2016-06-05: 10997887320 (amd64/Linux) - Refactor derived Generic instances to reduce allocations ,(platform('i386-unknown-mingw32'), 3293415576, 5) # 2012-10-30: 1733638168 (x86/Windows) From git at git.haskell.org Mon Jun 6 11:01:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:01:55 +0000 (UTC) Subject: [commit: ghc] master: Use UniqDFM for HomePackageTable (3042a9d) Message-ID: <20160606110155.67ED73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3042a9d8d55b4706d2ce366fee1712c7357d5a00/ghc >--------------------------------------------------------------- commit 3042a9d8d55b4706d2ce366fee1712c7357d5a00 Author: Bartosz Nitka Date: Mon Jun 6 02:10:07 2016 -0700 Use UniqDFM for HomePackageTable This isn't strictly necessary for deterministic ABIs. The results of eltsHpt are consumed in two ways: 1) they determine the order of linking 2) if you track the data flow all the family instances get put in FamInstEnvs, so the nondeterministic order is forgotten. 3) same for VectInfo stuff 4) same for Annotations The problem is that I haven't found a nice way to do 2. in a local way and 1. is nice to have if we went for deterministic object files. Besides these maps are keyed on ModuleNames so they should be small relative to other things and the overhead should be negligible. As a bonus we also get more specific names. Test Plan: ./validate Reviewers: bgamari, austin, hvr, ezyang, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2300 GHC Trac Issues: #4012 >--------------------------------------------------------------- 3042a9d8d55b4706d2ce366fee1712c7357d5a00 compiler/basicTypes/Module.hs | 8 ++++++- compiler/ghci/Linker.hs | 3 +-- compiler/iface/TcIface.hs | 2 +- compiler/main/DriverPipeline.hs | 3 +-- compiler/main/GHC.hs | 9 ++++---- compiler/main/GhcMake.hs | 35 ++++++++++++++-------------- compiler/main/HscTypes.hs | 50 +++++++++++++++++++++++++++++++++------- compiler/main/InteractiveEval.hs | 19 +++++++-------- compiler/typecheck/FamInst.hs | 3 +-- compiler/utils/UniqDFM.hs | 21 +++++++++++++++-- 10 files changed, 104 insertions(+), 49 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3042a9d8d55b4706d2ce366fee1712c7357d5a00 From git at git.haskell.org Mon Jun 6 11:11:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:11:32 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: HACK: CoreLint: Kill unsaturated unlifted types check (809a3bf) Message-ID: <20160606111132.763763A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/809a3bfab38f63a9a6a5a62de5a1482ed2f6abf2/ghc >--------------------------------------------------------------- commit 809a3bfab38f63a9a6a5a62de5a1482ed2f6abf2 Author: Ben Gamari Date: Sat Jan 30 19:53:05 2016 +0100 HACK: CoreLint: Kill unsaturated unlifted types check >--------------------------------------------------------------- 809a3bfab38f63a9a6a5a62de5a1482ed2f6abf2 compiler/coreSyn/CoreLint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 0261f7e..3db70882 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1084,7 +1084,7 @@ lintType ty@(TyConApp tc tys) = lintType ty' -- Expand type synonyms, so that we do not bogusly complain -- about un-saturated type synonyms - | isUnliftedTyCon tc || isTypeSynonymTyCon tc || isTypeFamilyTyCon tc + | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc -- Also type synonyms and type families , length tys < tyConArity tc = failWithL (hang (text "Un-saturated type application") 2 (ppr ty)) From git at git.haskell.org Mon Jun 6 11:11:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:11:35 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcSMonad: Introduce tcLookupId (1333b6a) Message-ID: <20160606111135.1D3F63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/1333b6a7551090c04e335b810d72baf8f96d48cb/ghc >--------------------------------------------------------------- commit 1333b6a7551090c04e335b810d72baf8f96d48cb Author: Ben Gamari Date: Sun Jan 31 17:42:57 2016 +0100 TcSMonad: Introduce tcLookupId >--------------------------------------------------------------- 1333b6a7551090c04e335b810d72baf8f96d48cb compiler/typecheck/TcSMonad.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 7354139..7ba915a 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -43,7 +43,7 @@ module TcSMonad ( getTopEnv, getGblEnv, getLclEnv, getTcEvBinds, getTcEvBindsFromVar, getTcLevel, getTcEvBindsMap, - tcLookupClass, + tcLookupClass, tcLookupId, -- Inerts InertSet(..), InertCans(..), @@ -122,7 +122,7 @@ import FamInstEnv import qualified TcRnMonad as TcM import qualified TcMType as TcM import qualified TcEnv as TcM - ( checkWellStaged, topIdLvl, tcGetDefaultTys, tcLookupClass ) + ( checkWellStaged, topIdLvl, tcGetDefaultTys, tcLookupClass, tcLookupId ) import Kind import TcType import DynFlags @@ -2727,6 +2727,9 @@ getLclEnv = wrapTcS $ TcM.getLclEnv tcLookupClass :: Name -> TcS Class tcLookupClass c = wrapTcS $ TcM.tcLookupClass c +tcLookupId :: Name -> TcS Id +tcLookupId n = wrapTcS $ TcM.tcLookupId n + -- Setting names as used (used in the deriving of Coercible evidence) -- Too hackish to expose it to TcS? In that case somehow extract the used -- constructors from the result of solveInteract From git at git.haskell.org Mon Jun 6 11:11:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:11:37 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: CoreLint: Improve debug output (84b0f2e) Message-ID: <20160606111137.BA0D03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/84b0f2e00cba19063d77e1691e15e064477420cb/ghc >--------------------------------------------------------------- commit 84b0f2e00cba19063d77e1691e15e064477420cb Author: Ben Gamari Date: Sun Jan 31 21:35:20 2016 +0100 CoreLint: Improve debug output >--------------------------------------------------------------- 84b0f2e00cba19063d77e1691e15e064477420cb compiler/coreSyn/CoreLint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 3db70882..b7ddfdd 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -860,7 +860,7 @@ lintTyKind tyvar arg_ty -- and then apply it to both boxed and unboxed types. = do { arg_kind <- lintType arg_ty ; unless (arg_kind `eqType` tyvar_kind) - (addErrL (mkKindErrMsg tyvar arg_ty $$ (text "xx" <+> ppr arg_kind))) } + (addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind))) } where tyvar_kind = tyVarKind tyvar From git at git.haskell.org Mon Jun 6 11:11:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:11:40 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Outputable: Refactor handling of CallStacks (1b87cad) Message-ID: <20160606111140.6CF9F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/1b87cad5fd64b600f26f7df785ce9b4ca27b2290/ghc >--------------------------------------------------------------- commit 1b87cad5fd64b600f26f7df785ce9b4ca27b2290 Author: Ben Gamari Date: Sun Jan 31 20:29:18 2016 +0100 Outputable: Refactor handling of CallStacks Provide callstacks in more places and consolidate handling >--------------------------------------------------------------- 1b87cad5fd64b600f26f7df785ce9b4ca27b2290 compiler/utils/Outputable.hs | 39 +++++++++++++++++++++++++++++---------- 1 file changed, 29 insertions(+), 10 deletions(-) diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index d61b1ec..06f1055 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -1,4 +1,7 @@ -{-# LANGUAGE CPP, ImplicitParams #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ConstraintKinds #-} {- (c) The University of Glasgow 2006-2012 (c) The GRASP Project, Glasgow University, 1992-1998 @@ -79,6 +82,9 @@ module Outputable ( pprTrace, pprTraceIt, warnPprTrace, pprSTrace, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, + + -- * Re-exported + HasCallStack, ) where import {-# SOURCE #-} DynFlags( DynFlags, @@ -116,8 +122,9 @@ import Data.Graph (SCC(..)) import GHC.Fingerprint import GHC.Show ( showMultiLineString ) +import GHC.Exts (Constraint) #if __GLASGOW_HASKELL__ > 710 -import GHC.Stack +import GHC.Exception (CallStack, prettyCallStackLines) #endif {- @@ -1066,9 +1073,21 @@ doOrDoes _ = text "do" ************************************************************************ -} -pprPanic :: String -> SDoc -> a +#if __GLASGOW_HASKELL__ > 710 +type HasCallStack = ((?callStack :: CallStack) :: Constraint) + +pprCallStack :: (?callStack :: CallStack) => SDoc +pprCallStack = vcat $ map text $ prettyCallStackLines ?callStack +#else +type HasCallStack = (() :: Constraint) + +pprCallStack :: SDoc +pprCallStack = empty +#endif + +pprPanic :: HasCallStack => String -> SDoc -> a -- ^ Throw an exception saying "bug in GHC" -pprPanic = panicDoc +pprPanic msg doc = panicDoc msg (pprCallStack $$ doc) pprSorry :: String -> SDoc -> a -- ^ Throw an exception saying "this isn't finished yet" @@ -1094,11 +1113,11 @@ pprTraceIt desc x = pprTrace desc (ppr x) x -- | If debug output is on, show some 'SDoc' on the screen along -- with a call stack when available. #if __GLASGOW_HASKELL__ > 710 -pprSTrace :: (?callStack :: CallStack) => SDoc -> a -> a -pprSTrace = pprTrace (prettyCallStack ?callStack) +pprSTrace :: HasCallStack => String -> SDoc -> a -> a +pprSTrace msg doc = pprTrace msg (pprCallStack $$ doc) #else -pprSTrace :: SDoc -> a -> a -pprSTrace = pprTrace "no callstack info" +pprSTrace :: String -> SDoc -> a -> a +pprSTrace msg doc = pprTrace msg (text "no callstack info" $$ doc) #endif warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a @@ -1115,11 +1134,11 @@ warnPprTrace True file line msg x -- | Panic with an assertation failure, recording the given file and -- line number. Should typically be accessed with the ASSERT family of macros #if __GLASGOW_HASKELL__ > 710 -assertPprPanic :: (?callStack :: CallStack) => String -> Int -> SDoc -> a +assertPprPanic :: HasCallStack => String -> Int -> SDoc -> a assertPprPanic _file _line msg = pprPanic "ASSERT failed!" doc where - doc = sep [ text (prettyCallStack ?callStack) + doc = sep [ pprCallStack , msg ] #else assertPprPanic :: String -> Int -> SDoc -> a From git at git.haskell.org Mon Jun 6 11:11:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:11:43 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcInteract: Unused parameter (6e10f55) Message-ID: <20160606111143.2500E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/6e10f55dfa2f530141118d03a89cca0704d005a8/ghc >--------------------------------------------------------------- commit 6e10f55dfa2f530141118d03a89cca0704d005a8 Author: Ben Gamari Date: Wed Mar 16 11:04:54 2016 +0100 TcInteract: Unused parameter >--------------------------------------------------------------- 6e10f55dfa2f530141118d03a89cca0704d005a8 compiler/typecheck/TcInteract.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 45ab157..37d6a13 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -2020,7 +2020,7 @@ matchTypeable clas [k,t] -- clas = Typeable | t `eqType` liftedTypeKind = doPrimRep trTYPE'PtrRepLiftedName t | t `eqType` runtimeRepTy = doPrimRep trRuntimeRepName t | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)] - , onlyNamedBndrsApplied tc ks = doTyConApp clas t tc ks + , onlyNamedBndrsApplied tc ks = doTyConApp clas t tc | Just (arg,ret) <- splitFunTy_maybe t = doFunTy clas t arg ret | Just (f,kt) <- splitAppTy_maybe t = doTyApp clas t f kt @@ -2055,8 +2055,8 @@ doPrimRep rep_name ty -- kind variables have been instantiated). -- -- TODO: Do we want to encode the applied kinds in the representation? -doTyConApp :: Class -> Type -> TyCon -> [Kind] -> TcS LookupInstResult -doTyConApp clas ty tc ks +doTyConApp :: Class -> Type -> TyCon -> TcS LookupInstResult +doTyConApp clas ty tc = return $ GenInst [mk_typeable_pred clas $ typeKind ty] (\[ev] -> EvTypeable ty $ EvTypeableTyCon tc ev) True From git at git.haskell.org Mon Jun 6 11:11:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:11:45 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Binary: More explicit pattern matching (12cd07d) Message-ID: <20160606111145.C7A4D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/12cd07d5bb664ad63b0333a6679cebd64f1f0acd/ghc >--------------------------------------------------------------- commit 12cd07d5bb664ad63b0333a6679cebd64f1f0acd Author: Ben Gamari Date: Wed Mar 16 09:40:54 2016 +0100 Binary: More explicit pattern matching >--------------------------------------------------------------- 12cd07d5bb664ad63b0333a6679cebd64f1f0acd compiler/utils/Binary.hs | 9 ++++++--- libraries/ghci/GHCi/TH/Binary.hs | 9 ++++++--- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index fcf9ce7..431b187 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -601,9 +601,12 @@ getTypeRepX bh = do 1 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh case typeRepKind f of - TRFun arg _ | Just HRefl <- arg `eqTypeRep` x -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" + TRFun arg _ -> + case arg `eqTypeRep` x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "Binary: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 9a4d314..7ecc746 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -105,9 +105,12 @@ getTypeRepX = do 1 -> do TypeRepX f <- getTypeRepX TypeRepX x <- getTypeRepX case typeRepKind f of - TRFun arg _ | Just HRefl <- arg `eqTypeRep` x -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" + TRFun arg _ -> + case arg `eqTypeRep` x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "getTypeRepX: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where From git at git.haskell.org Mon Jun 6 11:11:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:11:48 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix rebase (6b173f2) Message-ID: <20160606111148.9C4633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/6b173f25053de3a61186ab638cd7934523a64a6b/ghc >--------------------------------------------------------------- commit 6b173f25053de3a61186ab638cd7934523a64a6b Author: Ben Gamari Date: Fri Mar 11 17:23:30 2016 +0100 Fix rebase >--------------------------------------------------------------- 6b173f25053de3a61186ab638cd7934523a64a6b compiler/prelude/PrelNames.hs | 38 +++++++++++++-------------- compiler/typecheck/TcInteract.hs | 14 +++++----- libraries/base/Data/Typeable/Internal.hs | 44 ++++++++++++++++---------------- 3 files changed, 48 insertions(+), 48 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 6b173f25053de3a61186ab638cd7934523a64a6b From git at git.haskell.org Mon Jun 6 11:11:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:11:51 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Implement Data.Typeable.funResultTy (33eb10c) Message-ID: <20160606111151.5CA263A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/33eb10cb597d3e59b38d62702d8334be073ded9f/ghc >--------------------------------------------------------------- commit 33eb10cb597d3e59b38d62702d8334be073ded9f Author: Ben Gamari Date: Tue Mar 15 16:21:58 2016 +0100 Implement Data.Typeable.funResultTy >--------------------------------------------------------------- 33eb10cb597d3e59b38d62702d8334be073ded9f libraries/base/Data/Typeable.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index 486c5b8..7718cf3 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -69,6 +69,9 @@ module Data.Typeable , rnfTypeRep , showsTypeRep + -- * Observing type representations + , funResultTy + -- * Type constructors , I.TyCon -- abstract, instance of: Eq, Show, Typeable -- For now don't export Module to avoid name clashes @@ -147,6 +150,18 @@ gcast2 x = fmap (\Refl -> x) (eqT :: Maybe (t :~: t')) typeRepTyCon :: TypeRep -> TyCon typeRepTyCon = I.typeRepXTyCon +-- | Applies a type to a function type. Returns: @Just u@ if the first argument +-- represents a function of type @t -> u@ and the second argument represents a +-- function of type @t at . Otherwise, returns @Nothing at . +funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep +funResultTy (I.TypeRepX f) (I.TypeRepX x) + | Just HRefl <- (I.typeRep :: I.TypeRep Type) `I.eqTypeRep` I.typeRepKind f + , I.TRFun arg res <- f + , Just HRefl <- arg `I.eqTypeRep` x + = Just (I.TypeRepX res) + | otherwise + = Nothing + -- | Force a 'TypeRep' to normal form. rnfTypeRep :: TypeRep -> () rnfTypeRep = I.rnfTypeRepX From git at git.haskell.org Mon Jun 6 11:11:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:11:54 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix warnings (5803a58) Message-ID: <20160606111154.081393A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/5803a58b62b22fe59c4b6ad7b6771849fd07b79c/ghc >--------------------------------------------------------------- commit 5803a58b62b22fe59c4b6ad7b6771849fd07b79c Author: Ben Gamari Date: Fri Mar 11 17:51:26 2016 +0100 Fix warnings >--------------------------------------------------------------- 5803a58b62b22fe59c4b6ad7b6771849fd07b79c libraries/base/Data/Typeable/Internal.hs | 17 ++++++++++++----- libraries/ghc-boot/GHC/Serialized.hs | 1 - 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 6704154..7a3344e 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -68,7 +68,7 @@ module Data.Typeable.Internal ( -- * Construction -- | These are for internal use only - mkTrCon, mkTrApp, mkTyCon, + mkTrCon, mkTrApp, mkTyCon, mkTyCon#, typeSymbolTypeRep, typeNatTypeRep, -- * Representations for primitive types @@ -220,6 +220,7 @@ mkTrCon tc kind = TrTyCon fpr tc kind fpr = fingerprintFingerprints [fpr_tc, fpr_k] -- | Construct a representation for a type application. +-- TODO: Is this necessary? mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). TypeRep (a :: k1 -> k2) -> TypeRep (b :: k1) @@ -250,7 +251,7 @@ pattern TRCon con <- TrTyCon _ con _ -- | Splits a type application. splitApp :: TypeRep a -> Maybe (AppResult a) -splitApp (TrTyCon _ a _) = Nothing +splitApp (TrTyCon _ _ _) = Nothing splitApp (TrApp _ f x) = Just $ App f x ----------------- Observation --------------------- @@ -259,7 +260,9 @@ typeRepKind :: forall k (a :: k). TypeRep a -> TypeRep k typeRepKind (TrTyCon _ _ k) = k typeRepKind (TrApp _ f _) = case typeRepKind f of - TRFun arg res -> res + TRFun _arg res -> res + -- TODO: why is this case needed? + _ -> error "typeRepKind: impossible" -- | Observe the type constructor of a quantified type representation. typeRepXTyCon :: TypeRepX -> TyCon @@ -316,13 +319,16 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t ----------------- Showing TypeReps -------------------- instance Show (TypeRep a) where - showsPrec p (TrTyCon _ tycon _) = shows tycon - showsPrec p (TrApp _ f x) = shows f . showString " " . shows x + showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon + showsPrec p (TrApp _ f x) = showsPrec p f . showString " " . showsPrec p x + -- TODO: Reconsider precedence instance Show TypeRepX where showsPrec p (TypeRepX ty) = showsPrec p ty -- Some (Show.TypeRepX) helpers: +{- +-- FIXME: Handle tuples, etc. showArgs :: Show a => ShowS -> [a] -> ShowS showArgs _ [] = id showArgs _ [a] = showsPrec 10 a @@ -332,6 +338,7 @@ showTuple :: [TypeRepX] -> ShowS showTuple args = showChar '(' . showArgs (showChar ',') args . showChar ')' +-} -- | Helper to fully evaluate 'TypeRep' for use as @NFData(rnf)@ implementation -- diff --git a/libraries/ghc-boot/GHC/Serialized.hs b/libraries/ghc-boot/GHC/Serialized.hs index 7f86df9..8653049 100644 --- a/libraries/ghc-boot/GHC/Serialized.hs +++ b/libraries/ghc-boot/GHC/Serialized.hs @@ -22,7 +22,6 @@ module GHC.Serialized ( import Data.Bits import Data.Word ( Word8 ) import Data.Data -import Data.Typeable -- | Represents a serialized value of a particular type. Attempts can be made to deserialize it at certain types From git at git.haskell.org Mon Jun 6 11:11:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:11:56 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: More serialization (3b2ed2e) Message-ID: <20160606111156.AC96B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/3b2ed2e20c40f634be5afc31df99bac6fe6ed6b7/ghc >--------------------------------------------------------------- commit 3b2ed2e20c40f634be5afc31df99bac6fe6ed6b7 Author: Ben Gamari Date: Wed Mar 16 10:33:37 2016 +0100 More serialization >--------------------------------------------------------------- 3b2ed2e20c40f634be5afc31df99bac6fe6ed6b7 compiler/utils/Binary.hs | 14 +++++++++----- libraries/base/Data/Typeable.hs | 20 +++++++++++++------- libraries/ghci/GHCi/TH/Binary.hs | 13 ++++++++----- 3 files changed, 30 insertions(+), 17 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 431b187..2dd2182 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -587,12 +587,13 @@ putTypeRep bh (TRApp f x) = do put_ bh (1 :: Word8) putTypeRep bh f putTypeRep bh x +putTypeRep _ _ = fail "putTypeRep: Impossible" getTypeRepX :: BinHandle -> IO TypeRepX getTypeRepX bh = do tag <- get bh :: IO Word8 case tag of - 0 -> do con <- get bh + 0 -> do con <- get bh :: IO TyCon TypeRepX rep_k <- getTypeRepX bh case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k @@ -602,10 +603,13 @@ getTypeRepX bh = do TypeRepX x <- getTypeRepX bh case typeRepKind f of TRFun arg _ -> - case arg `eqTypeRep` x of - Just HRefl -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" + case (typeRep :: TypeRep Type) `eqTypeRep` arg of + Just HRefl -> -- FIXME: Generalize (->) + case x `eqTypeRep` arg of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + Nothing -> fail "getTypeRepX: Arrow of non-Type argument" _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "Binary: Invalid TypeRepX" diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index 7718cf3..21f93d2 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -154,13 +154,19 @@ typeRepTyCon = I.typeRepXTyCon -- represents a function of type @t -> u@ and the second argument represents a -- function of type @t at . Otherwise, returns @Nothing at . funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep -funResultTy (I.TypeRepX f) (I.TypeRepX x) - | Just HRefl <- (I.typeRep :: I.TypeRep Type) `I.eqTypeRep` I.typeRepKind f - , I.TRFun arg res <- f - , Just HRefl <- arg `I.eqTypeRep` x - = Just (I.TypeRepX res) - | otherwise - = Nothing +{- +funResultTy (I.TypeRepX f) (I.TypeRepX x) = + case (I.typeRep :: I.TypeRep Type) `I.eqTypeRep` I.typeRepKind f of + Just HRefl -> + case f of + I.TRFun arg res -> + case arg `I.eqTypeRep` x of + Just HRefl -> Just (I.TypeRepX res) + Nothing -> Nothing + _ -> Nothing + Nothing -> Nothing +-} +funResultTy _ _ = Nothing -- | Force a 'TypeRep' to normal form. rnfTypeRep :: TypeRep -> () diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 7ecc746..8d297a1 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -11,7 +11,6 @@ module GHCi.TH.Binary () where import Data.Binary import qualified Data.ByteString as B #if MIN_VERSION_base(4,9,0) -import Control.Monad (when) import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) @@ -91,6 +90,7 @@ putTypeRep (TRApp f x) = do put (1 :: Word8) putTypeRep f putTypeRep x +putTypeRep _ = fail "putTypeRep: Impossible" getTypeRepX :: Get TypeRepX getTypeRepX = do @@ -106,10 +106,13 @@ getTypeRepX = do TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> - case arg `eqTypeRep` x of - Just HRefl -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" + case (typeRep :: TypeRep Type) `eqTypeRep` arg of + Just HRefl -> -- FIXME: Generalize (->) + case arg `eqTypeRep` x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + _ -> fail "getTypeRepX: Arrow of non-Type argument" _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "getTypeRepX: Invalid TypeRepX" From git at git.haskell.org Mon Jun 6 11:11:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:11:59 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Message: Import Data.Typeable.TypeRep (e897633) Message-ID: <20160606111159.5D6CE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/e897633edd31b7ce72077fd02ff8e0485ce1418c/ghc >--------------------------------------------------------------- commit e897633edd31b7ce72077fd02ff8e0485ce1418c Author: Ben Gamari Date: Wed Mar 16 10:35:59 2016 +0100 Message: Import Data.Typeable.TypeRep >--------------------------------------------------------------- e897633edd31b7ce72077fd02ff8e0485ce1418c libraries/ghci/GHCi/Message.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index b8f9fcc..4bc8d2c 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving, +{-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving, CPP, GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-} @@ -29,6 +29,10 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import Data.Dynamic +#if MIN_VERSION_base(4,9,0) +-- Previously this was re-exported by Data.Dynamic +import Data.Typeable (TypeRep) +#endif import Data.IORef import Data.Map (Map) import GHC.Generics From git at git.haskell.org Mon Jun 6 11:12:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:02 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Add quick compatibility note (4c99c66) Message-ID: <20160606111202.09CB03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/4c99c66e2e38f2a50ba4c98a75c2a60bed587d29/ghc >--------------------------------------------------------------- commit 4c99c66e2e38f2a50ba4c98a75c2a60bed587d29 Author: Ben Gamari Date: Fri Mar 11 17:32:13 2016 +0100 Add quick compatibility note >--------------------------------------------------------------- 4c99c66e2e38f2a50ba4c98a75c2a60bed587d29 libraries/base/Data/Typeable.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index f33ac48..486c5b8 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -28,6 +28,11 @@ -- -- == Compatibility Notes -- +-- Since GHC 8.2, GHC has supported type-indexed type representations. +-- "Data.Typeable" provides type representations which are qualified over this +-- index, providing an interface very similar to the "Typeable" notion seen in +-- previous releases. For the type-indexed interface, see "Data.Reflection". +-- -- Since GHC 7.8, 'Typeable' is poly-kinded. The changes required for this might -- break some old programs involving 'Typeable'. More details on this, including -- how to fix your code, can be found on the From git at git.haskell.org Mon Jun 6 11:12:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:05 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Start implementing library side of TTypeable (4b0ee4e) Message-ID: <20160606111205.4C9033A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/4b0ee4e41b6946cc97b7976b2300179c15bac250/ghc >--------------------------------------------------------------- commit 4b0ee4e41b6946cc97b7976b2300179c15bac250 Author: Ben Gamari Date: Sat Jan 30 00:04:54 2016 +0100 Start implementing library side of TTypeable >--------------------------------------------------------------- 4b0ee4e41b6946cc97b7976b2300179c15bac250 compiler/deSugar/DsBinds.hs | 79 +++-- compiler/prelude/PrelNames.hs | 72 +++-- compiler/typecheck/TcEvidence.hs | 20 +- compiler/typecheck/TcHsSyn.hs | 8 +- compiler/typecheck/TcInteract.hs | 58 +++- compiler/utils/Binary.hs | 55 +++- libraries/Win32 | 2 +- libraries/array | 2 +- libraries/base/Data/Dynamic.hs | 51 +-- libraries/base/Data/Type/Equality.hs | 6 + libraries/base/Data/Typeable.hs | 192 ++++++++---- libraries/base/Data/Typeable/Internal.hs | 518 +++++++++++++++++-------------- libraries/base/GHC/Conc/Sync.hs | 4 - libraries/base/GHC/Show.hs | 2 +- libraries/base/Type/Reflection.hs | 43 +++ libraries/base/Type/Reflection/Unsafe.hs | 20 ++ libraries/base/base.cabal | 4 +- libraries/binary | 2 +- libraries/bytestring | 2 +- libraries/deepseq | 2 +- libraries/directory | 2 +- libraries/ghc-boot/GHC/Serialized.hs | 16 +- libraries/ghc-prim/GHC/Types.hs | 15 +- libraries/ghci/GHCi/TH/Binary.hs | 57 ++++ libraries/haskeline | 2 +- libraries/hpc | 2 +- libraries/pretty | 2 +- libraries/time | 2 +- libraries/unix | 2 +- nofib | 2 +- utils/haddock | 2 +- utils/hsc2hs | 2 +- 32 files changed, 806 insertions(+), 442 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 4b0ee4e41b6946cc97b7976b2300179c15bac250 From git at git.haskell.org Mon Jun 6 11:12:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:07 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Various fixes (2dd3c5e) Message-ID: <20160606111207.EFDBB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/2dd3c5e50f66bcbff4bb9e647716640668b5db21/ghc >--------------------------------------------------------------- commit 2dd3c5e50f66bcbff4bb9e647716640668b5db21 Author: Ben Gamari Date: Fri Mar 11 19:16:55 2016 +0100 Various fixes >--------------------------------------------------------------- 2dd3c5e50f66bcbff4bb9e647716640668b5db21 compiler/utils/Binary.hs | 6 +++--- libraries/ghci/GHCi/TH/Binary.hs | 14 +++++++------- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index bd9b585..c8f1d44 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -81,7 +81,7 @@ import Data.Time #if MIN_VERSION_base(4,9,0) import Type.Reflection import Type.Reflection.Unsafe -import GHC.Exts ( TYPE, Levity(..) ) +import Data.Kind (Type) #else import Data.Typeable #endif @@ -594,7 +594,7 @@ getTypeRepX bh = do case tag of 0 -> do con <- get bh TypeRepX rep_k <- getTypeRepX bh - Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep (TYPE 'Lifted)) + Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep Type) pure $ TypeRepX $ mkTrCon con rep_k 1 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh @@ -608,7 +608,7 @@ instance Typeable a => Binary (TypeRep (a :: k)) where put_ = putTypeRep get bh = do TypeRepX rep <- getTypeRepX bh - case rep `eqTypeRep` typeRep of + case rep `eqTypeRep` (typeRep :: TypeRep a) of Just HRefl -> pure rep Nothing -> fail "Binary: Type mismatch" diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 7851e33..2a8432b 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -14,10 +14,10 @@ import qualified Data.ByteString as B import Control.Monad (when) import Type.Reflection import Type.Reflection.Unsafe +import Data.Kind (Type) #else import Data.Typeable #endif -import GHC.Exts (TYPE, Levity(..)) import GHC.Serialized import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH @@ -97,11 +97,11 @@ getTypeRepX = do tag <- get :: Get Word8 case tag of 0 -> do con <- get :: Get TyCon - TypeRep rep_k <- getTypeRepX - Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep (TYPE 'Lifted)) + TypeRepX rep_k <- getTypeRepX + Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep Type) pure $ TypeRepX $ mkTrCon con rep_k - 1 -> do TypeRep f <- getTypeRepX - TypeRep x <- getTypeRepX + 1 -> do TypeRepX f <- getTypeRepX + TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> do Just HRefl <- pure $ eqTypeRep arg x @@ -112,13 +112,13 @@ instance Typeable a => Binary (TypeRep (a :: k)) where put = putTypeRep get = do TypeRepX rep <- getTypeRepX - case rep `eqTypeRep` typeRef of + case rep `eqTypeRep` (typeRep :: TypeRep a) of Just HRefl -> pure rep Nothing -> fail "Binary: Type mismatch" instance Binary TypeRepX where put (TypeRepX rep) = putTypeRep rep - get = getTypeRep + get = getTypeRepX #else instance Binary TyCon where put tc = put (tyConPackage tc) >> put (tyConModule tc) >> put (tyConName tc) From git at git.haskell.org Mon Jun 6 11:12:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:10 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix serialization (f8a4d5d) Message-ID: <20160606111210.9FC8A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/f8a4d5d7c52948d885d12ad7a3be9eac393a6fed/ghc >--------------------------------------------------------------- commit f8a4d5d7c52948d885d12ad7a3be9eac393a6fed Author: Ben Gamari Date: Fri Mar 11 19:23:16 2016 +0100 Fix serialization >--------------------------------------------------------------- f8a4d5d7c52948d885d12ad7a3be9eac393a6fed compiler/utils/Binary.hs | 12 +++++++----- libraries/ghci/GHCi/TH/Binary.hs | 14 ++++++++------ 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index c8f1d44..fcf9ce7 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -594,14 +594,16 @@ getTypeRepX bh = do case tag of 0 -> do con <- get bh TypeRepX rep_k <- getTypeRepX bh - Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep Type) - pure $ TypeRepX $ mkTrCon con rep_k + case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of + Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k + Nothing -> fail "getTypeRepX: Kind mismatch" + 1 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh case typeRepKind f of - TRFun arg _ -> do - Just HRefl <- pure $ eqTypeRep arg x - pure $ TypeRepX $ mkTrApp f x + TRFun arg _ | Just HRefl <- arg `eqTypeRep` x -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" _ -> fail "Binary: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 2a8432b..9a4d314 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -98,15 +98,17 @@ getTypeRepX = do case tag of 0 -> do con <- get :: Get TyCon TypeRepX rep_k <- getTypeRepX - Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep Type) - pure $ TypeRepX $ mkTrCon con rep_k + case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of + Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k + Nothing -> fail "getTypeRepX: Kind mismatch" + 1 -> do TypeRepX f <- getTypeRepX TypeRepX x <- getTypeRepX case typeRepKind f of - TRFun arg _ -> do - Just HRefl <- pure $ eqTypeRep arg x - pure $ TypeRepX $ mkTrApp f x - _ -> fail "Binary: Invalid TTypeRep" + TRFun arg _ | Just HRefl <- arg `eqTypeRep` x -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + _ -> fail "getTypeRepX: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where put = putTypeRep From git at git.haskell.org Mon Jun 6 11:12:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:13 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Internal things (f60679d) Message-ID: <20160606111213.5B56C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/f60679d65090671e2eff62a20cf5c5ed6a6f45ed/ghc >--------------------------------------------------------------- commit f60679d65090671e2eff62a20cf5c5ed6a6f45ed Author: Ben Gamari Date: Wed Mar 16 17:51:27 2016 +0100 Internal things >--------------------------------------------------------------- f60679d65090671e2eff62a20cf5c5ed6a6f45ed libraries/base/Data/Typeable/Internal.hs | 35 ++++++++++++++++++++++++++------ libraries/base/Type/Reflection.hs | 1 + 2 files changed, 30 insertions(+), 6 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 3b84aba..dd66283 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -71,6 +71,8 @@ module Data.Typeable.Internal ( mkTrCon, mkTrApp, mkTyCon, mkTyCon#, typeSymbolTypeRep, typeNatTypeRep, + debugShow, + -- * Representations for primitive types trTYPE, trTYPE'PtrRepLifted, @@ -317,6 +319,22 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t ----------------- Showing TypeReps -------------------- +debugShow :: TypeRep a -> String +debugShow rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = "Type" + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = "RuntimeRep" + | (tc, _) <- splitApps rep + , isArrowTyCon tc = "Arrow" +debugShow (TrApp _ f x) = "App ("++debugShow f++") ("++debugShow x++")" +debugShow (TrTyCon _ x k) + | isArrowTyCon x = "Arrow" + | "->" <- show x = "Arrow #" ++ show ( tyConFingerprint x + , tyConFingerprint trArrowTyCon + , tyConFingerprint $ typeRepTyCon (typeRep :: TypeRep (->)) + , typeRepTyCon (typeRep :: TypeRep (->)) + ) + | otherwise = show x++" :: "++debugShow k + instance Show (TypeRep (a :: k)) where showsPrec _ rep | isListTyCon tc, [ty] <- tys = @@ -325,16 +343,18 @@ instance Show (TypeRep (a :: k)) where showChar '(' . showArgs (showChar ',') tys . showChar ')' where (tc, tys) = splitApps rep showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon + showsPrec _ (TrApp _ (TrTyCon _ tycon _) x) + | isArrowTyCon tycon = + shows x . showString " ->" + showsPrec p (TrApp _ f x) - | Just HRefl <- f `eqTypeRep` (typeRep :: TypeRep (->)) = - shows x . showString " -> " | otherwise = - showsPrec p f . space . showParen need_parens (showsPrec 10 x) + showParen (p > 9) $ + showsPrec p f . + space . + showsPrec 9 x where space = showChar ' ' - need_parens = case x of - TrApp {} -> True - TrTyCon {} -> False instance Show TypeRepX where showsPrec p (TypeRepX ty) = showsPrec p ty @@ -346,6 +366,9 @@ splitApps = go [] go xs (TrTyCon _ tc _) = (tc, xs) go xs (TrApp _ f x) = go (TypeRepX x : xs) f +isArrowTyCon :: TyCon -> Bool +isArrowTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep (->)) + isListTyCon :: TyCon -> Bool isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [Int]) diff --git a/libraries/base/Type/Reflection.hs b/libraries/base/Type/Reflection.hs index 8057a2e..480e148 100644 --- a/libraries/base/Type/Reflection.hs +++ b/libraries/base/Type/Reflection.hs @@ -37,6 +37,7 @@ module Type.Reflection , I.tyConModule , I.tyConName , I.rnfTyCon + , I.debugShow ) where import qualified Data.Typeable.Internal as I From git at git.haskell.org Mon Jun 6 11:12:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:16 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcTypeable: Don't generate bindings for special primitive tycons (3a56be1) Message-ID: <20160606111216.095023A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/3a56be1dd3491c7035cd6e8b0971705ae0908d00/ghc >--------------------------------------------------------------- commit 3a56be1dd3491c7035cd6e8b0971705ae0908d00 Author: Ben Gamari Date: Wed Mar 16 15:34:03 2016 +0100 TcTypeable: Don't generate bindings for special primitive tycons >--------------------------------------------------------------- 3a56be1dd3491c7035cd6e8b0971705ae0908d00 compiler/typecheck/TcTypeable.hs | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index 04d07d1..cb79e08 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -13,7 +13,8 @@ import IfaceEnv( newGlobalBinder ) import TcEnv import TcRnMonad import PrelNames -import TysPrim ( primTyCons ) +import TysPrim ( primTyCons, tYPETyConName, funTyConName ) +import TysWiredIn ( runtimeRepTyCon ) import Id import Type import TyCon @@ -21,6 +22,7 @@ import DataCon import Name( getOccName ) import OccName import Module +import NameSet import HsSyn import DynFlags import Bag @@ -166,6 +168,17 @@ mkTypeableTyConBinds tycons ; gbl_env <- tcExtendGlobalValEnv tycon_rep_ids getGblEnv ; return (gbl_env `addTypecheckedBinds` tc_binds) } +-- | The names of the 'TyCon's which we handle explicitly in "Data.Typeable.Internal" +-- and should not generate bindings for in "GHC.Types". +-- +-- See Note [Mutually recursive representations of primitive types] +specialPrimTyCons :: NameSet +specialPrimTyCons = mkNameSet + [ tYPETyConName + , tyConName runtimeRepTyCon + , funTyConName + ] + -- | Generate bindings for the type representation of a wired-in TyCon defined -- by the virtual "GHC.Prim" module. This is where we inject the representation -- bindings for primitive types into "GHC.Types" @@ -209,7 +222,9 @@ ghcPrimTypeableBinds stuff where all_prim_tys :: [TyCon] all_prim_tys = [ tc' | tc <- funTyCon : primTyCons - , tc' <- tc : tyConATs tc ] + , tc' <- tc : tyConATs tc + , not $ tyConName tc' `elemNameSet` specialPrimTyCons + ] mkBind :: TyCon -> LHsBinds Id mkBind = mk_typeable_binds stuff From git at git.haskell.org Mon Jun 6 11:12:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:18 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Kill debugShow (c3dc056) Message-ID: <20160606111218.AFF573A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/c3dc056a5da32f550d56d5619bd82527a504d015/ghc >--------------------------------------------------------------- commit c3dc056a5da32f550d56d5619bd82527a504d015 Author: Ben Gamari Date: Wed Mar 16 22:08:49 2016 +0100 Kill debugShow >--------------------------------------------------------------- c3dc056a5da32f550d56d5619bd82527a504d015 libraries/base/Data/Typeable/Internal.hs | 18 ------------------ libraries/base/Type/Reflection.hs | 1 - 2 files changed, 19 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 7a2e914..09db187 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -71,8 +71,6 @@ module Data.Typeable.Internal ( mkTrCon, mkTrApp, mkTyCon, mkTyCon#, typeSymbolTypeRep, typeNatTypeRep, - debugShow, - -- * Representations for primitive types trTYPE, trTYPE'PtrRepLifted, @@ -319,22 +317,6 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t ----------------- Showing TypeReps -------------------- -debugShow :: TypeRep a -> String -debugShow rep - | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = "Type" - | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = "RuntimeRep" - | (tc, _) <- splitApps rep - , isArrowTyCon tc = "Arrow" -debugShow (TrApp _ f x) = "App ("++debugShow f++") ("++debugShow x++")" -debugShow (TrTyCon _ x k) - | isArrowTyCon x = "Arrow" - | "->" <- show x = "Arrow #" ++ show ( tyConFingerprint x - , tyConFingerprint trArrowTyCon - , tyConFingerprint $ typeRepTyCon (typeRep :: TypeRep (->)) - , typeRepTyCon (typeRep :: TypeRep (->)) - ) - | otherwise = show x++" :: "++debugShow k - instance Show (TypeRep (a :: k)) where showsPrec _ rep | isListTyCon tc, [ty] <- tys = diff --git a/libraries/base/Type/Reflection.hs b/libraries/base/Type/Reflection.hs index 480e148..8057a2e 100644 --- a/libraries/base/Type/Reflection.hs +++ b/libraries/base/Type/Reflection.hs @@ -37,7 +37,6 @@ module Type.Reflection , I.tyConModule , I.tyConName , I.rnfTyCon - , I.debugShow ) where import qualified Data.Typeable.Internal as I From git at git.haskell.org Mon Jun 6 11:12:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:21 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Kill todo (8801237) Message-ID: <20160606111221.5F8873A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/88012374c21915ccadc707dc8c77ca74f951e200/ghc >--------------------------------------------------------------- commit 88012374c21915ccadc707dc8c77ca74f951e200 Author: Ben Gamari Date: Wed Mar 16 13:36:24 2016 +0100 Kill todo >--------------------------------------------------------------- 88012374c21915ccadc707dc8c77ca74f951e200 libraries/base/Data/Typeable/Internal.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index bb2bcc2..2252634 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -261,8 +261,7 @@ typeRepKind (TrTyCon _ _ k) = k typeRepKind (TrApp _ f _) = case typeRepKind f of TRFun _arg res -> res - -- TODO: why is this case needed? - _ -> error "typeRepKind: impossible" + _ -> error "typeRepKind: impossible" -- | Observe the type constructor of a quantified type representation. typeRepXTyCon :: TypeRepX -> TyCon From git at git.haskell.org Mon Jun 6 11:12:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:24 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Move special tycons (afb34f3) Message-ID: <20160606111224.119983A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/afb34f311035e1dc24c2658558b7fa4a3c913f1e/ghc >--------------------------------------------------------------- commit afb34f311035e1dc24c2658558b7fa4a3c913f1e Author: Ben Gamari Date: Wed Mar 16 17:51:01 2016 +0100 Move special tycons >--------------------------------------------------------------- afb34f311035e1dc24c2658558b7fa4a3c913f1e compiler/prelude/TysPrim.hs | 16 +++++++++++++++- compiler/typecheck/TcTypeable.hs | 18 +++--------------- 2 files changed, 18 insertions(+), 16 deletions(-) diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index 1850e55..657ec08 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -27,6 +27,7 @@ module TysPrim( funTyCon, funTyConName, primTyCons, + primTypeableTyCons, charPrimTyCon, charPrimTy, intPrimTyCon, intPrimTy, @@ -76,7 +77,7 @@ module TysPrim( #include "HsVersions.h" import {-# SOURCE #-} TysWiredIn - ( runtimeRepTy, liftedTypeKind + ( runtimeRepTyCon, runtimeRepTy, liftedTypeKind , vecRepDataConTyCon, ptrRepUnliftedDataConTyCon , voidRepDataConTy, intRepDataConTy , wordRepDataConTy, int64RepDataConTy, word64RepDataConTy, addrRepDataConTy @@ -90,6 +91,7 @@ import {-# SOURCE #-} TysWiredIn import Var ( TyVar, KindVar, mkTyVar ) import Name +import NameEnv import TyCon import SrcLoc import Unique @@ -151,6 +153,18 @@ primTyCons #include "primop-vector-tycons.hs-incl" ] +-- | The names of the 'TyCon's which we define 'Typeable' bindings for +-- explicitly in "Data.Typeable.Internal" +-- and should not generate bindings for in "GHC.Types". +-- +-- See Note [Mutually recursive representations of primitive types] +primTypeableTyCons :: NameEnv TyConRepName +primTypeableTyCons = mkNameEnv + [ (tYPETyConName, trTYPEName) + , (tyConName runtimeRepTyCon, trRuntimeRepName) + , (funTyConName, trArrowName) + ] + mkPrimTc :: FastString -> Unique -> TyCon -> Name mkPrimTc fs unique tycon = mkWiredInName gHC_PRIM (mkTcOccFS fs) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index cb79e08..061d22f 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -13,8 +13,7 @@ import IfaceEnv( newGlobalBinder ) import TcEnv import TcRnMonad import PrelNames -import TysPrim ( primTyCons, tYPETyConName, funTyConName ) -import TysWiredIn ( runtimeRepTyCon ) +import TysPrim ( primTyCons, primTypeableTyCons ) import Id import Type import TyCon @@ -22,7 +21,7 @@ import DataCon import Name( getOccName ) import OccName import Module -import NameSet +import NameEnv import HsSyn import DynFlags import Bag @@ -168,17 +167,6 @@ mkTypeableTyConBinds tycons ; gbl_env <- tcExtendGlobalValEnv tycon_rep_ids getGblEnv ; return (gbl_env `addTypecheckedBinds` tc_binds) } --- | The names of the 'TyCon's which we handle explicitly in "Data.Typeable.Internal" --- and should not generate bindings for in "GHC.Types". --- --- See Note [Mutually recursive representations of primitive types] -specialPrimTyCons :: NameSet -specialPrimTyCons = mkNameSet - [ tYPETyConName - , tyConName runtimeRepTyCon - , funTyConName - ] - -- | Generate bindings for the type representation of a wired-in TyCon defined -- by the virtual "GHC.Prim" module. This is where we inject the representation -- bindings for primitive types into "GHC.Types" @@ -223,7 +211,7 @@ ghcPrimTypeableBinds stuff all_prim_tys :: [TyCon] all_prim_tys = [ tc' | tc <- funTyCon : primTyCons , tc' <- tc : tyConATs tc - , not $ tyConName tc' `elemNameSet` specialPrimTyCons + , not $ tyConName tc' `elemNameEnv` primTypeableTyCons ] mkBind :: TyCon -> LHsBinds Id From git at git.haskell.org Mon Jun 6 11:12:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:26 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix primitive types (b347d60) Message-ID: <20160606111226.B1BD63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/b347d60cbff5a5cc24477e6f273900952e8fce0e/ghc >--------------------------------------------------------------- commit b347d60cbff5a5cc24477e6f273900952e8fce0e Author: Ben Gamari Date: Wed Mar 16 19:52:17 2016 +0100 Fix primitive types >--------------------------------------------------------------- b347d60cbff5a5cc24477e6f273900952e8fce0e compiler/prelude/TysPrim.hs | 2 +- compiler/typecheck/TcInteract.hs | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index 657ec08..5b7b7ab 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -20,7 +20,7 @@ module TysPrim( kKiVar, -- Kind constructors... - tYPETyConName, unliftedTypeKindTyConName, + tYPETyCon, tYPETyConName, unliftedTypeKindTyConName, -- Kinds tYPE, diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 37d6a13..bcb6ec7 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -24,10 +24,10 @@ import Name import PrelNames ( knownNatClassName, knownSymbolClassName, typeableClassName, coercibleTyConKey, heqTyConKey, ipClassKey, - trTYPE'PtrRepLiftedName, trRuntimeRepName, trArrowName ) + trTYPEName, trTYPE'PtrRepLiftedName, trRuntimeRepName, trArrowName ) import TysWiredIn ( typeNatKind, typeSymbolKind, heqDataCon, coercibleDataCon, runtimeRepTy ) -import TysPrim ( eqPrimTyCon, eqReprPrimTyCon ) +import TysPrim ( eqPrimTyCon, eqReprPrimTyCon, tYPETyCon ) import Id( idType ) import CoAxiom ( Eqn, CoAxiom(..), CoAxBranch(..), fromBranches ) import Class @@ -2018,7 +2018,9 @@ matchTypeable clas [k,t] -- clas = Typeable | k `eqType` typeNatKind = doTyLit knownNatClassName t | k `eqType` typeSymbolKind = doTyLit knownSymbolClassName t | t `eqType` liftedTypeKind = doPrimRep trTYPE'PtrRepLiftedName t + | t `eqType` mkTyConTy tYPETyCon = doPrimRep trTYPEName t | t `eqType` runtimeRepTy = doPrimRep trRuntimeRepName t + | t `eqType` mkTyConTy funTyCon = doPrimRep trArrowName t | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)] , onlyNamedBndrsApplied tc ks = doTyConApp clas t tc | Just (arg,ret) <- splitFunTy_maybe t = doFunTy clas t arg ret From git at git.haskell.org Mon Jun 6 11:12:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:29 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Accept easy test output (7a3f742) Message-ID: <20160606111229.686923A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/7a3f7423f95fbe7d72125166758be192bd55f65d/ghc >--------------------------------------------------------------- commit 7a3f7423f95fbe7d72125166758be192bd55f65d Author: Ben Gamari Date: Wed Mar 16 22:58:53 2016 +0100 Accept easy test output >--------------------------------------------------------------- 7a3f7423f95fbe7d72125166758be192bd55f65d testsuite/tests/ghci.debugger/scripts/print019.stderr | 6 +++--- testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/ghci.debugger/scripts/print019.stderr b/testsuite/tests/ghci.debugger/scripts/print019.stderr index cc62fa1..c266bc8 100644 --- a/testsuite/tests/ghci.debugger/scripts/print019.stderr +++ b/testsuite/tests/ghci.debugger/scripts/print019.stderr @@ -5,10 +5,10 @@ Use :print or :force to determine these types Relevant bindings include it :: a1 (bound at :10:1) These potential instances exist: - instance Show TypeRep -- Defined in ?Data.Typeable.Internal? instance Show Ordering -- Defined in ?GHC.Show? instance Show TyCon -- Defined in ?GHC.Show? - ...plus 30 others - ...plus 10 instances involving out-of-scope types + instance Show Integer -- Defined in ?GHC.Show? + ...plus 29 others + ...plus 12 instances involving out-of-scope types (use -fprint-potential-instances to see them all) ? In a stmt of an interactive GHCi command: print it diff --git a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr index e6e637c..b48d63f 100644 --- a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr +++ b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr @@ -1,13 +1,13 @@ TcStaticPointersFail02.hs:9:6: error: - ? No instance for (Data.Typeable.Internal.Typeable b) + ? No instance for (base-4.9.0.0:Data.Typeable.Internal.Typeable b) arising from a static form ? In the expression: static (undefined :: (forall a. a -> a) -> b) In an equation for ?f1?: f1 = static (undefined :: (forall a. a -> a) -> b) TcStaticPointersFail02.hs:12:6: error: - ? No instance for (Data.Typeable.Internal.Typeable + ? No instance for (base-4.9.0.0:Data.Typeable.Internal.Typeable (Monad m => a -> m a)) arising from a static form (maybe you haven't applied a function to enough arguments?) From git at git.haskell.org Mon Jun 6 11:12:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:32 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Add mkFunTy (7fd93c8) Message-ID: <20160606111232.19BAA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/7fd93c85d5561e5ede1c9dbcdf3224d7b7ded5b3/ghc >--------------------------------------------------------------- commit 7fd93c85d5561e5ede1c9dbcdf3224d7b7ded5b3 Author: Ben Gamari Date: Wed Mar 16 23:15:36 2016 +0100 Add mkFunTy >--------------------------------------------------------------- 7fd93c85d5561e5ede1c9dbcdf3224d7b7ded5b3 libraries/base/Data/Typeable.hs | 14 ++++++++++++++ libraries/base/Data/Typeable/Internal.hs | 3 ++- 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index 21f93d2..3eb53c5 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -68,6 +68,7 @@ module Data.Typeable , typeRepTyCon , rnfTypeRep , showsTypeRep + , mkFunTy -- * Observing type representations , funResultTy @@ -168,6 +169,19 @@ funResultTy (I.TypeRepX f) (I.TypeRepX x) = -} funResultTy _ _ = Nothing +-- | Build a function type. +mkFunTy :: TypeRep -> TypeRep -> TypeRep +mkFunTy (I.TypeRepX arg) (I.TypeRepX res) + | Just HRefl <- arg `I.eqTypeRep` liftedTy + , Just HRefl <- res `I.eqTypeRep` liftedTy + = I.TypeRepX (I.TRFun arg res) + | otherwise + = error $ "mkFunTy: Attempted to construct function type from non-lifted "++ + "type: arg="++show arg++", res="++show res + where liftedTy = I.typeRep :: I.TypeRep * + -- TODO: We should be able to support this but the kind of (->) must be + -- generalized + -- | Force a 'TypeRep' to normal form. rnfTypeRep :: TypeRep -> () rnfTypeRep = I.rnfTypeRepX diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index c145773..2053adb 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -187,7 +187,8 @@ pattern TRFun :: forall fun. () => TypeRep arg -> TypeRep res -> TypeRep fun -pattern TRFun arg res <- TrApp _ (TrApp _ (eqTypeRep trArrow -> Just HRefl) arg) res +pattern TRFun arg res <- TrApp _ (TrApp _ (eqTypeRep trArrow -> Just HRefl) arg) res where + TRFun arg res = mkTrApp (mkTrApp trArrow arg) res decomposeFun :: forall fun r. TypeRep fun From git at git.haskell.org Mon Jun 6 11:12:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:34 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix pretty-printer (ae746a3) Message-ID: <20160606111234.BAC213A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ae746a31eca5baa7b42b378e4ff1c8049d445028/ghc >--------------------------------------------------------------- commit ae746a31eca5baa7b42b378e4ff1c8049d445028 Author: Ben Gamari Date: Wed Mar 16 22:07:23 2016 +0100 Fix pretty-printer >--------------------------------------------------------------- ae746a31eca5baa7b42b378e4ff1c8049d445028 libraries/base/Data/Typeable/Internal.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index dd66283..7a2e914 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -343,14 +343,18 @@ instance Show (TypeRep (a :: k)) where showChar '(' . showArgs (showChar ',') tys . showChar ')' where (tc, tys) = splitApps rep showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon - showsPrec _ (TrApp _ (TrTyCon _ tycon _) x) + --showsPrec p (TRFun x r) = + -- showParen (p > 8) $ + -- showsPrec 9 x . showString " -> " . showsPrec 8 r + showsPrec p (TrApp _ (TrApp _ (TrTyCon _ tycon _) x) r) | isArrowTyCon tycon = - shows x . showString " ->" + showParen (p > 8) $ + showsPrec 9 x . showString " -> " . showsPrec p r showsPrec p (TrApp _ f x) | otherwise = showParen (p > 9) $ - showsPrec p f . + showsPrec 8 f . space . showsPrec 9 x where From git at git.haskell.org Mon Jun 6 11:12:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:37 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix a few TTypeRep references (58b2cf7) Message-ID: <20160606111237.6A2843A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/58b2cf7b112c7638880bc225b4988112a18af8a2/ghc >--------------------------------------------------------------- commit 58b2cf7b112c7638880bc225b4988112a18af8a2 Author: Ben Gamari Date: Wed Mar 16 11:51:00 2016 +0100 Fix a few TTypeRep references >--------------------------------------------------------------- 58b2cf7b112c7638880bc225b4988112a18af8a2 compiler/deSugar/DsBinds.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index c492074..8c8642e 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -1127,10 +1127,10 @@ type TypeRepExpr = CoreExpr ds_ev_typeable :: Type -> EvTypeable -> DsM CoreExpr ds_ev_typeable ty (EvTypeableTyCon tc kind_ev) = do { mkTrCon <- dsLookupGlobalId mkTrConName - -- mkTrCon :: forall k (a :: k). TyCon -> TTypeRep k -> TTypeRep a + -- mkTrCon :: forall k (a :: k). TyCon -> TypeRep k -> TypeRep a ; tc_rep <- tyConRep tc -- :: TyCon - ; kind_rep <- getRep kind_ev (typeKind ty) -- :: TTypeRep k + ; kind_rep <- getRep kind_ev (typeKind ty) -- :: TypeRep k -- Note that we use the kind of the type, not the TyCon from which it is -- constructed since the latter may be kind polymorphic whereas the @@ -1161,8 +1161,8 @@ ds_ev_typeable ty (EvTypeableTyLit ev) ty_kind = typeKind ty -- tr_fun is the Name of - -- typeNatTypeRep :: KnownNat a => Proxy# a -> TTypeRep a - -- of typeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TTypeRep a + -- typeNatTypeRep :: KnownNat a => Proxy# a -> TypeRep a + -- of typeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TypeRep a tr_fun | ty_kind `eqType` typeNatKind = typeNatTypeRepName | ty_kind `eqType` typeSymbolKind = typeSymbolTypeRepName | otherwise = panic "dsEvTypeable: unknown type lit kind" @@ -1176,10 +1176,10 @@ ds_ev_typeable ty ev getRep :: EvTerm -- ^ EvTerm for @Typeable ty@ -> Type -- ^ The type @ty@ - -> DsM TypeRepExpr -- ^ Return @CoreExpr :: TTypeRep ty@ + -> DsM TypeRepExpr -- ^ Return @CoreExpr :: TypeRep ty@ -- namely @typeRep# dict@ -- Remember that --- typeRep# :: forall k (a::k). Typeable k a -> TTypeRep a +-- typeRep# :: forall k (a::k). Typeable k a -> TypeRep a getRep ev ty = do { typeable_expr <- dsEvTerm ev ; typeRepId <- dsLookupGlobalId typeRepIdName From git at git.haskell.org Mon Jun 6 11:12:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:40 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Inline space (f3931e6) Message-ID: <20160606111240.118223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/f3931e674108e9b727b80113bcfb0e18fff42df9/ghc >--------------------------------------------------------------- commit f3931e674108e9b727b80113bcfb0e18fff42df9 Author: Ben Gamari Date: Wed Mar 16 22:10:16 2016 +0100 Inline space >--------------------------------------------------------------- f3931e674108e9b727b80113bcfb0e18fff42df9 libraries/base/Data/Typeable/Internal.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 09db187..c145773 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -337,10 +337,8 @@ instance Show (TypeRep (a :: k)) where | otherwise = showParen (p > 9) $ showsPrec 8 f . - space . + showChar ' ' . showsPrec 9 x - where - space = showChar ' ' instance Show TypeRepX where showsPrec p (TypeRepX ty) = showsPrec p ty From git at git.haskell.org Mon Jun 6 11:12:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:45 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix up representation pretty-printer (5012264) Message-ID: <20160606111245.645933A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/5012264360792347fd5bbea2d4ecad85517b3390/ghc >--------------------------------------------------------------- commit 5012264360792347fd5bbea2d4ecad85517b3390 Author: Ben Gamari Date: Wed Mar 16 13:36:30 2016 +0100 Fix up representation pretty-printer >--------------------------------------------------------------- 5012264360792347fd5bbea2d4ecad85517b3390 libraries/base/Data/Typeable/Internal.hs | 44 +++++++++++++++++++++++--------- 1 file changed, 32 insertions(+), 12 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 2252634..3b84aba 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -317,28 +317,48 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t ----------------- Showing TypeReps -------------------- -instance Show (TypeRep a) where +instance Show (TypeRep (a :: k)) where + showsPrec _ rep + | isListTyCon tc, [ty] <- tys = + showChar '[' . shows ty . showChar ']' + | isTupleTyCon tc = + showChar '(' . showArgs (showChar ',') tys . showChar ')' + where (tc, tys) = splitApps rep showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon - showsPrec p (TrApp _ f x) = showsPrec p f . showString " " . showsPrec p x - -- TODO: Reconsider precedence + showsPrec p (TrApp _ f x) + | Just HRefl <- f `eqTypeRep` (typeRep :: TypeRep (->)) = + shows x . showString " -> " + | otherwise = + showsPrec p f . space . showParen need_parens (showsPrec 10 x) + where + space = showChar ' ' + need_parens = case x of + TrApp {} -> True + TrTyCon {} -> False instance Show TypeRepX where showsPrec p (TypeRepX ty) = showsPrec p ty --- Some (Show.TypeRepX) helpers: -{- --- FIXME: Handle tuples, etc. +splitApps :: TypeRep a -> (TyCon, [TypeRepX]) +splitApps = go [] + where + go :: [TypeRepX] -> TypeRep a -> (TyCon, [TypeRepX]) + go xs (TrTyCon _ tc _) = (tc, xs) + go xs (TrApp _ f x) = go (TypeRepX x : xs) f + +isListTyCon :: TyCon -> Bool +isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [Int]) + +isTupleTyCon :: TyCon -> Bool +isTupleTyCon tc + | ('(':',':_) <- tyConName tc = True + | otherwise = False + showArgs :: Show a => ShowS -> [a] -> ShowS showArgs _ [] = id showArgs _ [a] = showsPrec 10 a showArgs sep (a:as) = showsPrec 10 a . sep . showArgs sep as -showTuple :: [TypeRepX] -> ShowS -showTuple args = showChar '(' - . showArgs (showChar ',') args - . showChar ')' --} - -- | Helper to fully evaluate 'TypeRep' for use as @NFData(rnf)@ implementation -- -- @since TODO From git at git.haskell.org Mon Jun 6 11:12:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:42 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Finally serialization is both general and correct (9c8dd2d) Message-ID: <20160606111242.AFAEB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/9c8dd2d28460a6cd652ac481d5d1ffe39bda33d8/ghc >--------------------------------------------------------------- commit 9c8dd2d28460a6cd652ac481d5d1ffe39bda33d8 Author: Ben Gamari Date: Wed Mar 16 12:16:20 2016 +0100 Finally serialization is both general and correct >--------------------------------------------------------------- 9c8dd2d28460a6cd652ac481d5d1ffe39bda33d8 compiler/utils/Binary.hs | 13 +++++-------- libraries/ghci/GHCi/TH/Binary.hs | 11 ++++------- 2 files changed, 9 insertions(+), 15 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 2dd2182..a346e0d 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -603,15 +603,12 @@ getTypeRepX bh = do TypeRepX x <- getTypeRepX bh case typeRepKind f of TRFun arg _ -> - case (typeRep :: TypeRep Type) `eqTypeRep` arg of - Just HRefl -> -- FIXME: Generalize (->) - case x `eqTypeRep` arg of - Just HRefl -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" - Nothing -> fail "getTypeRepX: Arrow of non-Type argument" + case arg `eqTypeRep` typeRepKind x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" _ -> fail "getTypeRepX: Applied non-arrow type" - _ -> fail "Binary: Invalid TypeRepX" + _ -> fail "getTypeRepX: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where put_ = putTypeRep diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 8d297a1..573a9e4 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -106,13 +106,10 @@ getTypeRepX = do TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> - case (typeRep :: TypeRep Type) `eqTypeRep` arg of - Just HRefl -> -- FIXME: Generalize (->) - case arg `eqTypeRep` x of - Just HRefl -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" - _ -> fail "getTypeRepX: Arrow of non-Type argument" + case arg `eqTypeRep` typeRepKind x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "getTypeRepX: Invalid TypeRepX" From git at git.haskell.org Mon Jun 6 11:12:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:48 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: More test fixes (8960738) Message-ID: <20160606111248.310BD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/8960738961ee6d06a71ec4b84288e5e385cbf68a/ghc >--------------------------------------------------------------- commit 8960738961ee6d06a71ec4b84288e5e385cbf68a Author: Ben Gamari Date: Wed Mar 16 23:15:48 2016 +0100 More test fixes >--------------------------------------------------------------- 8960738961ee6d06a71ec4b84288e5e385cbf68a libraries/base/tests/dynamic002.hs | 5 +++++ libraries/base/tests/dynamic004.hs | 1 - 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/tests/dynamic002.hs b/libraries/base/tests/dynamic002.hs index 6d53d2e..fff14ec 100644 --- a/libraries/base/tests/dynamic002.hs +++ b/libraries/base/tests/dynamic002.hs @@ -1,7 +1,12 @@ +{-# LANGUAGE CPP #-} + -- !!! Testing Typeable instances module Main(main) where import Data.Dynamic +#if MIN_VERSION_base(4,9,0) +import Data.Typeable (TypeCon, TypeRep) +#endif import Data.Array import Data.Array.MArray import Data.Array.ST diff --git a/libraries/base/tests/dynamic004.hs b/libraries/base/tests/dynamic004.hs index e6b7a82..2091646 100644 --- a/libraries/base/tests/dynamic004.hs +++ b/libraries/base/tests/dynamic004.hs @@ -1,7 +1,6 @@ module Main where import Data.Typeable -import Data.Typeable.Internal import GHC.Fingerprint import Text.Printf From git at git.haskell.org Mon Jun 6 11:12:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:50 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Break recursive loop in serialization (6667e59) Message-ID: <20160606111250.D29F73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/6667e59f17a455da08c7f73490addc89a5c965e5/ghc >--------------------------------------------------------------- commit 6667e59f17a455da08c7f73490addc89a5c965e5 Author: Ben Gamari Date: Wed Mar 16 13:01:45 2016 +0100 Break recursive loop in serialization >--------------------------------------------------------------- 6667e59f17a455da08c7f73490addc89a5c965e5 compiler/utils/Binary.hs | 18 ++++++++++++++---- libraries/ghci/GHCi/TH/Binary.hs | 18 ++++++++++++++---- 2 files changed, 28 insertions(+), 8 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index a346e0d..b26778e 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -82,6 +82,7 @@ import Data.Time import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) +import GHC.Exts (RuntimeRep) #else import Data.Typeable #endif @@ -579,12 +580,19 @@ instance Binary TyCon where #if MIN_VERSION_base(4,9,0) putTypeRep :: BinHandle -> TypeRep a -> IO () +-- Special handling for Type and RuntimeRep due to recursive kind relations. +-- See Note [Mutually recursive representations of primitive types] +putTypeRep bh rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) + = put_ bh (0 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) + = put_ bh (1 :: Word8) putTypeRep bh rep@(TRCon con) = do - put_ bh (0 :: Word8) + put_ bh (2 :: Word8) put_ bh con putTypeRep bh (typeRepKind rep) putTypeRep bh (TRApp f x) = do - put_ bh (1 :: Word8) + put_ bh (3 :: Word8) putTypeRep bh f putTypeRep bh x putTypeRep _ _ = fail "putTypeRep: Impossible" @@ -593,13 +601,15 @@ getTypeRepX :: BinHandle -> IO TypeRepX getTypeRepX bh = do tag <- get bh :: IO Word8 case tag of - 0 -> do con <- get bh :: IO TyCon + 0 -> return $ TypeRepX (typeRep :: TypeRep Type) + 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) + 2 -> do con <- get bh :: IO TyCon TypeRepX rep_k <- getTypeRepX bh case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> fail "getTypeRepX: Kind mismatch" - 1 -> do TypeRepX f <- getTypeRepX bh + 3 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh case typeRepKind f of TRFun arg _ -> diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 573a9e4..bcf58bb 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -14,6 +14,7 @@ import qualified Data.ByteString as B import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) +import GHC.Exts (RuntimeRep) #else import Data.Typeable #endif @@ -82,12 +83,19 @@ instance Binary TyCon where get = mkTyCon <$> get <*> get <*> get putTypeRep :: TypeRep a -> Put +-- Special handling for Type and RuntimeRep due to recursive kind relations. +-- See Note [Mutually recursive representations of primitive types] +putTypeRep rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) + = put (0 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) + = put (1 :: Word8) putTypeRep rep@(TRCon con) = do - put (0 :: Word8) + put (2 :: Word8) put con putTypeRep (typeRepKind rep) putTypeRep (TRApp f x) = do - put (1 :: Word8) + put (3 :: Word8) putTypeRep f putTypeRep x putTypeRep _ = fail "putTypeRep: Impossible" @@ -96,13 +104,15 @@ getTypeRepX :: Get TypeRepX getTypeRepX = do tag <- get :: Get Word8 case tag of - 0 -> do con <- get :: Get TyCon + 0 -> return $ TypeRepX (typeRep :: TypeRep Type) + 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) + 2 -> do con <- get :: Get TyCon TypeRepX rep_k <- getTypeRepX case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> fail "getTypeRepX: Kind mismatch" - 1 -> do TypeRepX f <- getTypeRepX + 3 -> do TypeRepX f <- getTypeRepX TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> From git at git.haskell.org Mon Jun 6 11:12:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:53 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix recursive fingerprints (2f12211) Message-ID: <20160606111253.7A2613A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/2f1221167b7035321df06fe03414db4e697e3273/ghc >--------------------------------------------------------------- commit 2f1221167b7035321df06fe03414db4e697e3273 Author: Ben Gamari Date: Wed Mar 16 11:53:01 2016 +0100 Fix recursive fingerprints >--------------------------------------------------------------- 2f1221167b7035321df06fe03414db4e697e3273 libraries/base/Data/Typeable/Internal.hs | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 7a3344e..bb2bcc2 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -429,11 +429,20 @@ For this reason we are forced to define their representations manually. -} +-- | We can't use 'mkTrCon' here as it requires the fingerprint of the kind +-- which is knot-tied. +mkPrimTrCon :: forall k (a :: k). TyCon -> TypeRep k -> TypeRep a +mkPrimTrCon tc kind = TrTyCon fpr tc kind + where + fpr_tc = tyConFingerprint tc + fpr_tag = fingerprintString "prim" + fpr = fingerprintFingerprints [fpr_tag, fpr_tc] + mkPrimTyCon :: String -> TyCon mkPrimTyCon = mkTyCon "ghc-prim" "GHC.Prim" trTYPE :: TypeRep TYPE -trTYPE = mkTrCon (mkPrimTyCon "TYPE") runtimeRep_arr_type +trTYPE = mkPrimTrCon (mkPrimTyCon "TYPE") runtimeRep_arr_type where runtimeRep_arr :: TypeRep ((->) RuntimeRep) runtimeRep_arr = mkTrApp trArrow trRuntimeRep @@ -442,10 +451,10 @@ trTYPE = mkTrCon (mkPrimTyCon "TYPE") runtimeRep_arr_type runtimeRep_arr_type = mkTrApp runtimeRep_arr star trRuntimeRep :: TypeRep RuntimeRep -trRuntimeRep = mkTrCon (mkPrimTyCon "RuntimeRep") star +trRuntimeRep = mkPrimTrCon (mkPrimTyCon "RuntimeRep") star tr'PtrRepLifted :: TypeRep 'PtrRepLifted -tr'PtrRepLifted = mkTrCon (mkPrimTyCon "'PtrRepLifted") trRuntimeRep +tr'PtrRepLifted = mkPrimTrCon (mkPrimTyCon "'PtrRepLifted") trRuntimeRep trTYPE'PtrRepLifted :: TypeRep (TYPE 'PtrRepLifted) trTYPE'PtrRepLifted = mkTrApp trTYPE tr'PtrRepLifted @@ -454,7 +463,7 @@ trArrowTyCon :: TyCon trArrowTyCon = mkPrimTyCon "->" trArrow :: TypeRep (->) -trArrow = mkTrCon trArrowTyCon star_arr_star_arr_star +trArrow = mkPrimTrCon trArrowTyCon star_arr_star_arr_star -- Some useful aliases star :: TypeRep (TYPE 'PtrRepLifted) From git at git.haskell.org Mon Jun 6 11:12:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:56 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Another recursive serialization case (c9751b0) Message-ID: <20160606111256.26BA13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/c9751b08cf9cab6a53941f9dbe7887416b00d506/ghc >--------------------------------------------------------------- commit c9751b08cf9cab6a53941f9dbe7887416b00d506 Author: Ben Gamari Date: Wed Mar 16 14:05:43 2016 +0100 Another recursive serialization case >--------------------------------------------------------------- c9751b08cf9cab6a53941f9dbe7887416b00d506 compiler/utils/Binary.hs | 14 +++++++++----- libraries/ghci/GHCi/TH/Binary.hs | 14 +++++++++----- 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index b26778e..879a67f 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -580,19 +580,22 @@ instance Binary TyCon where #if MIN_VERSION_base(4,9,0) putTypeRep :: BinHandle -> TypeRep a -> IO () --- Special handling for Type and RuntimeRep due to recursive kind relations. +-- Special handling for Type, (->), and RuntimeRep due to recursive kind +-- relations. -- See Note [Mutually recursive representations of primitive types] putTypeRep bh rep | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = put_ bh (1 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep (->)) + = put_ bh (2 :: Word8) putTypeRep bh rep@(TRCon con) = do - put_ bh (2 :: Word8) + put_ bh (3 :: Word8) put_ bh con putTypeRep bh (typeRepKind rep) putTypeRep bh (TRApp f x) = do - put_ bh (3 :: Word8) + put_ bh (4 :: Word8) putTypeRep bh f putTypeRep bh x putTypeRep _ _ = fail "putTypeRep: Impossible" @@ -603,13 +606,14 @@ getTypeRepX bh = do case tag of 0 -> return $ TypeRepX (typeRep :: TypeRep Type) 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) - 2 -> do con <- get bh :: IO TyCon + 2 -> return $ TypeRepX (typeRep :: TypeRep (->)) + 3 -> do con <- get bh :: IO TyCon TypeRepX rep_k <- getTypeRepX bh case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> fail "getTypeRepX: Kind mismatch" - 3 -> do TypeRepX f <- getTypeRepX bh + 4 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh case typeRepKind f of TRFun arg _ -> diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index bcf58bb..c351cd1 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -83,19 +83,22 @@ instance Binary TyCon where get = mkTyCon <$> get <*> get <*> get putTypeRep :: TypeRep a -> Put --- Special handling for Type and RuntimeRep due to recursive kind relations. +-- Special handling for Type, (->), and RuntimeRep due to recursive kind +-- relations. -- See Note [Mutually recursive representations of primitive types] putTypeRep rep | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put (0 :: Word8) | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = put (1 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep (->)) + = put (2 :: Word8) putTypeRep rep@(TRCon con) = do - put (2 :: Word8) + put (3 :: Word8) put con putTypeRep (typeRepKind rep) putTypeRep (TRApp f x) = do - put (3 :: Word8) + put (4 :: Word8) putTypeRep f putTypeRep x putTypeRep _ = fail "putTypeRep: Impossible" @@ -106,13 +109,14 @@ getTypeRepX = do case tag of 0 -> return $ TypeRepX (typeRep :: TypeRep Type) 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) - 2 -> do con <- get :: Get TyCon + 2 -> return $ TypeRepX (typeRep :: TypeRep (->)) + 3 -> do con <- get :: Get TyCon TypeRepX rep_k <- getTypeRepX case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> fail "getTypeRepX: Kind mismatch" - 3 -> do TypeRepX f <- getTypeRepX + 4 -> do TypeRepX f <- getTypeRepX TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> From git at git.haskell.org Mon Jun 6 11:12:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:12:58 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Render TYPE 'PtrRepLifted as * (2c406cb) Message-ID: <20160606111258.D2E583A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/2c406cb3fc2784f4980f706bcc6a96316f41e9c0/ghc >--------------------------------------------------------------- commit 2c406cb3fc2784f4980f706bcc6a96316f41e9c0 Author: Ben Gamari Date: Thu Mar 17 01:02:39 2016 +0100 Render TYPE 'PtrRepLifted as * >--------------------------------------------------------------- 2c406cb3fc2784f4980f706bcc6a96316f41e9c0 libraries/base/Data/Typeable/Internal.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 2053adb..baedc64 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -320,6 +320,8 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t instance Show (TypeRep (a :: k)) where showsPrec _ rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep *) = + showChar '*' | isListTyCon tc, [ty] <- tys = showChar '[' . shows ty . showChar ']' | isTupleTyCon tc = From git at git.haskell.org Mon Jun 6 11:13:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:13:01 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix T8132 (54eb46f) Message-ID: <20160606111301.8038C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/54eb46f12339fe158c0d347c076cb180a5eaf5cc/ghc >--------------------------------------------------------------- commit 54eb46f12339fe158c0d347c076cb180a5eaf5cc Author: Ben Gamari Date: Wed Mar 16 23:22:32 2016 +0100 Fix T8132 >--------------------------------------------------------------- 54eb46f12339fe158c0d347c076cb180a5eaf5cc testsuite/tests/polykinds/T8132.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/polykinds/T8132.hs b/testsuite/tests/polykinds/T8132.hs index 337e288..cdbfd7f 100644 --- a/testsuite/tests/polykinds/T8132.hs +++ b/testsuite/tests/polykinds/T8132.hs @@ -1,6 +1,7 @@ {-# LANGUAGE MagicHash #-} -import Data.Typeable.Internal +import Data.Typeable data K = K -instance Typeable K where typeRep# _ = undefined +-- This used to have a RHS but now we hide typeRep# +instance Typeable K -- where typeRep# _ = undefined From git at git.haskell.org Mon Jun 6 11:13:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:13:04 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Implement withTypeable (d8efe39) Message-ID: <20160606111304.2E1FE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/d8efe395953e2c8d9ed5f69c0fc14c54198c94c2/ghc >--------------------------------------------------------------- commit d8efe395953e2c8d9ed5f69c0fc14c54198c94c2 Author: Ben Gamari Date: Wed Apr 13 00:02:51 2016 +0200 Implement withTypeable >--------------------------------------------------------------- d8efe395953e2c8d9ed5f69c0fc14c54198c94c2 libraries/base/Data/Typeable/Internal.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 6d8b181..e38607f 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -85,6 +85,7 @@ import Data.Type.Equality import GHC.Word import GHC.Show import GHC.TypeLits( KnownNat, KnownSymbol, natVal', symbolVal' ) +import Unsafe.Coerce import GHC.Fingerprint.Type import {-# SOURCE #-} GHC.Fingerprint @@ -242,8 +243,11 @@ pattern TRApp :: forall k2 (t :: k2). () => TypeRep a -> TypeRep b -> TypeRep t pattern TRApp f x <- TrApp _ f x +-- | Use a 'TypeRep' as 'Typeable' evidence. withTypeable :: TypeRep a -> (Typeable a => b) -> b -withTypeable = undefined +withTypeable rep f = f' rep + where f' :: TypeRep a -> b + f' = unsafeCoerce rep -- | Pattern match on a type constructor -- TODO: do we want to expose kinds in these patterns? From git at git.haskell.org Mon Jun 6 11:13:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:13:06 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Internal: Rename type variable (0217f61) Message-ID: <20160606111306.CB3693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/0217f61ab993119d575895dc2a59cb6810835908/ghc >--------------------------------------------------------------- commit 0217f61ab993119d575895dc2a59cb6810835908 Author: Ben Gamari Date: Fri Mar 18 11:49:43 2016 +0100 Internal: Rename type variable >--------------------------------------------------------------- 0217f61ab993119d575895dc2a59cb6810835908 libraries/base/Data/Typeable/Internal.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index baedc64..6d8b181 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -237,9 +237,9 @@ data AppResult (t :: k) where App :: TypeRep a -> TypeRep b -> AppResult (a b) -- | Pattern match on a type application -pattern TRApp :: forall k2 (fun :: k2). () - => forall k1 (a :: k1 -> k2) (b :: k1). (fun ~ a b) - => TypeRep a -> TypeRep b -> TypeRep fun +pattern TRApp :: forall k2 (t :: k2). () + => forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b) + => TypeRep a -> TypeRep b -> TypeRep t pattern TRApp f x <- TrApp _ f x withTypeable :: TypeRep a -> (Typeable a => b) -> b From git at git.haskell.org Mon Jun 6 11:13:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:13:09 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Bump base to 4.10.0 (f5c4fd7) Message-ID: <20160606111309.78E633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/f5c4fd75791d9f6cc7173d660f88f0fb672e13bb/ghc >--------------------------------------------------------------- commit f5c4fd75791d9f6cc7173d660f88f0fb672e13bb Author: Ben Gamari Date: Fri May 20 16:53:57 2016 +0200 Bump base to 4.10.0 >--------------------------------------------------------------- f5c4fd75791d9f6cc7173d660f88f0fb672e13bb compiler/utils/Binary.hs | 6 +++--- libraries/base/base.cabal | 2 +- libraries/base/tests/dynamic002.hs | 2 +- libraries/ghc-boot/GHC/Serialized.hs | 2 +- libraries/ghci/GHCi/Message.hs | 2 +- libraries/ghci/GHCi/TH/Binary.hs | 4 ++-- 6 files changed, 9 insertions(+), 9 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 879a67f..1a66de6 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -78,7 +78,7 @@ import qualified Data.ByteString.Unsafe as BS import Data.IORef import Data.Char ( ord, chr ) import Data.Time -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) @@ -572,13 +572,13 @@ instance Binary TyCon where p <- get bh m <- get bh n <- get bh -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) return (mkTyCon p m n) #else return (mkTyCon3 p m n) #endif -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) putTypeRep :: BinHandle -> TypeRep a -> IO () -- Special handling for Type, (->), and RuntimeRep due to recursive kind -- relations. diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index 088f1b9..46965ee 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -1,5 +1,5 @@ name: base -version: 4.9.0.0 +version: 4.10.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE diff --git a/libraries/base/tests/dynamic002.hs b/libraries/base/tests/dynamic002.hs index fff14ec..560c4b4 100644 --- a/libraries/base/tests/dynamic002.hs +++ b/libraries/base/tests/dynamic002.hs @@ -4,7 +4,7 @@ module Main(main) where import Data.Dynamic -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) import Data.Typeable (TypeCon, TypeRep) #endif import Data.Array diff --git a/libraries/ghc-boot/GHC/Serialized.hs b/libraries/ghc-boot/GHC/Serialized.hs index 8653049..42a9604 100644 --- a/libraries/ghc-boot/GHC/Serialized.hs +++ b/libraries/ghc-boot/GHC/Serialized.hs @@ -36,7 +36,7 @@ toSerialized serialize what = Serialized rep (serialize what) -- | If the 'Serialized' value contains something of the given type, then use the specified deserializer to return @Just@ that. -- Otherwise return @Nothing at . fromSerialized :: forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) fromSerialized deserialize (Serialized the_type bytes) | the_type == rep = Just (deserialize bytes) | otherwise = Nothing diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index 4bc8d2c..a019f9c 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -29,7 +29,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import Data.Dynamic -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) -- Previously this was re-exported by Data.Dynamic import Data.Typeable (TypeRep) #endif diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index c351cd1..c60b513 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -10,7 +10,7 @@ module GHCi.TH.Binary () where import Data.Binary import qualified Data.ByteString as B -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) @@ -77,7 +77,7 @@ instance Binary TH.PatSynArgs -- We need Binary TypeRep for serializing annotations -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) instance Binary TyCon where put tc = put (tyConPackage tc) >> put (tyConModule tc) >> put (tyConName tc) get = mkTyCon <$> get <*> get <*> get From git at git.haskell.org Mon Jun 6 11:13:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:13:12 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix withTypeable (d3ef4f2) Message-ID: <20160606111312.235FD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/d3ef4f2a4d5eeb214bc942e94b8fc010c837fca4/ghc >--------------------------------------------------------------- commit d3ef4f2a4d5eeb214bc942e94b8fc010c837fca4 Author: Ben Gamari Date: Fri May 20 18:07:01 2016 +0200 Fix withTypeable >--------------------------------------------------------------- d3ef4f2a4d5eeb214bc942e94b8fc010c837fca4 libraries/base/Data/Typeable/Internal.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index e38607f..ce33318 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -244,10 +244,13 @@ pattern TRApp :: forall k2 (t :: k2). () pattern TRApp f x <- TrApp _ f x -- | Use a 'TypeRep' as 'Typeable' evidence. -withTypeable :: TypeRep a -> (Typeable a => b) -> b -withTypeable rep f = f' rep - where f' :: TypeRep a -> b - f' = unsafeCoerce rep +withTypeable :: forall a r. TypeRep a -> (Typeable a => r) -> r +withTypeable rep k = unsafeCoerce k' rep + where k' :: Gift a r + k' = Gift k + +-- | A helper to satisfy the type checker in 'withTypeable'. +newtype Gift a r = Gift (Typeable a => r) -- | Pattern match on a type constructor -- TODO: do we want to expose kinds in these patterns? From git at git.haskell.org Mon Jun 6 11:13:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:13:14 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Bump base (324ea2d) Message-ID: <20160606111314.C1DE13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/324ea2d487473a8379335bdf4b12b89c6b2613c5/ghc >--------------------------------------------------------------- commit 324ea2d487473a8379335bdf4b12b89c6b2613c5 Author: Ben Gamari Date: Sat Jun 4 09:48:57 2016 +0200 Bump base >--------------------------------------------------------------- 324ea2d487473a8379335bdf4b12b89c6b2613c5 libraries/ghc-boot-th/ghc-boot-th.cabal.in | 2 +- libraries/ghc-boot/ghc-boot.cabal.in | 2 +- libraries/ghci/ghci.cabal.in | 2 +- libraries/template-haskell/template-haskell.cabal | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/libraries/ghc-boot-th/ghc-boot-th.cabal.in b/libraries/ghc-boot-th/ghc-boot-th.cabal.in index 3aebfbf..50b07db 100644 --- a/libraries/ghc-boot-th/ghc-boot-th.cabal.in +++ b/libraries/ghc-boot-th/ghc-boot-th.cabal.in @@ -34,4 +34,4 @@ Library GHC.LanguageExtensions.Type GHC.Lexeme - build-depends: base >= 4.7 && < 4.10 + build-depends: base >= 4.7 && < 4.11 diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in index eed11e3..4d162f0 100644 --- a/libraries/ghc-boot/ghc-boot.cabal.in +++ b/libraries/ghc-boot/ghc-boot.cabal.in @@ -44,7 +44,7 @@ Library GHC.LanguageExtensions.Type, GHC.Lexeme - build-depends: base >= 4.7 && < 4.10, + build-depends: base >= 4.7 && < 4.11, binary == 0.8.*, bytestring == 0.10.*, directory == 1.2.*, diff --git a/libraries/ghci/ghci.cabal.in b/libraries/ghci/ghci.cabal.in index 547374a..32ebb99 100644 --- a/libraries/ghci/ghci.cabal.in +++ b/libraries/ghci/ghci.cabal.in @@ -58,7 +58,7 @@ library Build-Depends: array == 0.5.*, - base == 4.9.*, + base == 4.10.*, binary == 0.8.*, bytestring == 0.10.*, containers == 0.5.*, diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal index 0d9f468..b90f53d 100644 --- a/libraries/template-haskell/template-haskell.cabal +++ b/libraries/template-haskell/template-haskell.cabal @@ -49,7 +49,7 @@ Library Language.Haskell.TH.Lib.Map build-depends: - base >= 4.8 && < 4.10, + base >= 4.8 && < 4.11, ghc-boot-th == 8.1, pretty == 1.1.* From git at git.haskell.org Mon Jun 6 11:13:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:13:17 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: testsuite: Bump base version (78d7d9a) Message-ID: <20160606111317.775913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/78d7d9a77c25ef929d41e9ef4a8c338ddabe7ec4/ghc >--------------------------------------------------------------- commit 78d7d9a77c25ef929d41e9ef4a8c338ddabe7ec4 Author: Ben Gamari Date: Sat Jun 4 09:58:08 2016 +0200 testsuite: Bump base version >--------------------------------------------------------------- 78d7d9a77c25ef929d41e9ef4a8c338ddabe7ec4 testsuite/tests/ado/ado004.stderr | 2 +- testsuite/tests/ghci/scripts/ghci008.stdout | 4 ++-- .../tests/indexed-types/should_compile/T3017.stderr | 2 +- testsuite/tests/partial-sigs/should_compile/ADT.stderr | 2 +- .../tests/partial-sigs/should_compile/AddAndOr1.stderr | 4 ++-- .../tests/partial-sigs/should_compile/AddAndOr2.stderr | 4 ++-- .../tests/partial-sigs/should_compile/AddAndOr3.stderr | 4 ++-- .../tests/partial-sigs/should_compile/AddAndOr4.stderr | 4 ++-- .../tests/partial-sigs/should_compile/AddAndOr5.stderr | 4 ++-- .../tests/partial-sigs/should_compile/AddAndOr6.stderr | 4 ++-- .../tests/partial-sigs/should_compile/BoolToBool.stderr | 4 ++-- .../should_compile/DataFamilyInstanceLHS.stderr | 2 +- .../partial-sigs/should_compile/Defaulting1MROn.stderr | 4 ++-- .../partial-sigs/should_compile/Defaulting2MROff.stderr | 2 +- .../partial-sigs/should_compile/Defaulting2MROn.stderr | 4 ++-- .../tests/partial-sigs/should_compile/Either.stderr | 2 +- .../should_compile/EqualityConstraint.stderr | 2 +- testsuite/tests/partial-sigs/should_compile/Every.stderr | 4 ++-- .../tests/partial-sigs/should_compile/EveryNamed.stderr | 2 +- .../partial-sigs/should_compile/ExpressionSig.stderr | 4 ++-- .../should_compile/ExpressionSigNamed.stderr | 4 ++-- .../partial-sigs/should_compile/ExtraConstraints1.stderr | 2 +- .../partial-sigs/should_compile/ExtraConstraints2.stderr | 4 ++-- .../partial-sigs/should_compile/ExtraConstraints3.stderr | 2 +- .../partial-sigs/should_compile/ExtraNumAMROff.stderr | 4 ++-- .../partial-sigs/should_compile/ExtraNumAMROn.stderr | 2 +- .../tests/partial-sigs/should_compile/Forall1.stderr | 4 ++-- .../tests/partial-sigs/should_compile/GenNamed.stderr | 4 ++-- .../tests/partial-sigs/should_compile/HigherRank1.stderr | 4 ++-- .../tests/partial-sigs/should_compile/HigherRank2.stderr | 4 ++-- .../should_compile/LocalDefinitionBug.stderr | 4 ++-- .../tests/partial-sigs/should_compile/Meltdown.stderr | 2 +- .../partial-sigs/should_compile/MonoLocalBinds.stderr | 4 ++-- .../tests/partial-sigs/should_compile/NamedTyVar.stderr | 2 +- .../NamedWildcardInDataFamilyInstanceLHS.stderr | 2 +- .../NamedWildcardInTypeFamilyInstanceLHS.stderr | 2 +- .../should_compile/ParensAroundContext.stderr | 4 ++-- .../tests/partial-sigs/should_compile/PatBind.stderr | 4 ++-- .../tests/partial-sigs/should_compile/PatBind2.stderr | 2 +- .../tests/partial-sigs/should_compile/PatternSig.stderr | 4 ++-- .../tests/partial-sigs/should_compile/Recursive.stderr | 4 ++-- .../should_compile/ScopedNamedWildcards.stderr | 4 ++-- .../should_compile/ScopedNamedWildcardsGood.stderr | 4 ++-- .../tests/partial-sigs/should_compile/ShowNamed.stderr | 2 +- .../tests/partial-sigs/should_compile/SimpleGen.stderr | 2 +- .../tests/partial-sigs/should_compile/SkipMany.stderr | 2 +- .../partial-sigs/should_compile/SomethingShowable.stderr | 2 +- .../should_compile/TypeFamilyInstanceLHS.stderr | 2 +- .../tests/partial-sigs/should_compile/Uncurry.stderr | 2 +- .../partial-sigs/should_compile/UncurryNamed.stderr | 2 +- .../should_compile/WarningWildcardInstantiations.stderr | 2 +- testsuite/tests/polykinds/T8132.stderr | 2 +- testsuite/tests/rename/should_fail/rnfail040.stderr | 4 ++-- testsuite/tests/roles/should_compile/Roles1.stderr | 2 +- testsuite/tests/roles/should_compile/Roles14.stderr | 2 +- testsuite/tests/roles/should_compile/Roles2.stderr | 2 +- testsuite/tests/roles/should_compile/Roles3.stderr | 2 +- testsuite/tests/roles/should_compile/Roles4.stderr | 2 +- testsuite/tests/roles/should_compile/T8958.stderr | 2 +- testsuite/tests/safeHaskell/check/Check01.stderr | 4 ++-- testsuite/tests/safeHaskell/check/Check06.stderr | 4 ++-- testsuite/tests/safeHaskell/check/Check08.stderr | 4 ++-- testsuite/tests/safeHaskell/check/Check09.stderr | 8 ++++---- testsuite/tests/safeHaskell/check/pkg01/ImpSafe01.stderr | 4 ++-- testsuite/tests/safeHaskell/check/pkg01/ImpSafe04.stderr | 4 ++-- testsuite/tests/safeHaskell/flags/SafeFlags17.stderr | 4 ++-- testsuite/tests/typecheck/should_compile/tc231.stderr | 2 +- .../typecheck/should_fail/TcStaticPointersFail02.stderr | 4 ++-- testsuite/tests/typecheck/should_fail/tcfail182.stderr | 16 ++++++++-------- 69 files changed, 114 insertions(+), 114 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 78d7d9a77c25ef929d41e9ef4a8c338ddabe7ec4 From git at git.haskell.org Mon Jun 6 11:13:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 11:13:21 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable's head updated: testsuite: Bump base version (78d7d9a) Message-ID: <20160606111321.D8C373A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/ttypeable' now includes: 46f9a47 DriverPipeline: Fix 'unused arguments' warnings from Clang b5565f1 Fix #11711. c5ed41c typechecker: fix trac issue #11708 3fe87aa Fix #11716. f4f315a Fix #11512 by getting visibility right for methods 220a0b9 Add test for #9646 3ddfcc9 PrelRules: Fix constant folding for WordRemOp 2841cca Mark GHC.Real.even and odd as INLINEABLE c095ec5 Ensure T11702 always runs with optasm c0f628d Revert "Add test for #11473" cb7ecda Fix duplicate T11334 test 08d254b Fix T9646 7186a01 Dwarf: Add support for labels in unwind expressions ba95f22 prof: Fix heap census for large ARR_WORDS (#11627) b735e99 DsExpr: Don't build/foldr huge lists 289d57a Add test for incompatible flags (issue #11580) cb3456d base: Rework System.CPUTime e6a44f2 T11145: Fix expected output 286c65f base: Fix CPUTime on Windows 3ade8bc Delete a misleading comment in TyCon 2cb5577 Remove unnecessary Ord instance for ConLike c37a583 Remove unused substTyWithBinders functions af2f7f9 Fix exponential algorithm in pure unifier. 01b29eb TypeApplications does not imply AllowAmbiguousTypes 0706a10 Add two small optimizations. (#11196) 1701255 Fix #11635 / #11719. 0b89064 Make equality print better. (#11712) f8ab575 Rename test for #11334 to 11334b, fixing conflict 3e1b882 Prevent eager unification with type families. 9477093 Comment a suspicious zonk in TcFlatten. 35e9379 Track specified/invisible more carefully. 5c0c751 Zonk before calling splitDepVarsOfType. d978c5e Fix #11723 and #11724. e19e58c Improve panicking output 1934f7f stgMallocBytes: Tolerate malloc(0) returning a NULL ptr 2d6d907 Comments (only) in TcFlatten 6f0e41d PPC NCG: Emit more portable `fcmpu 0, ...` instead of `fcmpu cr0, ...` 685398e Use the correct in-scope set in coercionKind 0beb82c Avoid running afoul of the zipTvSubst check. 7e74079 Comment fix 7d5ff3d Move applyTysX near piResultTys db9e4eb Move DFunUnfolding generation to TcInstDcls e57b9ff Fix regression test for #11145. 2ddfb75 base: Fix ClockGetTime on OS X da3b29b Ensure T9646 dump-simpl output is cleaned 8048d51 ErrUtils: Add timings to compiler phases 997312b Add `PatSynSigSkol` and modify `PatSynCtxt` 2708c22 Close ticky profiling file stream after printing (#9405) 03a1bb4 Add unicode syntax for banana brackets 6c2c853 Various ticky-related work 9f9345e Create empty dump files (fixes #10320) 0db0594 DsExpr: Rip out static/dynamic check in list desugaring 8335cc7 Add expected output for T9405 ef653f1 Revert "Various ticky-related work" 1448f8a Show: Restore redundant parentheses around records 371608f Default RuntimeRep variables unless -fprint-explicit-runtime-reps 0bd0c31 Defer inlining of Eq for primitive types 2b5929c Comments only cb08f8d Tidy up handling of coercion variables 343349d Avoid local label syntax for assembler on AIX 2cebbe6 users_guide: Fix various issues 8ff6518 users-guide: Add -Wredundant-constraints to flags reference 173a5d8 users_guide: small improvements on pattern synonyms. 2414952 Add option `no-keep-hi-files` and `no-keep-o-files` (fixes #4114) df26b95 Add NCG support for AIX/ppc32 4dc8835 Remove code-duplication in the PPC NCG 26f86f3 base: Fix GHC.Word and GHC.Int on 32-bit platforms 84dd9d0 An extra traceTc in tcExpr for ExprWithSig 356e5e0 Do not eta-reduce across Ticks in CorePrep 12372ba CorePrep: refactoring to reduce duplication 067335a A raft of comments about TyBinders b416630f Test Trac #11728 da4bc0c Document implicit quantification better 454585c More clarification in docs for implicit quantification 4e98b4f DynFlags: Initialize unsafeGlobalDynFlags enough to be useful e8d3567 Panic: Try outputting SDocs d0787a2 testsuite: Identify framework failures in testsuite summary 1b4d120 DWARF: Add debugging information chapter to users guide 882179d RTS: Fix & refactor "portable inline" macros 4da8e73 Fix #11754 by adding an additional check. 12a76be Check for rep poly on wildcard binders. 9f73e46 Clarify Note [Kind coercions in Unify] 06cd26b Remove now obsolete LD_STAGE0 hack c7b32ad Remove now pointless INLINE_ME macro 61df7f8 Fix AIX/ppc codegen in `-prof` compilation mode 0bca3f3 Scrap IRIX support f911358 Scrap DEC OSF/1 support ffc802e Drop Xcode 4.1 hack and fix ignored CC var issue afc48f8 Autoconf: detect and set CFLAGS/CPPFLAGS needed for C99 mode 49b9d80 Do not test for existence of the executable eb25381 Update bytestring submodule to latest snapshot cd3fbff Remove obsolete --with-hc flag from ./configure 91b96e1 fix compilation failure on Solaris 11 a658ad9 Reenable external-json linters 0f0c138 base: Document caveats about Control.Concurrent.Chan 415b706 users-guide: Provide more depth in table-of-contents eb8bc4d users-guide: Wibbles aa61174 users-guide: Add references to various issues in bugs section 7393532 Use a correct substitution in tcInstType a49228e Build correct substitution in instDFunType 4a93e4f Use the correct substitution in lintCoercion 5097f38 Add Data.Functor.Classes instances for Proxy (trac issue #11756) b0ab8db base: Add comment noting import loop be2a7ba cleanup POSIX/XOPEN defines for switch to C99 85e6997 Remove all mentions of IND_OLDGEN outside of docs/rts 30b9061 Be more explicit about closure types in ticky-ticky-report 38c7714 Ticky: Do not count every entry twice 8af1d08 Typo in Note name 80d4fdf SpecConstr: Transport strictness data to specialization?s argument?s binders e6e17a0 Rename isNopSig to isTopSig c8138c8 Do not print DmdType in Core output cf768ec Tes suite output updates d5d6804 rename: Disallow type signatures in patterns in plain Haskell ae6a56e users-guide/rel-notes: Note broken-ness of ImpredicativeTypes eb6b709 base: Fix haddock typo cb9a1e6 Add testcase for #11770 a76e6f5 Typos in non-code 1757dd8 Don't recompute some free vars in lintCoercion 3d245bf Do not claim that -O2 does not do better than -O 973633a Comments only in Unify.hs 7aa4c52 rts/posix/Itimer.c: Handle EINTR when reading timerfd d1179c4 ghc-prim: Delay inlining of {gt,ge,lt,le}Int to phase 1 c0e3e63 Defer inlining of Ord methods 58bbb40 ghc-prim: Mark unpackCStringUtf8# and unpackNBytes# as NOINLINE e9c2555 Don't require -hide-all-packages for MIN_VERSION_* macros bc953fc Add -f(no-)version-macro to explicitly control macros. 24d7615 Kill the magic of Any 8f66bac Comments only 1f68da1 Minor refactoring in mkExport 2e5e822 Comments only bdd9042 Refactor in TcMatches 174d3a5 Small refactor of TcMType.tauifyExpType 0ad2021 Make SigSkol take TcType not ExpType 9fc65bb Refactor error generation for pattern synonyms 28fe0ee Demand Analyzer: Do not set OneShot information da260a5 Revert accidental change to collectTyAndValBinders 6ea42c7 Revert "Demand Analyzer: Do not set OneShot information" 3806891 Make the example for -M work 72bd7f7 Improve printing of pattern synonym types f2a2b79 Deeply instantiate in :type 90d7d60 rts: Make StablePtr derefs thread-safe (#10296) b3ecd04 Elaborate test for #11376 9b6820c Bump binary submodule 7407a66 Don't infer CallStacks 2f3b803 Use exprCtOrigin in tcRnExpr 1e6ec12 Fix misattribution of `-Wunused-local-binds` warnings 351f976 T10272, T4340: Add 32-bit output 726cbc2 T10870: Skip on 32-bit architectures 1a8d61c testsuite: Update 32-bit performance numbers 2265c84 Core pretty printer: Omit wild case binders 5b986a4 CSE code cleanup and improvement 0f58d34 Demand Analyzer: Do not set OneShot information (second try) c9e8f80 Set tct_closed to TopLevel for closed bindings. eda273b runtime: replace hw.ncpu with hw.logicalcpu for Mac OS X 27528b3 Adjust performance numbers 06b7ce2 testsuite: One more 32-bit performance slip 6b6beba Fix installation of static sphinx assets 535896e rts: Fix parsing of profiler selectors 2bcf0c3 Revert "testsuite: One more 32-bit performance slip" eca8648 GHC.Base: Use thenIO in instance Applicative IO f0af351 Remove obsolete comment about the implementation of foldl f9d26e5 Fix a comment: triple -> tuple 485608d Refactor comments about shutdown c4a7520 Provide an optimized replicateM_ implementation #11795 90d66de Add doc to (<=<) comparing its type to (.) f3beed3 Remove left-over shell-tools.c 6d7fda5 Remove spurious STG_UNUSED annotation 2f82da7 Fix Template Haskell bug reported in #11809. d2e05c6 Reduce default for -fmax-pmcheck-iterations from 1e7 to 2e6 5a1add1 Export zonkEvBinds from TcHsSyn. 470d4d5 Fix suggestions for unbound variables (#11680) cf5ff08 Bump haddock submodule ad532de base: Fix "since" annotation on GHC.ExecutionStack 7443e5c Remove the instantiation check when deriving Generic(1) 378091c RtsFlags: Un-constify temporary buffer 8987ce0 Typos in Note 90538d8 Change runtime linker to perform lazy loading of symbols/sections 46e8f19 Fix a closed type family error message 02a5c58 Filter out invisible kind arguments during TH reification 8b57cac Added (more) missing instances for Identity and Const aadde2b Deriving Functor-like classes should unify kind variables 2ef35d8 Use `@since` annotation in GHC.ExecutionStack c6e579b Add linker notes 83eb4fd Small simplification (#11777) 5c4cd0e Cache the size of part_list/scavd_list (#11783) f4446c5 Allocate blocks in the GC in batches b1084fd Fix #11811. dd99f2e Fix #11797. 0b6dcf6 Fix #11814 by throwing more stuff into InScopeSets d81cdc2 Teach lookupLocalRdrEnv about Exacts. (#11813) 49560ba Fix commented out debugging code in ByteCodeGen 227a29d Fix typos: tyars -> tyvars 20f9056 Remove some old commented out code in StgLint 3a34b5c Add a test case for #11731. f4fd98c Add a final demand analyzer run right before TidyCore 928d747 Kill some unnecessary varSetElems 2acfaae Comments only e24b3b1 Adjust error check for class method types 31e4974 Remove some gratitious varSetElemsWellScoped 8d66765 Increase an InScopeSet for a substitution aaaa61c users-guide: Note change in LLVM support policy 10c6df0 utils: Provide CallStack to expectJust 116088d testsuite: Add T11824 cb0d29b testsuite: Add test for #11827 9d063b6 Linker: Fix signedness mismatch 933abfa rel-notes: Add note about UndecidableSuperClasses and #11762 54e67c1 Remove dead function SimplUtils.countValArgs f0e331b Comments only, on Type.topSortTyVars a7ee2d4 Improve TcFlatten.flattenTyVar e9ad489 libdw: More precise version check d77981e rts/RetainerProfile: Remove unused local bf17fd0 deriveConstants: Verify sanity of nm f4e6591 Bump haddock submodule 865602e Rework CC/CC_STAGE0 handling in `configure.ac` 3f3ad75 Update `directory` submodule to v1.2.6.0 release 4cbae1b Update array submodule to v0.5.1.1 release tag 97f2b16 Add Windows import library support to the Runtime Linker 04b70cd Add TemplateHaskell support for Overlapping pragmas 89b6674 TH: Tweak Haddock language 7a1c073 users-guide: Fix typo 07dc330 validate: Note existence of config_args variable 7005b9f Add flag to control number of missing patterns in warnings 36a0b6d Check CCS tree for pointers into shared object during checkUnload 177aec6 Linker: Clean up #if USE_MMAP usage a392208 Resolve symlinks when attempting to find GHC's lib folder on Windows 93d85af Update `directory` submodule to v1.2.6.1 release dd920e4 Silence unused-import warning introduced by 93d85af9fec968b 8a75bb5 Update haskeline submodule to 0.7.2.3 release 3dac53f Make it easy to get hyperlinked sources 10d808c relnotes: Add note about #11744 and workaround 87114ae Use stdint types to define SIZEOF and ALIGNMENT of INTx/WORDx 32ddd96 Remove obsolete/redundant FLEXIBLE_ARRAY macro 350ffc3 rts: Limit maximum backtrace depth d1ce35d rts: Don't use strndup 8556f56 Update `directory` submodule to v1.2.6.2 release a3c37c3 Remove unused import of emptyNameEnv d59939a Define TyCoRep.ppSuggestExplicitKinds, and use it 17eb241 Refactor computing dependent type vars 8136a5c Tighten checking for associated type instances 9de405d Kill dead TauTvFlavour, and move code around 81e2279 Update hsc2hs submodule 91ee509 Mark GHC.Stack.Types Trustworthy 96e1bb4 Update deepseq submodule to latest 1.4.2.0 snapshot ff290b8 Update binary submodule to 0.8.3.0 release 15b7e87 Update `pretty` submodule to v1.1.3.3 release 81b14c1 Update unix submodule to v2.7.2.0 release 7f71dbe Bump haddock submodule 81aa3d1 Reduce use of instances in hs-boot files 871f684 Define NameSet.intersectFVs 7319b80 Tighten up imports, white space 353d8ae SCC analysis for instances as well as types/classes 61191de Fix two buglets in 17eb241 noticed by Richard cdcf014 Tighten up imports on TcTyClsDecls 687c778 Kill unnecessary varSetElemsWellScoped in deriveTyData 62943d2 Build a correct substitution in dataConInstPat 55b1b85 Accept tcrun045 output 2e33320 Rename FV related functions 98a14ff Point to note about FV eta-expansion performance 7c6585a Remove mysterious varSetElemsWellScoped in tidyFreeTyCoVars 8c33cd4 testsuite: Bump max bytes used of T4029 f02af79 Improve the behaviour of warnIf edf54d7 Do not use defaulting in ambiguity check 9421b0c Warn about simplifiable class constraints 251a376 Test Trac #3990 26a1804 wibble to simplifiable 24d3276 A little more debug tracing c2b7a3d Avoid double error on out-of-scope identifier 970ff58 Simplify defaultKindVar and friends 6ad2b42 Refactor free tyvars on LHS of rules ed4a228 Fix typos: alpah -> alpha 4221cc2 Typo: veraibles -> variables a9076fc Remove unused tyCoVarsOfTelescope 0f96686 Make benign non-determinism in pretty-printing more obvious 03006f5 Get rid of varSetElemsWellScoped in abstractFloats 28503fe deriveConstants: Fix nm-classic error message e8c04d4 Testsuite: Delete test for deprecated "packedstring" dadf82d Testsuite: fixup lots of tests 2a83713 Testsuite: delete Roles9.stderr fd5212f Testsuite: delete unused concurrent/prog002/FileIO.hs c9bcaf3 Kill varSetElemsWellScoped in quantifyTyVars e68195a RTS: Add setInCallCapability() 95f9334 GHCi: use real time instead of CPU time for :set -s d396996 Doc improvement for ApplicativeDo 24864ba Use __builtin_clz() to implement log_2() 0712f55 Just comments & reformatting 2dc5b92 Kill varSetElems in TcErrors 94320e1 Kill varSetElems try_tyvar_defaulting f13a8d2 Kill varSetElems in markNominal a48ebcc Implement the state hack without modifiyng OneShotInfo 5adf8f3 Document -fmax-pmcheck-iterations a bit better a0e1051 Recommend more reliable recourse for broken nm 57c636f Update nofib submodule to nofib master fa3ba06 Expand the comment on pprVarSet 82538f6 Kill varSetElems in injImproveEqns af6dced Comments only a2abcf6 Minor improvement to error message 1e86cab Comments only 9ed57d6 Remove unused unifyType_ 4c746cb Add missing solveEqualities 3dce4f2 Refactor RecordPatSynField, FieldLabel c4dd4ae Better documentation of -XConstrainedClassMethods c5b1014 Fix debug-only check in CoreLint 546f24e Revert "Use __builtin_clz() to implement log_2()" 3a53380 Kill unused foldOccSet 196ce62 Testsuite: delete accidentally committed .stderr.normalised file 89c6d07 Testsuite: add -ignore-dot-ghci to some ghci tests [skip ci] 9dc34d3 Testsuite: fix T11223_simple_(unused_)duplicate_lib b0569e8 Testsuite: benign test fixes 3c426b0 Add uniqSetAny and uniqSetAll and use them 7312923 Kill mapUniqSet 32c0aba Testsuite: delete -fesc tests e20b3ed Testsuite: delete T5054 and T5054_2 (#5054) bcfee21 rts/LdvProfile.c: Fix NULL dereference on shutdown f255f80 Linker: Fix implicit function declaration warning on OS X 6e195f4 Remove unused foldFsEnv 031de8b Remove unused foldNameEnv f99db38 Fix path to the new build system, now called Hadrian. 0fa1d07 testsuite: fix up T11223's Makefile a2970f8 RTS: delete BlockedOnGA* + dead code c5919f7 Remove the incredibly hairy splitTelescopeTvs. 7242582 Test #11484 in th/T11484 00053ee Fix typo: Superclases -> Superclasses b725fe0 PPC NCG: Improve pointer de-tagging code c4259ff Testsuite: make CLEANUP=1 the default (#9758) 2ae39ac Testsuite: accept new output for 2 partial-sigs tests 2fe7a0a Fix reference to Note in TcCanonical cb05860 Comment typos: Mkae -> Make, Hsakell -> Haskell 49bae46 Comment typo: unambigious -> unambiguous f69e707 Typos in DmdAnal e6627d1 Fix aggressive cleanup of T1407 868d2c4 rts: Remove deprecated C type `lnat` eac6967 users-guide: Add index entry for "environment file" 18676a4 Bump haddock submodule 533037c Greater customization of GHCi prompt 16a51a6 rts: Close livelock window due to rapid ticker enable/disable 65e13f6 rts: Split up Itimer.c df9b772 Catch errors from timerfd_settime 55f4009 Kill Itimer.h 999c464 rts/itimer/pthread: Stop timer when ticker is stopped 116d3fe Remove unused getScopedTyVarBinds 1161932 Add T11747 as a test ecc0603 deriveConstants: Fix nm advice one last time a28611b Export constructors for IntPtr and WordPtr ea34f56 Remove unused equivClassesByUniq cd85dc8 Make sure record pattern synonym selectors are in scope in GHCi. db2bfe0 added docstring for '-fhistory-size' flag 81d8a23 glasgow_exts.rst: fix quoting c5be5e2 docs/users_guide/glasgow_exts.rst: fix merge conflict fa86ac7 Make validDerivPred ignore non-visible arguments to a class type constructor 36d29f7 StaticPointers: Allow closed vars in the static form. 5f8c0b8 Revert "Revert "Use __builtin_clz() to implement log_1()"" ef44606 Cleanups related to MAX_FREE_LIST 0051ac1 Update libraries/hpc submodule to v0.6.0.3 release tag 4466ae6 Update bytestring submodule to 0.10.8.0 release tag 50e7055 Export oneShot from GHC.Exts f9d9375 Adjust testsuite output to bytestring-0.10.8.0 76ee260 Allow limiting the number of GC threads (+RTS -qn) f703fd6 Add +RTS -AL 1fa92ca schedulePushWork: avoid unnecessary wakeups dbcaa8c Don't STATIC_INLINE giveCapabilityToTask aa5e2dd Make 'make fast' work for the User Guide b75d194 Be more aggressive when checking constraints for custom type errors. 4f2afe1 testsuite: Add test for #11959 763610e base: Export runRW# from GHC.Exts ad4392c Kill non-deterministic foldUFM in TrieMap and TcAppMap db9de7e rts: Replace `nat` with `uint32_t` e340520 Comments only explaining export list parsing. 94f2ee1 Explain linter optimization for StaticPtr checks. 990ce8c Use tcExtendGlobalValEnv for default methods ecc1d58 Update Win32 submodule to v2.3.1.1 release tag 018487e Fix pretty printing of IEThingWith fe190ae Remove trailing whitespace from 'testsuite/tests/module/all.T' 633b099 Update time submodule to 1.6.0.1 release tag 8e5776b rts/ProfHeap.c: Use `ssize_t` instead of `long`. dd3e847 Documentation for simplifyDeriv. 260a564 Use stdint types for Stg{Word,Int}{8,16,32,64} 2593e20 White space only 76d9156 Emit wild-card constraints in the right place cc75a5d Comments only e1ff2b4 Fix partial sigs and pattern bindings interaction 9dbf5f5 Tidy up partial-sig quantification bb296bf Error message wibbles, re partial type sigs 0597493 Re-do the invariant for TcDepVars 3ca7806 stg/Types.h: Fix comment and #include 53f26f5 Forbid variables to be parents in import lists. e996e85 RdrHsSyn: Only suggest `type` qualification when appropriate ea3d1ef Fix a crash in requestSync() bff6e1b Comments only 4ac0e81 Kill unnecessary cmpType in lhs_cmp_type b58b0e1 Make simplifyInstanceContexts deterministic a4717f5 Comments about static forms b21e8cc Comments only e7e5939 Add Outputable ShowHowMuch e24b50c Use partial-sig constraints as givens 1a43783 Record that EqualityConstraint now works f6e58be Test Trac #11640 7e28e47 Get rid of Traversable UniqFM and Foldable UniqFM 402f201 Fix typos ab91b85 make accept for Make simplifyInstanceContexts deterministic e207198 Kill foldUFM in classifyTyCon 8669c48 Document why closeOverKind is OK for determinism 584ade6 RtsFlags: Make `mallocFailHook` const correct 0efbf18 rts: Fix C compiler warnings on Windows 9363f04 Handle promotion failures when scavenging a WEAK (#11108) 0e71988 Remove some varSetElems in dsCmdStmt 3edbd09 Document SCC determinism cfc5df4 Fix ASSERT failure and re-enable setnumcapabilities001 2a0d00d Make random an "extra" package 86a1f20 Remove a copy of System.Random and use reqlib('random') b5f85ce Remove stale comment. da105ca Don't prematurely force TyThing thunks with -ddump-if-trace. 925b0ae Make absentError not depend on uniques eae3362 docs: add skeleton 8.2.1 release notes e217287 Bump haddock submodule c079de3 Add TH support for pattern synonyms (fixes #8761) e53f218 Fix deriveTyData's kind unification when two kind variables are unified b8e2565 Make Generic1 poly-kinded 6971430 Allow putting Haddocks on derived instances 01bc109 Document zonkTyCoVarsAndFV determinism 6bf0eef Kill varEnvElts in specImports 69c974f Use StgHalfWord instead of a CPP #if 995cf0f rts: Make function pointer parameters `const` where possible 0c0129b RtsUtils: Use `size_t` instead of `int` where appropriate 7c0b595 Fix comments about scavenging WEAK objects 5416fad Refactor some ppr functions to use pprUFM bd01bbb Test Trac #12039 8e48d24 Bump haddock submodule e4834ed Fix a performance issue with -fprint-expanded-synonyms c974927 Update bytestring submodule to 0.10.8.1 release tag bf669a0 Bump haddock submodule 2dbdc79 PPC NCG: Fix pretty printing of st[wd]ux instr. 563a485 PPC: Implement SMP primitives using gcc built-ins d78faa1 testsuite/ImpSafe03: Normalize version of bytestring eed820b Move Extension type to ghc-boot-th 21fe4ff Kill varSetElems in tcInferPatSynDecl d20d843 Another bump of haddock submodule 7814420 Remove html_theme requirement of haddock docs 4a037a9 Set `USE_MMAP` at configure time 770d708 Add ghc-boot-th to rules/foreachLibrary dc94914 Document determinism in shortOutIndirections 3f3dc23 Testsuite: run tests in /tmp after copying required files 1a9ae4b Testsuite: delete old cleanup code (#11980) a9dd9b7 Testsuite: delete unused file [skip ci] c92cfbc Testsuite: don't skip concio001 and concio001_thr 931b3c7 Delete libraries/ghci/GNUmakefile [skip ci] a54d87a rules: Fix name of ghc-boot-th library 5d80d14 rules/build-prog: Ensure programs depend upon their transitive deps 33c029d rts: More const correct-ness fixes b088c02 Testsuite: T10052 requires interpreter (#11730) 3251743 Testsuite: don't warn when mk/ghcconfig_* hasn't been created yet 77ee3a9 Update .mailmap [skip ci] fffe3a2 Make inert_model and inert_eqs deterministic sets f0f0ac8 Fix histograms for ticky code ba3e1fd Add a test for #11108 39a2faa Rework parser to allow use with DynFlags 310371f rts: Add isPinnedByteArray# primop f091218 CLabel: Catch #11155 during C-- pretty-printing 9dd0481 Add (broken) test for #12063. 5f1557e Failing test case for #12076. f18e8d8 rts: Add missing `const` from HashTable API 6282bc3 Kill varSetElems in tidyFreeTyCoVars 13e40f9 Kill varEnvElts in tcPragExpr 72b677d Fix Trac #12051 ad7f122 Improve pretty-printing of equalities f9e90bc Improve documentation for type wildcards 0bfcfd0 Comments only d1efe86 Comments only 358567a testsuite: Add expected output for T11108 470def9 Testsuite: fix T11827 (#11827) 296b8f1 Add libraries/ghci/GNUmakefile to .gitignore [skip ci] f0f3517 Remove use of caddr_t 8abc193 Get types in osFreeMBlocks in sync with osGetMBlocks 464b6f8 {,M}BLOCK_SIZE_W * sizeof(W_) -> {,M}BLOCK_SIZE 2e6433a testsuite: Add a TypeRep test a88bb1b Give lifted primitive types a representation 1ee47c1 Use the correct return type for Windows' send()/recv() (Fix #12010) 809a3bf HACK: CoreLint: Kill unsaturated unlifted types check 1333b6a TcSMonad: Introduce tcLookupId 1b87cad Outputable: Refactor handling of CallStacks 84b0f2e CoreLint: Improve debug output 4b0ee4e Start implementing library side of TTypeable 6b173f2 Fix rebase 4c99c66 Add quick compatibility note 5803a58 Fix warnings 2dd3c5e Various fixes f8a4d5d Fix serialization 33eb10c Implement Data.Typeable.funResultTy 12cd07d Binary: More explicit pattern matching 3b2ed2e More serialization e897633 Message: Import Data.Typeable.TypeRep 6e10f55 TcInteract: Unused parameter 58b2cf7 Fix a few TTypeRep references 2f12211 Fix recursive fingerprints 9c8dd2d Finally serialization is both general and correct 6667e59 Break recursive loop in serialization 8801237 Kill todo 5012264 Fix up representation pretty-printer c9751b0 Another recursive serialization case 3a56be1 TcTypeable: Don't generate bindings for special primitive tycons afb34f3 Move special tycons f60679d Internal things b347d60 Fix primitive types ae746a3 Fix pretty-printer c3dc056 Kill debugShow f3931e6 Inline space 7a3f742 Accept easy test output 7fd93c8 Add mkFunTy 8960738 More test fixes 54eb46f Fix T8132 2c406cb Render TYPE 'PtrRepLifted as * 0217f61 Internal: Rename type variable d8efe39 Implement withTypeable f5c4fd7 Bump base to 4.10.0 d3ef4f2 Fix withTypeable 324ea2d Bump base 78d7d9a testsuite: Bump base version From git at git.haskell.org Mon Jun 6 12:56:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 12:56:52 +0000 (UTC) Subject: [commit: ghc] master: Implement deterministic CallInfoSet (48e9a1f) Message-ID: <20160606125652.B133B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/48e9a1f5521fa3185510d144dd28a87e452ce134/ghc >--------------------------------------------------------------- commit 48e9a1f5521fa3185510d144dd28a87e452ce134 Author: Bartosz Nitka Date: Mon Jun 6 04:36:21 2016 -0700 Implement deterministic CallInfoSet We need CallInfoSet to be deterministic because it determines the order that the binds get generated. Currently it's not deterministic because it's keyed on `CallKey = [Maybe Type]` and `Ord CallKey` is implemented with `cmpType` which is nondeterministic. See Note [CallInfoSet determinism] for more details. Test Plan: ./validate Reviewers: simonpj, bgamari, austin, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2242 GHC Trac Issues: #4012 >--------------------------------------------------------------- 48e9a1f5521fa3185510d144dd28a87e452ce134 compiler/specialise/Specialise.hs | 111 +++++++++++++++++++++++++------------- 1 file changed, 74 insertions(+), 37 deletions(-) diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index 5c76f23..84f8b62 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -36,14 +36,12 @@ import Outputable import FastString import State import UniqDFM +import TrieMap import Control.Monad #if __GLASGOW_HASKELL__ > 710 import qualified Control.Monad.Fail as MonadFail #endif -import Data.Map (Map) -import qualified Data.Map as Map -import qualified FiniteMap as Map {- ************************************************************************ @@ -660,10 +658,10 @@ specImports dflags this_mod top_env done callers rule_base cds where go :: RuleBase -> [CallInfoSet] -> CoreM ([CoreRule], [CoreBind]) go _ [] = return ([], []) - go rb (CIS fn calls_for_fn : other_calls) + go rb (cis@(CIS fn _calls_for_fn) : other_calls) = do { (rules1, spec_binds1) <- specImport dflags this_mod top_env done callers rb fn $ - Map.toList calls_for_fn + ciSetToList cis ; (rules2, spec_binds2) <- go (extendRuleBaseList rb rules1) other_calls ; return (rules1 ++ rules2, spec_binds1 ++ spec_binds2) } @@ -1728,19 +1726,71 @@ type CallDetails = DIdEnv CallInfoSet -- The order of specialized binds and rules depends on how we linearize -- CallDetails, so to get determinism we must use a deterministic set here. -- See Note [Deterministic UniqFM] in UniqDFM -newtype CallKey = CallKey [Maybe Type] -- Nothing => unconstrained type argument - --- CallInfo uses a Map, thereby ensuring that --- we record only one call instance for any key --- --- The list of types and dictionaries is guaranteed to --- match the type of f -data CallInfoSet = CIS Id (Map CallKey ([DictExpr], VarSet)) - -- Range is dict args and the vars of the whole - -- call (including tyvars) - -- [*not* include the main id itself, of course] +newtype CallKey = CallKey [Maybe Type] + -- Nothing => unconstrained type argument + +data CallInfoSet = CIS Id (Bag CallInfo) + -- The list of types and dictionaries is guaranteed to + -- match the type of f + +{- +Note [CallInfoSet determinism] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +CallInfoSet holds a Bag of (CallKey, [DictExpr], VarSet) triplets for a given +Id. They represent the types that the function is instantiated at along with +the dictionaries and free variables. + +We use this information to generate specialized versions of a given function. +CallInfoSet used to be defined as: + + data CallInfoSet = CIS Id (Map CallKey ([DictExpr], VarSet)) + +Unfortunately this was not deterministic. The Ord instance of CallKey was +defined in terms of cmpType which is not deterministic. +See Note [cmpType nondeterminism]. +The end result was that if the function had multiple specializations they would +be generated in arbitrary order. + +We need a container that: +a) when turned into a list has only one element per each CallKey and the list +has deterministic order +b) supports union +c) supports singleton +d) supports filter + +We can't use UniqDFM here because there's no one Unique that we can key on. + +The current approach is to implement the set as a Bag with duplicates. +This makes b), c), d) trivial and pushes a) towards the end. The deduplication +is done by using a TrieMap for membership tests on CallKey. This lets us delete +the nondeterministic Ord CallKey instance. + +An alternative approach would be to augument the Map the same way that UniqDFM +is augumented, by keeping track of insertion order and using it to order the +resulting lists. It would mean keeping the nondeterministic Ord CallKey +instance making it easy to reintroduce nondeterminism in the future. +-} + +ciSetToList :: CallInfoSet -> [CallInfo] +ciSetToList (CIS _ b) = snd $ foldrBag combine (emptyTM, []) b + where + -- This is where we eliminate duplicates, recording the CallKeys we've + -- already seen in the TrieMap. See Note [CallInfoSet determinism]. + combine :: CallInfo -> (CallKeySet, [CallInfo]) -> (CallKeySet, [CallInfo]) + combine ci@(CallKey key, _) (set, acc) + | Just _ <- lookupTM key set = (set, acc) + | otherwise = (insertTM key () set, ci:acc) + +type CallKeySet = ListMap (MaybeMap TypeMap) () + -- We only use it in ciSetToList to check for membership + +ciSetFilter :: (CallInfo -> Bool) -> CallInfoSet -> CallInfoSet +ciSetFilter p (CIS id a) = CIS id (filterBag p a) type CallInfo = (CallKey, ([DictExpr], VarSet)) + -- Range is dict args and the vars of the whole + -- call (including tyvars) + -- [*not* include the main id itself, of course] instance Outputable CallInfoSet where ppr (CIS fn map) = hang (text "CIS" <+> ppr fn) @@ -1758,24 +1808,12 @@ ppr_call_key_ty (Just ty) = char '@' <+> pprParendType ty instance Outputable CallKey where ppr (CallKey ts) = ppr ts --- Type isn't an instance of Ord, so that we can control which --- instance we use. That's tiresome here. Oh well -instance Eq CallKey where - k1 == k2 = case k1 `compare` k2 of { EQ -> True; _ -> False } - -instance Ord CallKey where - compare (CallKey k1) (CallKey k2) = cmpList cmp k1 k2 - where - cmp Nothing Nothing = EQ - cmp Nothing (Just _) = LT - cmp (Just _) Nothing = GT - cmp (Just t1) (Just t2) = cmpType t1 t2 - unionCalls :: CallDetails -> CallDetails -> CallDetails unionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2 unionCallInfoSet :: CallInfoSet -> CallInfoSet -> CallInfoSet -unionCallInfoSet (CIS f calls1) (CIS _ calls2) = CIS f (calls1 `Map.union` calls2) +unionCallInfoSet (CIS f calls1) (CIS _ calls2) = + CIS f (calls1 `unionBags` calls2) callDetailsFVs :: CallDetails -> VarSet callDetailsFVs calls = @@ -1784,14 +1822,15 @@ callDetailsFVs calls = -- immediately by converting to a nondeterministic set. callInfoFVs :: CallInfoSet -> VarSet -callInfoFVs (CIS _ call_info) = Map.foldRight (\(_,fv) vs -> unionVarSet fv vs) emptyVarSet call_info +callInfoFVs (CIS _ call_info) = + foldrBag (\(_, (_,fv)) vs -> unionVarSet fv vs) emptyVarSet call_info ------------------------------------------------------------ singleCall :: Id -> [Maybe Type] -> [DictExpr] -> UsageDetails singleCall id tys dicts = MkUD {ud_binds = emptyBag, ud_calls = unitDVarEnv id $ CIS id $ - Map.singleton (CallKey tys) (dicts, call_fvs) } + unitBag (CallKey tys, (dicts, call_fvs)) } where call_fvs = exprsFreeVars dicts `unionVarSet` tys_fvs tys_fvs = tyCoVarsOfTypes (catMaybes tys) @@ -2044,7 +2083,7 @@ callsForMe fn (MkUD { ud_binds = orig_dbs, ud_calls = orig_calls }) , ud_calls = delDVarEnv orig_calls fn } calls_for_me = case lookupDVarEnv orig_calls fn of Nothing -> [] - Just (CIS _ calls) -> filter_dfuns (Map.toList calls) + Just cis -> filter_dfuns (ciSetToList cis) dep_set = foldlBag go (unitVarSet fn) orig_dbs go dep_set (db,fvs) | fvs `intersectsVarSet` dep_set @@ -2078,11 +2117,9 @@ splitDictBinds dbs bndr_set deleteCallsMentioning :: VarSet -> CallDetails -> CallDetails -- Remove calls *mentioning* bs deleteCallsMentioning bs calls - = mapDVarEnv filter_calls calls + = mapDVarEnv (ciSetFilter keep_call) calls where - filter_calls :: CallInfoSet -> CallInfoSet - filter_calls (CIS f calls) = CIS f (Map.filter keep_call calls) - keep_call (_, fvs) = not (fvs `intersectsVarSet` bs) + keep_call (_, (_, fvs)) = not (fvs `intersectsVarSet` bs) deleteCallsFor :: [Id] -> CallDetails -> CallDetails -- Remove calls *for* bs From git at git.haskell.org Mon Jun 6 13:03:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 13:03:42 +0000 (UTC) Subject: [commit: ghc] master: Add @since annotations to base instances (a90085b) Message-ID: <20160606130342.413633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a90085bd45239fffd65c01c24752a9bbcef346f1/ghc >--------------------------------------------------------------- commit a90085bd45239fffd65c01c24752a9bbcef346f1 Author: Seraphime Kirkovski Date: Mon Jun 6 12:29:38 2016 +0200 Add @since annotations to base instances Add @since annotations to instances in `base`. Test Plan: * ./validate # some commets shouldn't break the build * review the annotations for absurdities. Reviewers: ekmett, goldfire, RyanGlScott, austin, hvr, bgamari Reviewed By: RyanGlScott, hvr, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2277 GHC Trac Issues: #11767 >--------------------------------------------------------------- a90085bd45239fffd65c01c24752a9bbcef346f1 libraries/base/Control/Applicative.hs | 7 ++ libraries/base/Control/Arrow.hs | 17 ++++ libraries/base/Control/Category.hs | 3 + libraries/base/Control/Exception.hs | 1 + libraries/base/Control/Exception/Base.hs | 16 ++++ libraries/base/Control/Monad/Fail.hs | 3 + libraries/base/Control/Monad/Fix.hs | 16 ++++ libraries/base/Control/Monad/IO/Class.hs | 1 + libraries/base/Control/Monad/ST/Lazy/Imp.hs | 4 + libraries/base/Control/Monad/Zip.hs | 14 +++ libraries/base/Data/Bifunctor.hs | 9 ++ libraries/base/Data/Bits.hs | 10 ++- libraries/base/Data/Complex.hs | 6 ++ libraries/base/Data/Data.hs | 101 ++++++++++++++++++++++ libraries/base/Data/Dynamic.hs | 2 + libraries/base/Data/Either.hs | 3 + libraries/base/Data/Fixed.hs | 23 +++++ libraries/base/Data/Foldable.hs | 14 +++ libraries/base/Data/Functor/Classes.hs | 36 ++++++++ libraries/base/Data/Functor/Compose.hs | 13 +++ libraries/base/Data/Functor/Const.hs | 7 ++ libraries/base/Data/Functor/Identity.hs | 10 +++ libraries/base/Data/Functor/Product.hs | 20 +++++ libraries/base/Data/Functor/Sum.hs | 11 +++ libraries/base/Data/List/NonEmpty.hs | 8 ++ libraries/base/Data/Monoid.hs | 18 ++++ libraries/base/Data/Ord.hs | 1 + libraries/base/Data/Proxy.hs | 12 +++ libraries/base/Data/Semigroup.hs | 78 +++++++++++++++++ libraries/base/Data/String.hs | 4 + libraries/base/Data/Traversable.hs | 20 +++++ libraries/base/Data/Type/Coercion.hs | 5 ++ libraries/base/Data/Type/Equality.hs | 5 ++ libraries/base/Data/Typeable/Internal.hs | 3 + libraries/base/Data/Version.hs | 2 + libraries/base/Data/Void.hs | 6 ++ libraries/base/Foreign/C/Error.hs | 1 + libraries/base/Foreign/C/Types.hs | 1 + libraries/base/Foreign/Storable.hs | 20 +++++ libraries/base/GHC/Arr.hs | 17 +++- libraries/base/GHC/Base.hs | 34 +++++++- libraries/base/GHC/Conc/Sync.hs | 9 ++ libraries/base/GHC/Enum.hs | 29 +++++++ libraries/base/GHC/Event/EPoll.hsc | 1 + libraries/base/GHC/Event/Internal.hs | 5 ++ libraries/base/GHC/Event/KQueue.hsc | 2 + libraries/base/GHC/Event/PSQ.hs | 1 + libraries/base/GHC/Event/Poll.hsc | 1 + libraries/base/GHC/Event/Unique.hs | 1 + libraries/base/GHC/Exception.hs | 6 ++ libraries/base/GHC/Exts.hs | 1 + libraries/base/GHC/Fingerprint/Type.hs | 1 + libraries/base/GHC/Float.hs | 16 ++++ libraries/base/GHC/ForeignPtr.hs | 3 + libraries/base/GHC/GHCi.hs | 5 ++ libraries/base/GHC/Generics.hs | 70 +++++++++++++++ libraries/base/GHC/IO/Encoding/CodePage/API.hs | 1 + libraries/base/GHC/IO/Encoding/Types.hs | 1 + libraries/base/GHC/IO/Exception.hs | 22 +++++ libraries/base/GHC/IO/FD.hs | 4 + libraries/base/GHC/IO/Handle.hs | 2 + libraries/base/GHC/IO/Handle/Types.hs | 3 + libraries/base/GHC/IOArray.hs | 1 + libraries/base/GHC/IORef.hs | 1 + libraries/base/GHC/Int.hs | 56 ++++++++++++ libraries/base/GHC/MVar.hs | 1 + libraries/base/GHC/Natural.hs | 16 ++++ libraries/base/GHC/Num.hs | 3 + libraries/base/GHC/Ptr.hs | 2 + libraries/base/GHC/RTS/Flags.hsc | 4 + libraries/base/GHC/Read.hs | 28 ++++++ libraries/base/GHC/Real.hs | 13 +++ libraries/base/GHC/ST.hs | 4 + libraries/base/GHC/STRef.hs | 1 + libraries/base/GHC/Show.hs | 23 +++++ libraries/base/GHC/Stable.hs | 1 + libraries/base/GHC/StaticPtr.hs | 1 + libraries/base/GHC/TypeLits.hs | 8 ++ libraries/base/GHC/Word.hs | 54 ++++++++++++ libraries/base/System/Console/GetOpt.hs | 3 + libraries/base/System/Mem/StableName.hs | 1 + libraries/base/System/Timeout.hs | 2 + libraries/base/Text/ParserCombinators/ReadP.hs | 11 +++ libraries/base/Text/ParserCombinators/ReadPrec.hs | 6 ++ libraries/base/Text/Printf.hs | 22 +++++ libraries/base/Text/Show/Functions.hs | 1 + libraries/base/codepages/MakeTable.hs | 4 + 87 files changed, 1029 insertions(+), 4 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 a90085bd45239fffd65c01c24752a9bbcef346f1 From git at git.haskell.org Mon Jun 6 13:46:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 13:46:01 +0000 (UTC) Subject: [commit: ghc] master: Desugar ApplicativeDo and RecDo deterministically (e684f54) Message-ID: <20160606134601.73B453A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e684f5469399b9d239693eb54f9d1b4d55253ac4/ghc >--------------------------------------------------------------- commit e684f5469399b9d239693eb54f9d1b4d55253ac4 Author: Bartosz Nitka Date: Mon Jun 6 06:08:54 2016 -0700 Desugar ApplicativeDo and RecDo deterministically This fixes a problem described in Note [Deterministic ApplicativeDo and RecursiveDo desugaring]. Test Plan: ./validate + new testcase Reviewers: simonpj, bgamari, austin, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2287 GHC Trac Issues: #4012 >--------------------------------------------------------------- e684f5469399b9d239693eb54f9d1b4d55253ac4 compiler/basicTypes/Name.hs | 4 +- compiler/basicTypes/NameSet.hs | 2 + compiler/rename/RnExpr.hs | 43 +++++++++++++--- testsuite/driver/extra_files.py | 1 + testsuite/tests/determinism/determ019/A.hs | 57 ++++++++++++++++++++++ .../determinism/{determ018 => determ019}/Makefile | 2 +- .../determinism/{determ010 => determ019}/all.T | 4 +- .../determ019.stdout} | 0 8 files changed, 102 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 e684f5469399b9d239693eb54f9d1b4d55253ac4 From git at git.haskell.org Mon Jun 6 13:51:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 13:51:12 +0000 (UTC) Subject: [commit: ghc] master: Kill nameSetElems (31ba8d6) Message-ID: <20160606135112.15ABD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/31ba8d645d24b16324eb66fd07f007710fdd8ba9/ghc >--------------------------------------------------------------- commit 31ba8d645d24b16324eb66fd07f007710fdd8ba9 Author: Bartosz Nitka Date: Mon Jun 6 06:53:25 2016 -0700 Kill nameSetElems nameSetElems used `eltsUFM` which is nondeterministic. Test Plan: ./validate Reviewers: simonmar, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2305 GHC Trac Issues: #4012 >--------------------------------------------------------------- 31ba8d645d24b16324eb66fd07f007710fdd8ba9 compiler/basicTypes/NameSet.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/compiler/basicTypes/NameSet.hs b/compiler/basicTypes/NameSet.hs index 7bfd915..0ab4ec0 100644 --- a/compiler/basicTypes/NameSet.hs +++ b/compiler/basicTypes/NameSet.hs @@ -10,7 +10,7 @@ module NameSet ( -- ** Manipulating these sets emptyNameSet, unitNameSet, mkNameSet, unionNameSet, unionNameSets, - minusNameSet, elemNameSet, nameSetElems, extendNameSet, extendNameSetList, + minusNameSet, elemNameSet, extendNameSet, extendNameSetList, delFromNameSet, delListFromNameSet, isEmptyNameSet, filterNameSet, intersectsNameSet, intersectNameSet, nameSetAny, nameSetAll, nameSetElemsStable, @@ -57,7 +57,6 @@ unionNameSet :: NameSet -> NameSet -> NameSet unionNameSets :: [NameSet] -> NameSet minusNameSet :: NameSet -> NameSet -> NameSet elemNameSet :: Name -> NameSet -> Bool -nameSetElems :: NameSet -> [Name] isEmptyNameSet :: NameSet -> Bool delFromNameSet :: NameSet -> Name -> NameSet delListFromNameSet :: NameSet -> [Name] -> NameSet @@ -77,7 +76,6 @@ unionNameSet = unionUniqSets unionNameSets = unionManyUniqSets minusNameSet = minusUniqSet elemNameSet = elementOfUniqSet -nameSetElems = uniqSetToList delFromNameSet = delOneFromUniqSet filterNameSet = filterUniqSet intersectNameSet = intersectUniqSets From git at git.haskell.org Mon Jun 6 15:19:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 15:19:19 +0000 (UTC) Subject: [commit: ghc] master: Document putDictionary determinism (46d2da0) Message-ID: <20160606151919.27D333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/46d2da00ddb8756d966a5ba491b618367911de0f/ghc >--------------------------------------------------------------- commit 46d2da00ddb8756d966a5ba491b618367911de0f Author: Bartosz Nitka Date: Mon Jun 6 07:38:03 2016 -0700 Document putDictionary determinism Summary: Like explained in the comment it's OK here. Test Plan: ./validate Reviewers: simonmar, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2306 GHC Trac Issues: #4012 >--------------------------------------------------------------- 46d2da00ddb8756d966a5ba491b618367911de0f compiler/utils/Binary.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 8800d98..9f8d926 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -650,7 +650,9 @@ type Dictionary = Array Int FastString -- The dictionary putDictionary :: BinHandle -> Int -> UniqFM (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz - mapM_ (putFS bh) (elems (array (0,sz-1) (eltsUFM dict))) + mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) + -- It's OK to use nonDetEltsUFM here because the elements have indices + -- that array uses to create order getDictionary :: BinHandle -> IO Dictionary getDictionary bh = do From git at git.haskell.org Mon Jun 6 15:19:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 15:19:21 +0000 (UTC) Subject: [commit: ghc] master: Kill foldUniqSet (3e7a876) Message-ID: <20160606151921.C6A883A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3e7a876a9cdf10e5153421b4905928b9de981778/ghc >--------------------------------------------------------------- commit 3e7a876a9cdf10e5153421b4905928b9de981778 Author: Bartosz Nitka Date: Mon Jun 6 08:15:43 2016 -0700 Kill foldUniqSet I planned to just say that we don't care about this part. Turns out I was able to document away the uses in the codegenerator. Test Plan: ./validate Reviewers: simonmar, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2307 GHC Trac Issues: #4012 >--------------------------------------------------------------- 3e7a876a9cdf10e5153421b4905928b9de981778 compiler/nativeGen/RegAlloc/Graph/SpillClean.hs | 3 ++- compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs | 4 +-- compiler/utils/GraphOps.hs | 30 ++++++++++++++-------- compiler/utils/UniqSet.hs | 4 +-- 4 files changed, 24 insertions(+), 17 deletions(-) diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs index f472d29..2383d7b 100644 --- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs +++ b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs @@ -549,7 +549,8 @@ delAssoc :: (Uniquable a) delAssoc a m | Just aSet <- lookupUFM m a , m1 <- delFromUFM m a - = foldUniqSet (\x m -> delAssoc1 x a m) m1 aSet + = nonDetFoldUFM (\x m -> delAssoc1 x a m) m1 aSet + -- It's OK to use nonDetFoldUFM here because deletion is commutative | otherwise = m diff --git a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs index b632ac7..4bbf5d4 100644 --- a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs +++ b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs @@ -225,8 +225,8 @@ trivColorable classN conflicts exclusions RcFloat -> (cd, cf+1) _ -> panic "Regs.trivColorable: reg class not handled" - tmp = foldUniqSet acc (0, 0) conflicts - (countInt, countFloat) = foldUniqSet acc tmp exclusions + tmp = nonDetFoldUFM acc (0, 0) conflicts + (countInt, countFloat) = nonDetFoldUFM acc tmp exclusions squeese = worst countInt classN RcInteger + worst countFloat classN RcFloat diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs index ba0db0f..8b194ad 100644 --- a/compiler/utils/GraphOps.hs +++ b/compiler/utils/GraphOps.hs @@ -58,18 +58,24 @@ addNode :: Uniquable k addNode k node graph = let -- add back conflict edges from other nodes to this one - map_conflict - = foldUniqSet - (adjustUFM_C (\n -> n { nodeConflicts = addOneToUniqSet (nodeConflicts n) k})) - (graphMap graph) - (nodeConflicts node) + map_conflict = + nonDetFoldUFM + -- It's OK to use nonDetFoldUFM here because the + -- operation is commutative + (adjustUFM_C (\n -> n { nodeConflicts = + addOneToUniqSet (nodeConflicts n) k})) + (graphMap graph) + (nodeConflicts node) -- add back coalesce edges from other nodes to this one - map_coalesce - = foldUniqSet - (adjustUFM_C (\n -> n { nodeCoalesce = addOneToUniqSet (nodeCoalesce n) k})) - map_conflict - (nodeCoalesce node) + map_coalesce = + nonDetFoldUFM + -- It's OK to use nonDetFoldUFM here because the + -- operation is commutative + (adjustUFM_C (\n -> n { nodeCoalesce = + addOneToUniqSet (nodeCoalesce n) k})) + map_conflict + (nodeCoalesce node) in graph { graphMap = addToUFM map_coalesce k node} @@ -462,7 +468,9 @@ freezeNode k else node -- panic "GraphOps.freezeNode: edge to freeze wasn't in the coalesce set" -- If the edge isn't actually in the coelesce set then just ignore it. - fm2 = foldUniqSet (adjustUFM_C (freezeEdge k)) fm1 + fm2 = nonDetFoldUFM (adjustUFM_C (freezeEdge k)) fm1 + -- It's OK to use nonDetFoldUFM here because the operation + -- is commutative $ nodeCoalesce node in fm2 diff --git a/compiler/utils/UniqSet.hs b/compiler/utils/UniqSet.hs index a316f53..925997f 100644 --- a/compiler/utils/UniqSet.hs +++ b/compiler/utils/UniqSet.hs @@ -22,7 +22,7 @@ module UniqSet ( unionUniqSets, unionManyUniqSets, minusUniqSet, intersectUniqSets, - foldUniqSet, uniqSetAny, uniqSetAll, + uniqSetAny, uniqSetAll, elementOfUniqSet, elemUniqSet_Directly, filterUniqSet, @@ -61,7 +61,6 @@ unionManyUniqSets :: [UniqSet a] -> UniqSet a minusUniqSet :: UniqSet a -> UniqSet a -> UniqSet a intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a -foldUniqSet :: (a -> b -> b) -> b -> UniqSet a -> b elementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool elemUniqSet_Directly :: Unique -> UniqSet a -> Bool filterUniqSet :: (a -> Bool) -> UniqSet a -> UniqSet a @@ -109,7 +108,6 @@ unionManyUniqSets sets = foldr1 unionUniqSets sets minusUniqSet = minusUFM intersectUniqSets = intersectUFM -foldUniqSet = foldUFM elementOfUniqSet = elemUFM elemUniqSet_Directly = elemUFM_Directly filterUniqSet = filterUFM From git at git.haskell.org Mon Jun 6 17:31:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 17:31:22 +0000 (UTC) Subject: [commit: ghc] master: Make UnitIdMap a deterministic map (1937ef1) Message-ID: <20160606173122.7865C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1937ef1c506b538f0f93cd290fa4a42fc85ab769/ghc >--------------------------------------------------------------- commit 1937ef1c506b538f0f93cd290fa4a42fc85ab769 Author: Bartosz Nitka Date: Mon Jun 6 08:54:17 2016 -0700 Make UnitIdMap a deterministic map This impacts at least the order in which version macros are generated. It's pretty hard to track what kind of nondeterminism is benign and this should have no performance impact as the number of packages should be relatively small. Test Plan: ./validate Reviewers: simonmar, austin, bgamari, ezyang Reviewed By: ezyang Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2308 GHC Trac Issues: #4012 >--------------------------------------------------------------- 1937ef1c506b538f0f93cd290fa4a42fc85ab769 compiler/main/Packages.hs | 53 ++++++++++++++++++++++++----------------------- compiler/utils/UniqDFM.hs | 7 ++++++- 2 files changed, 33 insertions(+), 27 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 1937ef1c506b538f0f93cd290fa4a42fc85ab769 From git at git.haskell.org Mon Jun 6 19:45:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 19:45:56 +0000 (UTC) Subject: [commit: ghc] wip/T12105: Merge MatchFixity and HsMatchContext (306ecad) Message-ID: <20160606194556.E9B933A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12105 Link : http://ghc.haskell.org/trac/ghc/changeset/306ecad591951521ac3f5888ca8be85bf749d271/ghc >--------------------------------------------------------------- commit 306ecad591951521ac3f5888ca8be85bf749d271 Author: Alan Zimmerman Date: Wed May 25 00:09:34 2016 +0200 Merge MatchFixity and HsMatchContext Summary: MatchFixity was introduced to facilitate use of API Annotations. HsMatchContext does the same thing with more detail, but is chased through all over the place to provide context when processing a Match. Since we already have MatchFixity in the Match, it may as well provide the full context. updates submodule haddock Test Plan: ./validate Reviewers: austin, goldfire, bgamari Subscribers: thomie, mpickering Differential Revision: https://phabricator.haskell.org/D2271 GHC Trac Issues: #12105 >--------------------------------------------------------------- 306ecad591951521ac3f5888ca8be85bf749d271 compiler/deSugar/Check.hs | 5 +- compiler/deSugar/DsBinds.hs | 8 +- compiler/deSugar/DsExpr.hs | 14 +- compiler/deSugar/DsMeta.hs | 2 +- compiler/hsSyn/Convert.hs | 35 ++-- compiler/hsSyn/HsBinds.hs | 39 ++-- compiler/hsSyn/HsDecls.hs | 67 +++--- compiler/hsSyn/HsExpr.hs | 232 ++++++++++++--------- compiler/hsSyn/HsExpr.hs-boot | 23 +- compiler/hsSyn/HsLit.hs | 4 +- compiler/hsSyn/HsPat.hs | 17 +- compiler/hsSyn/HsPat.hs-boot | 4 +- compiler/hsSyn/HsSyn.hs | 2 +- compiler/hsSyn/HsTypes.hs | 43 ++-- compiler/hsSyn/HsUtils.hs | 36 ++-- compiler/hsSyn/PlaceHolder.hs | 27 ++- compiler/main/HscStats.hs | 3 + compiler/parser/Parser.y | 4 +- compiler/parser/RdrHsSyn.hs | 21 +- compiler/rename/RnBinds.hs | 27 +-- compiler/typecheck/TcAnnotations.hs | 3 +- compiler/typecheck/TcArrows.hs | 4 +- compiler/typecheck/TcBinds.hs | 8 +- compiler/typecheck/TcEnv.hs | 7 +- compiler/typecheck/TcExpr.hs | 3 +- compiler/typecheck/TcGenDeriv.hs | 84 +++++--- compiler/typecheck/TcGenGenerics.hs | 4 +- compiler/typecheck/TcHsSyn.hs | 2 +- compiler/typecheck/TcInstDcls.hs | 5 +- compiler/typecheck/TcMatches.hs | 11 +- compiler/typecheck/TcMatches.hs-boot | 4 +- compiler/typecheck/TcPat.hs | 3 +- compiler/typecheck/TcPatSyn.hs | 26 ++- compiler/typecheck/TcRnDriver.hs | 3 +- compiler/typecheck/TcTyDecls.hs | 9 +- testsuite/tests/ghc-api/landmines/landmines.stdout | 4 +- testsuite/tests/patsyn/should_fail/T11667.stderr | 2 +- testsuite/tests/th/T8761.stderr | 2 +- utils/haddock | 2 +- 39 files changed, 460 insertions(+), 339 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 306ecad591951521ac3f5888ca8be85bf749d271 From git at git.haskell.org Mon Jun 6 19:45:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 19:45:59 +0000 (UTC) Subject: [commit: ghc] wip/T12105's head updated: Merge MatchFixity and HsMatchContext (306ecad) Message-ID: <20160606194559.B3A263A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T12105' now includes: 4f5b335 Suppress the warning about __sync_fetch_and_nand (#9678) 03d8960 Don't split the arg types in a PatSyn signature eb8eb02 Spelling in comment 839b424 Remove unused Type.splitFunTysN 9c3e55b Comments only 35053eb Testsuite: delete check_files_written 1bf5c12 Spelling 8f7d016 Add support for unicode TH quotes (#11743) 4c6e69d Document some benign nondeterminism 9d06ef1 Make Arrow desugaring deterministic 95dfdce Remove 'deriving Typeable' statements fe8a4e5 Runtime linker: Break m32 allocator out into its own file 1956cbf Fix: #12084 deprecate old profiling flags 31f1804 Testsuite: delete drvfail015.stderr-7.0 [skip ci] 1319363 Always use native-Haskell de/encoders for ASCII and latin1 ac38c02 Update submodule vector [skip ci] 961ed26 Fix broken links to mdo papers eec88ee RTS: simplify read_heap_profiling_flag bdc5558 Testsuite: introduce TEST_HC_OPTS_INTERACTIVE (#11468) 8408d84 Spelling in comments 6a5bce1 Testsuite: also normalise platform-dependent .stdout/stderr f07bf19 Testsuite: fix enum01/02/03 on Windows (#9399) 5020bc8 Testsuite: add a test for #5522 (-fliberate-case -fspec-constr) 0f1e315 Fix bytecode gen to deal with rep-polymorphism e9e61f1 Reduce special-casing for nullary unboxed tuple 5b8bec2 StgCmmExpr: Fix a duplication 5b145c9 Coverage.hs: Fix a duplication cd50d23 StgCmmCon: Do not generate moves from unused fields to local variables b43a793 More fixes for unboxed tuples 72fd407 Comments and white space only 59250dc StgCmmExpr: Remove a redundant list 3a00ff9 Do not init record accessors as exported 3f20da1 Typos in comments d0dd572 Clarify users' guide section on GeneralizedNewtypeDeriving d40682e Testsuite: don't use --interactive in Makefiles 1e67010 RtsFlags.c: Const correct fixes 7e4f3dc StgCmmUtils.emitMultiAssign: Make assertion msg more helpful 0ffa23d Remove unused FAST_STRING_NOT_NEEDED macro defs 930e74f Update a Cmm note 0676e68 Fix detection and use of `USE_LIBDW` cb2c042 Use nameSetAny in findUses f2b3be0 Improve failed knot-tying error message. 99ace83 Kill nameSetElems in getInfo 36d254a Testsuite: run tests in /tmp/ghctest-xxx instead of /tmp/ghctest/xxx 940229c Travis: llvm's apt repository is offline cb9f635 Localize orphan-related nondeterminism d348acd Serialize vParallelTyCons in a stable order 3eac3a0 Add nameSetElemsStable and fix the build dad39ff Remove dead generics-related code from OccName d753ea2 Use UniqDSet for finding free names in the Linker e2446c0 Kill nameSetElems in findImportUsage be47085 Kill nameSetElems in rnCmdTop 060c176 Whitespace only 1d1987e HscMain: Minor simplification 9cc6fac Make FieldLabelEnv a deterministic set 2046297 Document putSymbolTable determinism 4842a80 Derive instances in Data.Data 1dadd9a testsuite: Mark broken tests on powerpc64le 3747372 Refactored SymbolInfo to lower memory usage in RTS 079c1b8 Use useful names for Symbol Addr and Names in Linker.c 02f893e integer-gmp: Make minusInteger more efficient 4aa299d PrelInfo: Ensure that tuple promoted datacon names are in knownKeyNames eda73a3 RTS SMP: Use compiler built-ins on all platforms. 4dbacbc Rename isPinnedByteArray# to isByteArrayPinned# b948a1d Refactor the SymbolName and SymbolAddr types to be pointers 5965117 Replace hand-written Bounded instances with derived ones 0d963ca Add relocation type R_X86_64_REX_GOTPCRELX 4848ab9 Testsuite: fixup comments for T9872d [skip ci] 886f4c1 Better comment for orIfNotFound. f91d87d Failing test-case for #12135. 3042a9d Use UniqDFM for HomePackageTable 48e9a1f Implement deterministic CallInfoSet a90085b Add @since annotations to base instances e684f54 Desugar ApplicativeDo and RecDo deterministically 31ba8d6 Kill nameSetElems 46d2da0 Document putDictionary determinism 3e7a876 Kill foldUniqSet 1937ef1 Make UnitIdMap a deterministic map 306ecad Merge MatchFixity and HsMatchContext From git at git.haskell.org Mon Jun 6 21:16:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Jun 2016 21:16:22 +0000 (UTC) Subject: [commit: ghc] master: Merge MatchFixity and HsMatchContext (a13cb27) Message-ID: <20160606211622.51AC93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a13cb27960f9bdb0bc9eececf9159f034f113481/ghc >--------------------------------------------------------------- commit a13cb27960f9bdb0bc9eececf9159f034f113481 Author: Alan Zimmerman Date: Wed May 25 00:09:34 2016 +0200 Merge MatchFixity and HsMatchContext Summary: MatchFixity was introduced to facilitate use of API Annotations. HsMatchContext does the same thing with more detail, but is chased through all over the place to provide context when processing a Match. Since we already have MatchFixity in the Match, it may as well provide the full context. updates submodule haddock Test Plan: ./validate Reviewers: austin, goldfire, bgamari Subscribers: thomie, mpickering Differential Revision: https://phabricator.haskell.org/D2271 GHC Trac Issues: #12105 (cherry picked from commit 306ecad591951521ac3f5888ca8be85bf749d271) >--------------------------------------------------------------- a13cb27960f9bdb0bc9eececf9159f034f113481 compiler/deSugar/Check.hs | 5 +- compiler/deSugar/DsBinds.hs | 8 +- compiler/deSugar/DsExpr.hs | 14 +- compiler/deSugar/DsMeta.hs | 2 +- compiler/hsSyn/Convert.hs | 35 ++-- compiler/hsSyn/HsBinds.hs | 39 ++-- compiler/hsSyn/HsDecls.hs | 67 +++--- compiler/hsSyn/HsExpr.hs | 232 ++++++++++++--------- compiler/hsSyn/HsExpr.hs-boot | 23 +- compiler/hsSyn/HsLit.hs | 4 +- compiler/hsSyn/HsPat.hs | 17 +- compiler/hsSyn/HsPat.hs-boot | 4 +- compiler/hsSyn/HsSyn.hs | 2 +- compiler/hsSyn/HsTypes.hs | 43 ++-- compiler/hsSyn/HsUtils.hs | 36 ++-- compiler/hsSyn/PlaceHolder.hs | 27 ++- compiler/main/HscStats.hs | 3 + compiler/parser/Parser.y | 4 +- compiler/parser/RdrHsSyn.hs | 21 +- compiler/rename/RnBinds.hs | 27 +-- compiler/typecheck/TcAnnotations.hs | 3 +- compiler/typecheck/TcArrows.hs | 4 +- compiler/typecheck/TcBinds.hs | 8 +- compiler/typecheck/TcEnv.hs | 7 +- compiler/typecheck/TcExpr.hs | 3 +- compiler/typecheck/TcGenDeriv.hs | 84 +++++--- compiler/typecheck/TcGenGenerics.hs | 4 +- compiler/typecheck/TcHsSyn.hs | 2 +- compiler/typecheck/TcInstDcls.hs | 5 +- compiler/typecheck/TcMatches.hs | 11 +- compiler/typecheck/TcMatches.hs-boot | 4 +- compiler/typecheck/TcPat.hs | 3 +- compiler/typecheck/TcPatSyn.hs | 26 ++- compiler/typecheck/TcRnDriver.hs | 3 +- compiler/typecheck/TcTyDecls.hs | 9 +- testsuite/tests/ghc-api/landmines/landmines.stdout | 4 +- testsuite/tests/patsyn/should_fail/T11667.stderr | 2 +- testsuite/tests/th/T8761.stderr | 2 +- utils/haddock | 2 +- 39 files changed, 460 insertions(+), 339 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 a13cb27960f9bdb0bc9eececf9159f034f113481 From git at git.haskell.org Tue Jun 7 12:20:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 12:20:56 +0000 (UTC) Subject: [commit: ghc] master: Kill occSetElts (77ccdf3) Message-ID: <20160607122056.7C7203A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/77ccdf3b7387ed16f781a8f693dc3c9bde87f477/ghc >--------------------------------------------------------------- commit 77ccdf3b7387ed16f781a8f693dc3c9bde87f477 Author: Bartosz Nitka Date: Tue Jun 7 05:23:32 2016 -0700 Kill occSetElts It uses uniqSetToList which is nondeterministic. GHC Trac: #4012 >--------------------------------------------------------------- 77ccdf3b7387ed16f781a8f693dc3c9bde87f477 compiler/basicTypes/OccName.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs index 4410bd1..19a9b3b 100644 --- a/compiler/basicTypes/OccName.hs +++ b/compiler/basicTypes/OccName.hs @@ -91,7 +91,7 @@ module OccName ( -- * The 'OccSet' type OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet, extendOccSetList, - unionOccSets, unionManyOccSets, minusOccSet, elemOccSet, occSetElts, + unionOccSets, unionManyOccSets, minusOccSet, elemOccSet, isEmptyOccSet, intersectOccSet, intersectsOccSet, filterOccSet, @@ -443,7 +443,6 @@ unionOccSets :: OccSet -> OccSet -> OccSet unionManyOccSets :: [OccSet] -> OccSet minusOccSet :: OccSet -> OccSet -> OccSet elemOccSet :: OccName -> OccSet -> Bool -occSetElts :: OccSet -> [OccName] isEmptyOccSet :: OccSet -> Bool intersectOccSet :: OccSet -> OccSet -> OccSet intersectsOccSet :: OccSet -> OccSet -> Bool @@ -458,7 +457,6 @@ unionOccSets = unionUniqSets unionManyOccSets = unionManyUniqSets minusOccSet = minusUniqSet elemOccSet = elementOfUniqSet -occSetElts = uniqSetToList isEmptyOccSet = isEmptyUniqSet intersectOccSet = intersectUniqSets intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2)) From git at git.haskell.org Tue Jun 7 12:52:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 12:52:31 +0000 (UTC) Subject: [commit: ghc] master: Use a deterministic map for imp_dep_mods (7fea712) Message-ID: <20160607125231.DA8743A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7fea7121ce195e562a5443c0a8ef3861504ef1b3/ghc >--------------------------------------------------------------- commit 7fea7121ce195e562a5443c0a8ef3861504ef1b3 Author: Bartosz Nitka Date: Tue Jun 7 05:55:50 2016 -0700 Use a deterministic map for imp_dep_mods This lets us remove some normalization and makes it less brittle for the future. Test Plan: ./validate Reviewers: ezyang, austin, bgamari, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2311 GHC Trac Issues: #4012 >--------------------------------------------------------------- 7fea7121ce195e562a5443c0a8ef3861504ef1b3 compiler/deSugar/Desugar.hs | 7 ++++--- compiler/iface/MkIface.hs | 5 +++-- compiler/typecheck/TcRnDriver.hs | 16 ++++++---------- compiler/typecheck/TcRnTypes.hs | 13 +++++++------ 4 files changed, 20 insertions(+), 21 deletions(-) diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index c7a869d..7ce0c6d 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -61,11 +61,11 @@ import Util import MonadUtils import OrdList import UniqFM +import UniqDFM import ListSetOps import Fingerprint import Maybes -import Data.Function import Data.List import Data.IORef import Control.Monad( when ) @@ -83,7 +83,8 @@ mkDependencies = do -- Template Haskell used? th_used <- readIORef th_var - let dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod)) + let dep_mods = eltsUDFM (delFromUDFM (imp_dep_mods imports) + (moduleName mod)) -- M.hi-boot can be in the imp_dep_mods, but we must remove -- it before recording the modules on which this one depends! -- (We want to retain M.hi-boot in imp_dep_mods so that @@ -100,7 +101,7 @@ mkDependencies trust_pkgs = imp_trust_pkgs imports dep_pkgs' = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs - return Deps { dep_mods = sortBy (stableModuleNameCmp `on` fst) dep_mods, + return Deps { dep_mods = dep_mods, dep_pkgs = dep_pkgs', dep_orphs = sortBy stableModuleCmp (imp_orphs imports), dep_finsts = sortBy stableModuleCmp (imp_finsts imports) } diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 88bc662..67bbd95 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -107,6 +107,7 @@ import Binary import Fingerprint import Exception import UniqFM +import UniqDFM import Control.Monad import Data.Function @@ -1055,14 +1056,14 @@ checkVersions hsc_env mod_summary iface -- We do this regardless of compilation mode, although in --make mode -- all the dependent modules should be in the HPT already, so it's -- quite redundant - ; updateEps_ $ \eps -> eps { eps_is_boot = mod_deps } + ; updateEps_ $ \eps -> eps { eps_is_boot = udfmToUfm mod_deps } ; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface] ; return (recomp, Just iface) }}}} where this_pkg = thisPackage (hsc_dflags hsc_env) -- This is a bit of a hack really - mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface) + mod_deps :: DModuleNameEnv (ModuleName, IsBootInterface) mod_deps = mkModDeps (dep_mods (mi_deps iface)) -- | Check the flags haven't changed diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index cb7bb69..5e83305 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -83,7 +83,7 @@ import Id import IdInfo import VarEnv import Module -import UniqFM +import UniqDFM import Name import NameEnv import NameSet @@ -400,7 +400,7 @@ tcRnImports hsc_env import_decls = do { (rn_imports, rdr_env, imports, hpc_info) <- rnImports import_decls ; ; this_mod <- getModule - ; let { dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface) + ; let { dep_mods :: DModuleNameEnv (ModuleName, IsBootInterface) ; dep_mods = imp_dep_mods imports -- We want instance declarations from all home-package @@ -411,7 +411,7 @@ tcRnImports hsc_env import_decls -- modules batch (@--make@) compiled before this one, but -- which are not below this one. ; want_instances :: ModuleName -> Bool - ; want_instances mod = mod `elemUFM` dep_mods + ; want_instances mod = mod `elemUDFM` dep_mods && mod /= moduleName this_mod ; (home_insts, home_fam_insts) = hptInstances hsc_env want_instances @@ -420,7 +420,7 @@ tcRnImports hsc_env import_decls -- Record boot-file info in the EPS, so that it's -- visible to loadHiBootInterface in tcRnSrcDecls, -- and any other incrementally-performed imports - ; updateEps_ (\eps -> eps { eps_is_boot = dep_mods }) ; + ; updateEps_ (\eps -> eps { eps_is_boot = udfmToUfm dep_mods }) ; -- Update the gbl env ; updGblEnv ( \ gbl -> @@ -2434,15 +2434,11 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, , vcat (map ppr rules) , vcat (map ppr vects) , text "Dependent modules:" <+> - pprUFM (imp_dep_mods imports) (ppr . sortBy cmp_mp) + pprUDFM (imp_dep_mods imports) ppr , text "Dependent packages:" <+> ppr (sortBy stableUnitIdCmp $ imp_dep_pkgs imports)] - where -- The two uses of sortBy are just to reduce unnecessary + where -- The use of sortBy is just to reduce unnecessary -- wobbling in testsuite output - cmp_mp (mod_name1, is_boot1) (mod_name2, is_boot2) - = (mod_name1 `stableModuleNameCmp` mod_name2) - `thenCmp` - (is_boot1 `compare` is_boot2) ppr_types :: TypeEnv -> SDoc ppr_types type_env diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 4017688..a416c74 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -163,6 +163,7 @@ import SrcLoc import VarSet import ErrUtils import UniqFM +import UniqDFM import UniqSupply import BasicTypes import Bag @@ -1042,7 +1043,7 @@ data ImportAvails -- different packages. (currently not the case, but might be in the -- future). - imp_dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface), + imp_dep_mods :: DModuleNameEnv (ModuleName, IsBootInterface), -- ^ Home-package modules needed by the module being compiled -- -- It doesn't matter whether any of these dependencies @@ -1084,14 +1085,14 @@ data ImportAvails } mkModDeps :: [(ModuleName, IsBootInterface)] - -> ModuleNameEnv (ModuleName, IsBootInterface) -mkModDeps deps = foldl add emptyUFM deps + -> DModuleNameEnv (ModuleName, IsBootInterface) +mkModDeps deps = foldl add emptyUDFM deps where - add env elt@(m,_) = addToUFM env m elt + add env elt@(m,_) = addToUDFM env m elt emptyImportAvails :: ImportAvails emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv, - imp_dep_mods = emptyUFM, + imp_dep_mods = emptyUDFM, imp_dep_pkgs = [], imp_trust_pkgs = [], imp_trust_own_pkg = False, @@ -1114,7 +1115,7 @@ plusImportAvails imp_trust_pkgs = tpkgs2, imp_trust_own_pkg = tself2, imp_orphs = orphs2, imp_finsts = finsts2 }) = ImportAvails { imp_mods = plusModuleEnv_C (++) mods1 mods2, - imp_dep_mods = plusUFM_C plus_mod_dep dmods1 dmods2, + imp_dep_mods = plusUDFM_C plus_mod_dep dmods1 dmods2, imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2, imp_trust_pkgs = tpkgs1 `unionLists` tpkgs2, imp_trust_own_pkg = tself1 || tself2, From git at git.haskell.org Tue Jun 7 13:13:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 13:13:05 +0000 (UTC) Subject: [commit: ghc] master: CoreToStg: Remove hand-written Eq instances of HowBound and LetInfo (d05dee3) Message-ID: <20160607131305.A5A1B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d05dee38c80e862d82e9ba891f3ae5076e376f31/ghc >--------------------------------------------------------------- commit d05dee38c80e862d82e9ba891f3ae5076e376f31 Author: ?mer Sinan A?acan Date: Tue Jun 7 09:15:22 2016 -0400 CoreToStg: Remove hand-written Eq instances of HowBound and LetInfo >--------------------------------------------------------------- d05dee38c80e862d82e9ba891f3ae5076e376f31 compiler/stgSyn/CoreToStg.hs | 16 +++------------- 1 file changed, 3 insertions(+), 13 deletions(-) diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs index c275f4d..d2010a8 100644 --- a/compiler/stgSyn/CoreToStg.hs +++ b/compiler/stgSyn/CoreToStg.hs @@ -856,10 +856,12 @@ data HowBound Arity -- Its arity (local Ids don't have arity info at this point) | LambdaBound -- Used for both lambda and case + deriving (Eq) data LetInfo = TopLet -- top level things | NestedLet + deriving (Eq) isLetBound :: HowBound -> Bool isLetBound (LetBound _ _) = True @@ -1010,21 +1012,9 @@ plusFVInfo :: (Var, HowBound, StgBinderInfo) -> (Var, HowBound, StgBinderInfo) -> (Var, HowBound, StgBinderInfo) plusFVInfo (id1,hb1,info1) (id2,hb2,info2) - = ASSERT(id1 == id2 && hb1 `check_eq_how_bound` hb2) + = ASSERT(id1 == id2 && hb1 == hb2) (id1, hb1, combineStgBinderInfo info1 info2) --- The HowBound info for a variable in the FVInfo should be consistent -check_eq_how_bound :: HowBound -> HowBound -> Bool -check_eq_how_bound ImportBound ImportBound = True -check_eq_how_bound LambdaBound LambdaBound = True -check_eq_how_bound (LetBound li1 ar1) (LetBound li2 ar2) = ar1 == ar2 && check_eq_li li1 li2 -check_eq_how_bound _ _ = False - -check_eq_li :: LetInfo -> LetInfo -> Bool -check_eq_li NestedLet NestedLet = True -check_eq_li TopLet TopLet = True -check_eq_li _ _ = False - -- Misc. filterStgBinders :: [Var] -> [Var] From git at git.haskell.org Tue Jun 7 13:29:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 13:29:56 +0000 (UTC) Subject: [commit: ghc] master: Kill two instances of uniqSetToList (4426c5f) Message-ID: <20160607132956.2A51F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4426c5ffe5dfc00da4e203ae8fe9323a427c479e/ghc >--------------------------------------------------------------- commit 4426c5ffe5dfc00da4e203ae8fe9323a427c479e Author: Bartosz Nitka Date: Tue Jun 7 05:36:43 2016 -0700 Kill two instances of uniqSetToList There should be no performance impact of switching to the deterministic set here. GHC Trac: #4012 >--------------------------------------------------------------- 4426c5ffe5dfc00da4e203ae8fe9323a427c479e compiler/cmm/PprC.hs | 3 ++- compiler/ghci/Linker.hs | 17 ++++++++--------- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index 4bb256a..331dd67 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -42,6 +42,7 @@ import FastString import Outputable import Platform import UniqSet +import UniqFM import Unique import Util @@ -984,7 +985,7 @@ is_cishCC JavaScriptCallConv = False -- pprTempAndExternDecls :: [CmmBlock] -> (SDoc{-temps-}, SDoc{-externs-}) pprTempAndExternDecls stmts - = (vcat (map pprTempDecl (uniqSetToList temps)), + = (pprUFM temps (vcat . map pprTempDecl), vcat (map (pprExternDecl False{-ToDo-}) (Map.keys lbls))) where (temps, lbls) = runTE (mapM_ te_BB stmts) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 2df8840..f018a2e 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -47,7 +47,6 @@ import Util import ErrUtils import SrcLoc import qualified Maybes -import UniqSet import UniqDSet import FastString import Platform @@ -576,7 +575,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods -- 1. Find the dependent home-pkg-modules/packages from each iface -- (omitting modules from the interactive package, which is already linked) ; (mods_s, pkgs_s) <- follow_deps (filterOut isInteractiveModule mods) - emptyUniqSet emptyUniqSet; + emptyUniqDSet emptyUniqDSet; ; let { -- 2. Exclude ones already linked @@ -604,11 +603,11 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods -- dependencies of that. Hence we need to traverse the dependency -- tree recursively. See bug #936, testcase ghci/prog007. follow_deps :: [Module] -- modules to follow - -> UniqSet ModuleName -- accum. module dependencies - -> UniqSet UnitId -- accum. package dependencies + -> UniqDSet ModuleName -- accum. module dependencies + -> UniqDSet UnitId -- accum. package dependencies -> IO ([ModuleName], [UnitId]) -- result follow_deps [] acc_mods acc_pkgs - = return (uniqSetToList acc_mods, uniqSetToList acc_pkgs) + = return (uniqDSetToList acc_mods, uniqDSetToList acc_pkgs) follow_deps (mod:mods) acc_mods acc_pkgs = do mb_iface <- initIfaceCheck hsc_env $ @@ -628,12 +627,12 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods where is_boot (m,True) = Left m is_boot (m,False) = Right m - boot_deps' = filter (not . (`elementOfUniqSet` acc_mods)) boot_deps - acc_mods' = addListToUniqSet acc_mods (moduleName mod : mod_deps) - acc_pkgs' = addListToUniqSet acc_pkgs $ map fst pkg_deps + boot_deps' = filter (not . (`elementOfUniqDSet` acc_mods)) boot_deps + acc_mods' = addListToUniqDSet acc_mods (moduleName mod : mod_deps) + acc_pkgs' = addListToUniqDSet acc_pkgs $ map fst pkg_deps -- if pkg /= this_pkg - then follow_deps mods acc_mods (addOneToUniqSet acc_pkgs' pkg) + then follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' pkg) else follow_deps (map (mkModule this_pkg) boot_deps' ++ mods) acc_mods' acc_pkgs' where From git at git.haskell.org Tue Jun 7 13:38:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 13:38:18 +0000 (UTC) Subject: [commit: ghc] master: Fix build by removing unused import (0d6f428) Message-ID: <20160607133818.4C1F83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0d6f4284d58a3a3008c7719c96517000b1e15be5/ghc >--------------------------------------------------------------- commit 0d6f4284d58a3a3008c7719c96517000b1e15be5 Author: Bartosz Nitka Date: Tue Jun 7 06:41:12 2016 -0700 Fix build by removing unused import >--------------------------------------------------------------- 0d6f4284d58a3a3008c7719c96517000b1e15be5 compiler/typecheck/TcRnTypes.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index a416c74..ef6feaf 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -162,7 +162,6 @@ import Module import SrcLoc import VarSet import ErrUtils -import UniqFM import UniqDFM import UniqSupply import BasicTypes From git at git.haskell.org Tue Jun 7 13:54:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 13:54:52 +0000 (UTC) Subject: [commit: ghc] master: Kill varSetElems in checkValidInferredKinds (c148212) Message-ID: <20160607135452.808033A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c1482127ded4479e2ac698851b1545887c2aedf0/ghc >--------------------------------------------------------------- commit c1482127ded4479e2ac698851b1545887c2aedf0 Author: Bartosz Nitka Date: Tue Jun 7 06:53:14 2016 -0700 Kill varSetElems in checkValidInferredKinds It's only used for producing an error message here GHC Trac: #4012 >--------------------------------------------------------------- c1482127ded4479e2ac698851b1545887c2aedf0 compiler/typecheck/TcValidity.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 83f64f3..f137d1e 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -49,6 +49,7 @@ import FamInst ( makeInjectivityErrors ) import Name import VarEnv import VarSet +import UniqFM import Var ( mkTyVar ) import ErrUtils import DynFlags @@ -1863,7 +1864,9 @@ checkValidInferredKinds orig_kvs out_of_scope extra where (env1, _) = tidyTyCoVarBndrs emptyTidyEnv orig_kvs - (env, _) = tidyTyCoVarBndrs env1 (varSetElems out_of_scope) + (env, _) = tidyTyCoVarBndrs env1 (nonDetEltsUFM out_of_scope) + -- It's OK to use nonDetEltsUFM here because it's only used for + -- generating the error message {- ************************************************************************ From git at git.haskell.org Tue Jun 7 14:19:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 14:19:55 +0000 (UTC) Subject: [commit: ghc] master: Use DVarSet in Vectorise.Exp (ad8e203) Message-ID: <20160607141955.5834C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ad8e2032b86389814f4e1da64c84ab3d3c4c3802/ghc >--------------------------------------------------------------- commit ad8e2032b86389814f4e1da64c84ab3d3c4c3802 Author: Bartosz Nitka Date: Tue Jun 7 06:28:51 2016 -0700 Use DVarSet in Vectorise.Exp I believe this part of code is a bit unused. That's probably why it never became a problem in my testing. I'm changing to deterministic sets here to be safer. Test Plan: ./validate Reviewers: simonmar, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2312 GHC Trac Issues: #4012 >--------------------------------------------------------------- ad8e2032b86389814f4e1da64c84ab3d3c4c3802 compiler/vectorise/Vectorise/Exp.hs | 53 ++++++++++++++++++------------------- 1 file changed, 26 insertions(+), 27 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 ad8e2032b86389814f4e1da64c84ab3d3c4c3802 From git at git.haskell.org Tue Jun 7 14:32:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 14:32:06 +0000 (UTC) Subject: [commit: ghc] master: Document determinism in pprintClosureCommand (3b698e8) Message-ID: <20160607143206.085E03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3b698e8938ccfa3e0dbf192abf4984d6937a196e/ghc >--------------------------------------------------------------- commit 3b698e8938ccfa3e0dbf192abf4984d6937a196e Author: Bartosz Nitka Date: Tue Jun 7 07:33:45 2016 -0700 Document determinism in pprintClosureCommand Like described in the comment, it's OK here. GHC Trac: #4012 >--------------------------------------------------------------- 3b698e8938ccfa3e0dbf192abf4984d6937a196e compiler/ghci/Debugger.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs index acc900f..64ac154 100644 --- a/compiler/ghci/Debugger.hs +++ b/compiler/ghci/Debugger.hs @@ -26,6 +26,7 @@ import IfaceEnv( newInteractiveBinder ) import Name import Var hiding ( varName ) import VarSet +import UniqFM import Type import Kind import GHC @@ -99,7 +100,9 @@ pprintClosureCommand bindThings force str = do my_tvs = termTyCoVars t tvs = env_tvs `minusVarSet` my_tvs tyvarOccName = nameOccName . tyVarName - tidyEnv = (initTidyOccEnv (map tyvarOccName (varSetElems tvs)) + tidyEnv = (initTidyOccEnv (map tyvarOccName (nonDetEltsUFM tvs)) + -- It's OK to use nonDetEltsUFM here because initTidyOccEnv + -- forgets the ordering immediately by creating an env , env_tvs `intersectVarSet` my_tvs) return$ mapTermType (snd . tidyOpenType tidyEnv) t From git at git.haskell.org Tue Jun 7 15:20:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 15:20:04 +0000 (UTC) Subject: [commit: ghc] master: Make vectInfoParallelVars a DVarSet (5db93d2) Message-ID: <20160607152004.C58F53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5db93d2e567ecb7169b06097244361327ec1eb2a/ghc >--------------------------------------------------------------- commit 5db93d2e567ecb7169b06097244361327ec1eb2a Author: Bartosz Nitka Date: Tue Jun 7 07:19:30 2016 -0700 Make vectInfoParallelVars a DVarSet We dump it in the interface file, so we need to do it in a deterministic order. I haven't seen any problems with this during my testing, but that's probably because it's unused. Test Plan: ./validate Reviewers: simonmar, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2313 GHC Trac Issues: #4012 >--------------------------------------------------------------- 5db93d2e567ecb7169b06097244361327ec1eb2a compiler/iface/MkIface.hs | 2 +- compiler/iface/TcIface.hs | 2 +- compiler/main/HscTypes.hs | 6 +++--- compiler/main/TidyPgm.hs | 11 ++++++----- compiler/vectorise/Vectorise/Env.hs | 7 ++++--- compiler/vectorise/Vectorise/Exp.hs | 4 ++-- compiler/vectorise/Vectorise/Monad.hs | 2 +- compiler/vectorise/Vectorise/Monad/Global.hs | 2 +- 8 files changed, 19 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 5db93d2e567ecb7169b06097244361327ec1eb2a From git at git.haskell.org Tue Jun 7 16:05:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 16:05:19 +0000 (UTC) Subject: [commit: ghc] master: Kill varSetElems (7008515) Message-ID: <20160607160519.40EF63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7008515be5863df46f7863ccb8b74df004ccf73e/ghc >--------------------------------------------------------------- commit 7008515be5863df46f7863ccb8b74df004ccf73e Author: Bartosz Nitka Date: Tue Jun 7 07:47:42 2016 -0700 Kill varSetElems This eradicates varSetElems from the codebase. This function used to introduce nondeterminism. I've also documented benign nondeterminism in three places. GHC Trac: #4012 >--------------------------------------------------------------- 7008515be5863df46f7863ccb8b74df004ccf73e compiler/basicTypes/VarEnv.hs | 6 ++++-- compiler/basicTypes/VarSet.hs | 8 +++----- compiler/typecheck/TcSimplify.hs | 4 +++- testsuite/tests/callarity/unittest/CallArity1.hs | 5 ++++- 4 files changed, 14 insertions(+), 9 deletions(-) diff --git a/compiler/basicTypes/VarEnv.hs b/compiler/basicTypes/VarEnv.hs index dd61257..5a852a3 100644 --- a/compiler/basicTypes/VarEnv.hs +++ b/compiler/basicTypes/VarEnv.hs @@ -109,8 +109,10 @@ data InScopeSet = InScope (VarEnv Var) {-# UNPACK #-} !Int -- INVARIANT: it's not zero; we use it as a multiplier in uniqAway instance Outputable InScopeSet where - ppr (InScope s _) = text "InScope" - <+> braces (fsep (map (ppr . Var.varName) (varSetElems s))) + ppr (InScope s _) = + text "InScope" <+> braces (fsep (map (ppr . Var.varName) (nonDetEltsUFM s))) + -- It's OK to use nonDetEltsUFM here because it's + -- only for pretty printing -- In-scope sets get big, and with -dppr-debug -- the output is overwhelming diff --git a/compiler/basicTypes/VarSet.hs b/compiler/basicTypes/VarSet.hs index 4663a41..b0151d8 100644 --- a/compiler/basicTypes/VarSet.hs +++ b/compiler/basicTypes/VarSet.hs @@ -12,7 +12,7 @@ module VarSet ( -- ** Manipulating these sets emptyVarSet, unitVarSet, mkVarSet, extendVarSet, extendVarSetList, extendVarSet_C, - elemVarSet, varSetElems, subVarSet, + elemVarSet, subVarSet, unionVarSet, unionVarSets, mapUnionVarSet, intersectVarSet, intersectsVarSet, disjointVarSet, isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey, @@ -72,7 +72,6 @@ unionVarSets :: [VarSet] -> VarSet mapUnionVarSet :: (a -> VarSet) -> [a] -> VarSet -- ^ map the function over the list, and union the results -varSetElems :: VarSet -> [Var] unitVarSet :: Var -> VarSet extendVarSet :: VarSet -> Var -> VarSet extendVarSetList:: VarSet -> [Var] -> VarSet @@ -108,7 +107,6 @@ subVarSet :: VarSet -> VarSet -> Bool -- True if first arg is subset o unionVarSet = unionUniqSets unionVarSets = unionManyUniqSets -varSetElems = uniqSetToList elemVarSet = elementOfUniqSet minusVarSet = minusUniqSet delVarSet = delOneFromUniqSet @@ -188,10 +186,10 @@ pluralVarSet = pluralUFM -- The order of variables is non-deterministic and for pretty-printing that -- shouldn't be a problem. -- Having this function helps contain the non-determinism created with --- varSetElems. +-- nonDetEltsUFM. -- Passing a list to the pretty-printing function allows the caller -- to decide on the order of Vars (eg. toposort them) without them having --- to use varSetElems at the call site. This prevents from let-binding +-- to use nonDetEltsUFM at the call site. This prevents from let-binding -- non-deterministically ordered lists and reusing them where determinism -- matters. pprVarSet :: VarSet -- ^ The things to be pretty printed diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 4c621dd..c889b4b 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -648,7 +648,9 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds -- promoteTyVar ignores coercion variables ; outer_tclvl <- TcM.getTcLevel - ; mapM_ (promoteTyVar outer_tclvl) (varSetElems promote_tkvs) + ; mapM_ (promoteTyVar outer_tclvl) (nonDetEltsUFM promote_tkvs) + -- It's OK to use nonDetEltsUFM here because promoteTyVar is + -- commutative -- Emit an implication constraint for the -- remaining constraints from the RHS diff --git a/testsuite/tests/callarity/unittest/CallArity1.hs b/testsuite/tests/callarity/unittest/CallArity1.hs index b889a2f..6873d32 100644 --- a/testsuite/tests/callarity/unittest/CallArity1.hs +++ b/testsuite/tests/callarity/unittest/CallArity1.hs @@ -19,6 +19,7 @@ import System.Environment( getArgs ) import VarSet import PprCore import Unique +import UniqFM import CoreLint import FastString @@ -173,7 +174,9 @@ main = do putMsg dflags (text n <> char ':') -- liftIO $ putMsg dflags (ppr e) let e' = callArityRHS e - let bndrs = varSetElems (allBoundIds e') + let bndrs = nonDetEltsUFM (allBoundIds e') + -- It should be OK to use nonDetEltsUFM here, if it becomes a + -- problem we should use DVarSet -- liftIO $ putMsg dflags (ppr e') forM_ bndrs $ \v -> putMsg dflags $ nest 4 $ ppr v <+> ppr (idCallArity v) From git at git.haskell.org Tue Jun 7 16:05:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 16:05:21 +0000 (UTC) Subject: [commit: ghc] master: Use pprUFM in pprStgLVs (7d58a97) Message-ID: <20160607160521.E57303A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7d58a97854bffd515a421d4cd2d7eeee8a99601e/ghc >--------------------------------------------------------------- commit 7d58a97854bffd515a421d4cd2d7eeee8a99601e Author: Bartosz Nitka Date: Tue Jun 7 08:43:58 2016 -0700 Use pprUFM in pprStgLVs >--------------------------------------------------------------- 7d58a97854bffd515a421d4cd2d7eeee8a99601e compiler/stgSyn/StgSyn.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/stgSyn/StgSyn.hs b/compiler/stgSyn/StgSyn.hs index 87bbb94..f3a02c8 100644 --- a/compiler/stgSyn/StgSyn.hs +++ b/compiler/stgSyn/StgSyn.hs @@ -65,6 +65,7 @@ import Type ( Type ) import Type ( typePrimRep ) import UniqSet import Unique ( Unique ) +import UniqFM import Util {- @@ -760,7 +761,7 @@ pprStgLVs lvs if userStyle sty || isEmptyUniqSet lvs then empty else - hcat [text "{-lvs:", interpp'SP (uniqSetToList lvs), text "-}"] + hcat [text "{-lvs:", pprUFM lvs interpp'SP, text "-}"] pprStgRhs :: (OutputableBndr bndr, Outputable bdee, Ord bdee) => GenStgRhs bndr bdee -> SDoc From git at git.haskell.org Tue Jun 7 19:33:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 19:33:20 +0000 (UTC) Subject: [commit: ghc] branch 'wip/thomie' created Message-ID: <20160607193320.5D2BC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/thomie Referencing: 9bee6ef2fb5c280e061144368d75a0ef947e68c9 From git at git.haskell.org Tue Jun 7 19:33:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 19:33:23 +0000 (UTC) Subject: [commit: ghc] wip/thomie: Testsuite driver: always quote opts.testdir (9bee6ef) Message-ID: <20160607193323.14B783A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/thomie Link : http://ghc.haskell.org/trac/ghc/changeset/9bee6ef2fb5c280e061144368d75a0ef947e68c9/ghc >--------------------------------------------------------------- commit 9bee6ef2fb5c280e061144368d75a0ef947e68c9 Author: Thomas Miedema Date: Tue Jun 7 15:59:15 2016 +0200 Testsuite driver: always quote opts.testdir This makes sure the testsuite keeps working when testdir contains backward slashes. >--------------------------------------------------------------- 9bee6ef2fb5c280e061144368d75a0ef947e68c9 testsuite/driver/runtests.py | 2 +- testsuite/driver/testlib.py | 42 +++++++++++++++++++-------------- testsuite/tests/cabal/cabal01/Makefile | 2 +- testsuite/tests/ghci/linking/dyn/all.T | 4 ++-- testsuite/tests/rename/prog006/Makefile | 2 +- 5 files changed, 29 insertions(+), 23 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9bee6ef2fb5c280e061144368d75a0ef947e68c9 From git at git.haskell.org Tue Jun 7 21:10:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 21:10:02 +0000 (UTC) Subject: [commit: ghc] master: Typofix. (00e3a5d) Message-ID: <20160607211002.8406E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/00e3a5d723a6182faab4737478fb18599316e2c1/ghc >--------------------------------------------------------------- commit 00e3a5d723a6182faab4737478fb18599316e2c1 Author: Edward Z. Yang Date: Tue Jun 7 14:13:42 2016 -0700 Typofix. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 00e3a5d723a6182faab4737478fb18599316e2c1 docs/users_guide/using-concurrent.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/using-concurrent.rst b/docs/users_guide/using-concurrent.rst index c5179c7..8c0587c 100644 --- a/docs/users_guide/using-concurrent.rst +++ b/docs/users_guide/using-concurrent.rst @@ -78,7 +78,7 @@ following compiler options affect parallelism: .. ghc-flag:: -feager-blackholing - Blackholing is the act of marking a thunk (lazy computuation) as + Blackholing is the act of marking a thunk (lazy computation) as being under evaluation. It is useful for three reasons: firstly it lets us detect certain kinds of infinite loop (the ``NonTermination`` exception), secondly it avoids certain kinds of From git at git.haskell.org Tue Jun 7 21:23:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 21:23:04 +0000 (UTC) Subject: [commit: ghc] master: Testsuite driver: always quote opts.testdir (4d5b2f6) Message-ID: <20160607212304.229A53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4d5b2f6ae20810632f8a6e7f01745808bb8af1c0/ghc >--------------------------------------------------------------- commit 4d5b2f6ae20810632f8a6e7f01745808bb8af1c0 Author: Thomas Miedema Date: Tue Jun 7 15:59:15 2016 +0200 Testsuite driver: always quote opts.testdir This makes sure the testsuite keeps working when testdir contains backward slashes. Differential Revision: https://phabricator.haskell.org/D2314 >--------------------------------------------------------------- 4d5b2f6ae20810632f8a6e7f01745808bb8af1c0 testsuite/driver/runtests.py | 2 +- testsuite/driver/testlib.py | 43 +++++++++++++++++++-------------- testsuite/tests/cabal/cabal01/Makefile | 2 +- testsuite/tests/ghci/linking/dyn/all.T | 4 +-- testsuite/tests/rename/prog006/Makefile | 2 +- 5 files changed, 30 insertions(+), 23 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4d5b2f6ae20810632f8a6e7f01745808bb8af1c0 From git at git.haskell.org Tue Jun 7 21:23:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Jun 2016 21:23:06 +0000 (UTC) Subject: [commit: ghc] master: Testsuite Windows: mark T8308 expect_broken (#8308) (f5f5a8a) Message-ID: <20160607212306.E15943A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f5f5a8a7957d6c52f47071d2b7419b47e43e9a9d/ghc >--------------------------------------------------------------- commit f5f5a8a7957d6c52f47071d2b7419b47e43e9a9d Author: Thomas Miedema Date: Tue Jun 7 21:13:34 2016 +0200 Testsuite Windows: mark T8308 expect_broken (#8308) >--------------------------------------------------------------- f5f5a8a7957d6c52f47071d2b7419b47e43e9a9d testsuite/tests/rts/T8308/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/rts/T8308/all.T b/testsuite/tests/rts/T8308/all.T index cadbbcb..7204e40 100644 --- a/testsuite/tests/rts/T8308/all.T +++ b/testsuite/tests/rts/T8308/all.T @@ -1,2 +1,2 @@ -test('T8308', [extra_clean(['T8308.ticky'])], +test('T8308', when(opsys('mingw32'), expect_broken(8308)), run_command, ['$MAKE -s --no-print-directory T8308']) From git at git.haskell.org Wed Jun 8 06:52:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Jun 2016 06:52:13 +0000 (UTC) Subject: [commit: ghc] master: Add some determinism tests (d4b548e) Message-ID: <20160608065213.BC9443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d4b548efea15943026dd0d4929b6f0f999b4d718/ghc >--------------------------------------------------------------- commit d4b548efea15943026dd0d4929b6f0f999b4d718 Author: Bartosz Nitka Date: Tue Jun 7 13:04:22 2016 -0700 Add some determinism tests These are the tests that I accumulated fixing real issues. Each test is a separate thing that was broken and they are relatively small. GHC Trac: #4012 >--------------------------------------------------------------- d4b548efea15943026dd0d4929b6f0f999b4d718 testsuite/driver/extra_files.py | 10 + testsuite/tests/determinism/determ007/A.hs | 3 + testsuite/tests/determinism/determ007/Makefile | 13 ++ testsuite/tests/determinism/determ007/all.T | 4 + .../determ007.stdout} | 0 testsuite/tests/determinism/determ008/A.hs | 3 + testsuite/tests/determinism/determ008/Makefile | 13 ++ testsuite/tests/determinism/determ008/all.T | 4 + .../determ008.stdout} | 0 testsuite/tests/determinism/determ009/A.hs | 4 + testsuite/tests/determinism/determ009/Makefile | 13 ++ testsuite/tests/determinism/determ009/all.T | 4 + .../determ009.stdout} | 0 testsuite/tests/determinism/determ011/A.hs | 26 +++ testsuite/tests/determinism/determ011/Makefile | 13 ++ testsuite/tests/determinism/determ011/all.T | 4 + .../determ011.stdout} | 0 testsuite/tests/determinism/determ012/A.hs | 10 + testsuite/tests/determinism/determ012/Makefile | 13 ++ testsuite/tests/determinism/determ012/all.T | 4 + .../tests/determinism/determ012/determ012.stdout | 2 + testsuite/tests/determinism/determ013/A.hs | 19 ++ testsuite/tests/determinism/determ013/Makefile | 13 ++ testsuite/tests/determinism/determ013/all.T | 4 + .../tests/determinism/determ013/determ013.stdout | 2 + .../T10934.hs => determinism/determ014/A.hs} | 0 testsuite/tests/determinism/determ014/Makefile | 13 ++ testsuite/tests/determinism/determ014/all.T | 4 + .../tests/determinism/determ014/determ014.stdout | 2 + testsuite/tests/determinism/determ015/A.hs | 59 ++++++ testsuite/tests/determinism/determ015/Makefile | 13 ++ testsuite/tests/determinism/determ015/all.T | 4 + .../determ015.stdout} | 0 testsuite/tests/determinism/determ016/A.hs | 19 ++ testsuite/tests/determinism/determ016/Makefile | 13 ++ testsuite/tests/determinism/determ016/all.T | 4 + .../determ016.stdout} | 0 testsuite/tests/determinism/determ017/A.hs | 215 +++++++++++++++++++++ testsuite/tests/determinism/determ017/Makefile | 13 ++ testsuite/tests/determinism/determ017/all.T | 4 + .../determ017.stdout} | 0 41 files changed, 544 insertions(+) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d4b548efea15943026dd0d4929b6f0f999b4d718 From git at git.haskell.org Wed Jun 8 08:43:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Jun 2016 08:43:50 +0000 (UTC) Subject: [commit: ghc] master: Desugar: Display resulting program stats with -v2 (dd33245) Message-ID: <20160608084350.B13613A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dd33245922a9d363bdb8c34d00ed4d1574bc5285/ghc >--------------------------------------------------------------- commit dd33245922a9d363bdb8c34d00ed4d1574bc5285 Author: ?mer Sinan A?acan Date: Wed Jun 8 04:47:05 2016 -0400 Desugar: Display resulting program stats with -v2 Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2310 >--------------------------------------------------------------- dd33245922a9d363bdb8c34d00ed4d1574bc5285 compiler/deSugar/Desugar.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index 7ce0c6d..4ba9b6a 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -31,6 +31,7 @@ import Class import Avail import CoreSyn import CoreFVs( exprsSomeFreeVarsList ) +import CoreStats ( coreBindsStats ) import CoreSubst import PprCore import DsMonad @@ -389,6 +390,11 @@ deSugar hsc_env mg_safe_haskell = safe_mode, mg_trust_pkg = imp_trust_own_pkg imports } + + ; debugTraceMsg dflags 2 $ + sep [ text "Result size of Desugar" + , nest 2 (equals <+> ppr (coreBindsStats ds_binds)) ] + ; return (msgs, Just mod_guts) }}}} From git at git.haskell.org Wed Jun 8 08:53:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Jun 2016 08:53:10 +0000 (UTC) Subject: [commit: ghc] master: Revert "Desugar: Display resulting program stats with -v2" (44a3c18) Message-ID: <20160608085310.026913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/44a3c18292a02d50a8237545a31562b5a5359773/ghc >--------------------------------------------------------------- commit 44a3c18292a02d50a8237545a31562b5a5359773 Author: ?mer Sinan A?acan Date: Wed Jun 8 04:55:17 2016 -0400 Revert "Desugar: Display resulting program stats with -v2" This reverts commit dd33245922a9d363bdb8c34d00ed4d1574bc5285. It seems like we already have `endPassIO` calls here, which should print term sizes. For some reason they don't sometimes, and we need to understand why instead of adding more prints. >--------------------------------------------------------------- 44a3c18292a02d50a8237545a31562b5a5359773 compiler/deSugar/Desugar.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index 4ba9b6a..7ce0c6d 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -31,7 +31,6 @@ import Class import Avail import CoreSyn import CoreFVs( exprsSomeFreeVarsList ) -import CoreStats ( coreBindsStats ) import CoreSubst import PprCore import DsMonad @@ -390,11 +389,6 @@ deSugar hsc_env mg_safe_haskell = safe_mode, mg_trust_pkg = imp_trust_own_pkg imports } - - ; debugTraceMsg dflags 2 $ - sep [ text "Result size of Desugar" - , nest 2 (equals <+> ppr (coreBindsStats ds_binds)) ] - ; return (msgs, Just mod_guts) }}}} From git at git.haskell.org Wed Jun 8 10:59:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Jun 2016 10:59:17 +0000 (UTC) Subject: [commit: ghc] master: Report term sizes with -v3 even when -ddump is enabled (c2bbc8b) Message-ID: <20160608105917.6D9193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c2bbc8baf6947e00689b556e6e30e1ec39d2e68a/ghc >--------------------------------------------------------------- commit c2bbc8baf6947e00689b556e6e30e1ec39d2e68a Author: ?mer Sinan A?acan Date: Wed Jun 8 07:02:29 2016 -0400 Report term sizes with -v3 even when -ddump is enabled This is the proper fix for the problem I tried solve with D2310 (committed as dd33245 and reverted in 44a3c18). Reviewers: austin, goldfire, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2315 >--------------------------------------------------------------- c2bbc8baf6947e00689b556e6e30e1ec39d2e68a compiler/coreSyn/CoreLint.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 0261f7e..9c5b033 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -211,13 +211,14 @@ dumpPassResult :: DynFlags -> CoreProgram -> [CoreRule] -> IO () dumpPassResult dflags unqual mb_flag hdr extra_info binds rules - | Just flag <- mb_flag - = Err.dumpSDoc dflags unqual flag (showSDoc dflags hdr) dump_doc + = do { forM_ mb_flag $ \flag -> + Err.dumpSDoc dflags unqual flag (showSDoc dflags hdr) dump_doc - | otherwise - = Err.debugTraceMsg dflags 2 size_doc - -- Report result size - -- This has the side effect of forcing the intermediate to be evaluated + -- Report result size + -- This has the side effect of forcing the intermediate to be evaluated + -- if it's not already forced by a -ddump flag. + ; Err.debugTraceMsg dflags 2 size_doc + } where size_doc = sep [text "Result size of" <+> hdr, nest 2 (equals <+> ppr (coreBindsStats binds))] From git at git.haskell.org Wed Jun 8 13:26:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Jun 2016 13:26:04 +0000 (UTC) Subject: [commit: ghc] master: Literal: Remove unused hashLiteral function (80cf4cf) Message-ID: <20160608132604.D17F73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/80cf4cf0b7ff1513811d985726714c654ef7f032/ghc >--------------------------------------------------------------- commit 80cf4cf0b7ff1513811d985726714c654ef7f032 Author: ?mer Sinan A?acan Date: Wed Jun 8 08:16:53 2016 -0400 Literal: Remove unused hashLiteral function >--------------------------------------------------------------- 80cf4cf0b7ff1513811d985726714c654ef7f032 compiler/basicTypes/Literal.hs | 37 ------------------------------------- 1 file changed, 37 deletions(-) diff --git a/compiler/basicTypes/Literal.hs b/compiler/basicTypes/Literal.hs index 4d3c23b..769bb51 100644 --- a/compiler/basicTypes/Literal.hs +++ b/compiler/basicTypes/Literal.hs @@ -21,7 +21,6 @@ module Literal -- ** Operations on Literals , literalType - , hashLiteral , absentLiteralOf , pprLiteral @@ -58,7 +57,6 @@ import Util import Data.ByteString (ByteString) import Data.Int -import Data.Ratio import Data.Word import Data.Char import Data.Data ( Data ) @@ -500,38 +498,3 @@ MachDouble -1.0## LitInteger -1 (-1) MachLabel "__label" ... ("__label" ...) -} - -{- -************************************************************************ -* * -\subsection{Hashing} -* * -************************************************************************ - -Hash values should be zero or a positive integer. No negatives please. -(They mess up the UniqFM for some reason.) --} - -hashLiteral :: Literal -> Int -hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints -hashLiteral (MachStr s) = hashByteString s -hashLiteral (MachNullAddr) = 0 -hashLiteral (MachInt i) = hashInteger i -hashLiteral (MachInt64 i) = hashInteger i -hashLiteral (MachWord i) = hashInteger i -hashLiteral (MachWord64 i) = hashInteger i -hashLiteral (MachFloat r) = hashRational r -hashLiteral (MachDouble r) = hashRational r -hashLiteral (MachLabel s _ _) = hashFS s -hashLiteral (LitInteger i _) = hashInteger i - -hashRational :: Rational -> Int -hashRational r = hashInteger (numerator r) - -hashInteger :: Integer -> Int -hashInteger i = 1 + abs (fromInteger (i `rem` 10000)) - -- The 1+ is to avoid zero, which is a Bad Number - -- since we use * to combine hash values - -hashFS :: FastString -> Int -hashFS s = uniqueOfFS s From git at git.haskell.org Wed Jun 8 13:32:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Jun 2016 13:32:33 +0000 (UTC) Subject: [commit: ghc] master: Show sources of cost centers in .prof (d7933cb) Message-ID: <20160608133233.30E6B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d7933cbc28f4f094eba3d128bc147920f68c965b/ghc >--------------------------------------------------------------- commit d7933cbc28f4f094eba3d128bc147920f68c965b Author: ?mer Sinan A?acan Date: Wed Jun 8 09:30:32 2016 -0400 Show sources of cost centers in .prof This fixes the problem with duplicate cost-centre names that was reported a couple of times before. When a module implements a typeclass multiple times for different types, methods of different implementations get same cost-centre names and are reported like this: COST CENTRE MODULE %time %alloc CAF GHC.IO.Handle.FD 0.0 32.8 CAF GHC.Read 0.0 1.0 CAF GHC.IO.Encoding 0.0 1.8 showsPrec Main 0.0 1.2 readPrec Main 0.0 19.4 readPrec Main 0.0 20.5 main Main 0.0 20.2 individual inherited COST CENTRE MODULE no. entries %time %alloc %time %alloc MAIN MAIN 53 0 0.0 0.2 0.0 100.0 CAF Main 105 0 0.0 0.3 0.0 62.5 readPrec Main 109 1 0.0 0.6 0.0 0.6 readPrec Main 107 1 0.0 0.6 0.0 0.6 main Main 106 1 0.0 20.2 0.0 61.0 == Main 114 1 0.0 0.0 0.0 0.0 == Main 113 1 0.0 0.0 0.0 0.0 showsPrec Main 112 2 0.0 1.2 0.0 1.2 showsPrec Main 111 2 0.0 0.9 0.0 0.9 readPrec Main 110 0 0.0 18.8 0.0 18.8 readPrec Main 108 0 0.0 19.9 0.0 19.9 It's not possible to tell from the report which `==` took how long. This patch adds one more column at the cost of making outputs wider. The report now looks like this: COST CENTRE MODULE SRC %time %alloc CAF GHC.IO.Handle.FD 0.0 32.9 CAF GHC.IO.Encoding 0.0 1.8 CAF GHC.Read 0.0 1.0 showsPrec Main Main_1.hs:7:19-22 0.0 1.2 readPrec Main Main_1.hs:7:13-16 0.0 19.5 readPrec Main Main_1.hs:4:13-16 0.0 20.5 main Main Main_1.hs:(10,1)-(20,20) 0.0 20.2 individual inherited COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc MAIN MAIN 53 0 0.0 0.2 0.0 100.0 CAF Main 105 0 0.0 0.3 0.0 62.5 readPrec Main Main_1.hs:7:13-16 109 1 0.0 0.6 0.0 0.6 readPrec Main Main_1.hs:4:13-16 107 1 0.0 0.6 0.0 0.6 main Main Main_1.hs:(10,1)-(20,20) 106 1 0.0 20.2 0.0 61.0 == Main Main_1.hs:7:25-26 114 1 0.0 0.0 0.0 0.0 == Main Main_1.hs:4:25-26 113 1 0.0 0.0 0.0 0.0 showsPrec Main Main_1.hs:7:19-22 112 2 0.0 1.2 0.0 1.2 showsPrec Main Main_1.hs:4:19-22 111 2 0.0 0.9 0.0 0.9 readPrec Main Main_1.hs:7:13-16 110 0 0.0 18.8 0.0 18.8 readPrec Main Main_1.hs:4:13-16 108 0 0.0 19.9 0.0 19.9 CAF Text.Read.Lex 102 0 0.0 0.5 0.0 0.5 To fix failing test cases because of different orderings of cost centres (e.g. optimized and non-optimized build printing in different order), with this patch we also start sorting cost centres before printing. The order depends on 1) entries (more entered cost centres come first) 2) names (using strcmp() on cost centre names). Reviewers: simonmar, austin, erikd, bgamari Reviewed By: simonmar, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2282 GHC Trac Issues: #11543, #8473, #7105 >--------------------------------------------------------------- d7933cbc28f4f094eba3d128bc147920f68c965b rts/Profiling.c | 112 +++++++++++++++++---- testsuite/driver/testlib.py | 47 ++++++--- .../tests/profiling/should_run/T2552.prof.sample | 57 ++++++----- .../tests/profiling/should_run/T5559.prof.sample | 33 +++--- .../profiling/should_run/T5654b-O0.prof.sample | 40 ++++---- .../profiling/should_run/T5654b-O1.prof.sample | 40 ++++---- .../tests/profiling/should_run/T680.prof.sample | 65 ++++++------ testsuite/tests/profiling/should_run/all.T | 2 +- .../tests/profiling/should_run/ioprof.prof.sample | 74 +++++++------- .../profiling/should_run/prof-doc-fib.prof.sample | 41 ++++---- .../profiling/should_run/prof-doc-last.prof.sample | 54 +++++----- .../profiling/should_run/profinline001.prof.sample | 39 ++++--- .../tests/profiling/should_run/scc001.prof.sample | 48 ++++----- .../tests/profiling/should_run/scc002.prof.sample | 45 +++++---- .../tests/profiling/should_run/scc003.prof.sample | 54 +++++----- .../tests/profiling/should_run/scc005.prof.sample | 35 ++++--- 16 files changed, 441 insertions(+), 345 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 d7933cbc28f4f094eba3d128bc147920f68c965b From git at git.haskell.org Thu Jun 9 04:23:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Jun 2016 04:23:57 +0000 (UTC) Subject: [commit: ghc] master: Fix #12076 by inlining trivial expressions in CorePrep. (11ff1df) Message-ID: <20160609042357.901443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/11ff1df8a7c25485c9c7508d65bcb380e592010d/ghc >--------------------------------------------------------------- commit 11ff1df8a7c25485c9c7508d65bcb380e592010d Author: Edward Z. Yang Date: Mon May 16 21:05:24 2016 -0700 Fix #12076 by inlining trivial expressions in CorePrep. Summary: This mostly follows the plan detailed by the discussion Simon and I had, with one difference: instead of grabbing the free variables of the trivial expressions to get the embedded Ids, we just use getIdFromTrivialExpr_maybe to extract out the Id. If there is no Id, the expression cannot refer to a function (as there are no literal functions) and thus we do not need to saturate. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2309 GHC Trac Issues: #12076 >--------------------------------------------------------------- 11ff1df8a7c25485c9c7508d65bcb380e592010d compiler/basicTypes/BasicTypes.hs | 1 + compiler/coreSyn/CoreArity.hs | 4 +- compiler/coreSyn/CorePrep.hs | 126 +++++++++++++++++++-- compiler/coreSyn/CoreUtils.hs | 25 +++- compiler/main/TidyPgm.hs | 4 +- .../tests/simplCore/should_compile/T12076lit.hs | 19 ++++ .../tests/simplCore/should_compile/T12076sat.hs | 9 ++ testsuite/tests/simplCore/should_compile/all.T | 4 +- 8 files changed, 172 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 11ff1df8a7c25485c9c7508d65bcb380e592010d From git at git.haskell.org Thu Jun 9 04:24:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Jun 2016 04:24:00 +0000 (UTC) Subject: [commit: ghc] master: Fix #12064 by making IfaceClass typechecking more lazy. (8f6d292) Message-ID: <20160609042400.B43793A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8f6d292746217f1fa9f645ff8d191943af1c5771/ghc >--------------------------------------------------------------- commit 8f6d292746217f1fa9f645ff8d191943af1c5771 Author: Edward Z. Yang Date: Sun May 15 16:13:51 2016 -0700 Fix #12064 by making IfaceClass typechecking more lazy. Summary: Comes with a test based off of prog006. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2221 GHC Trac Issues: #12064 >--------------------------------------------------------------- 8f6d292746217f1fa9f645ff8d191943af1c5771 compiler/iface/TcIface.hs | 21 ++++++++++++--------- compiler/typecheck/TcRnDriver.hs | 2 +- testsuite/tests/typecheck/should_compile/T12064.hs | 4 ++++ .../tests/typecheck/should_compile/T12064.hs-boot | 2 ++ testsuite/tests/typecheck/should_compile/T12064a.hs | 4 ++++ testsuite/tests/typecheck/should_compile/all.T | 2 ++ 6 files changed, 25 insertions(+), 10 deletions(-) diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index 320594c..a6486f3 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -426,20 +426,23 @@ tc_iface_decl _parent ignore_prags tc_sig :: IfaceClassOp -> IfL TcMethInfo tc_sig (IfaceClassOp occ rdr_ty dm) = do { op_name <- lookupIfaceTop occ - ; ~(op_ty, dm') <- forkM (mk_op_doc op_name rdr_ty) $ - do { ty <- tcIfaceType rdr_ty - ; dm' <- tc_dm dm - ; return (ty, dm') } + ; let doc = mk_op_doc op_name rdr_ty + ; op_ty <- forkM (doc <+> text "ty") $ tcIfaceType rdr_ty -- Must be done lazily for just the same reason as the -- type of a data con; to avoid sucking in types that -- it mentions unless it's necessary to do so + ; dm' <- tc_dm doc dm ; return (op_name, op_ty, dm') } - tc_dm :: Maybe (DefMethSpec IfaceType) -> IfL (Maybe (DefMethSpec Type)) - tc_dm Nothing = return Nothing - tc_dm (Just VanillaDM) = return (Just VanillaDM) - tc_dm (Just (GenericDM ty)) = do { ty' <- tcIfaceType ty - ; return (Just (GenericDM ty')) } + tc_dm :: SDoc + -> Maybe (DefMethSpec IfaceType) + -> IfL (Maybe (DefMethSpec Type)) + tc_dm _ Nothing = return Nothing + tc_dm _ (Just VanillaDM) = return (Just VanillaDM) + tc_dm doc (Just (GenericDM ty)) + = do { -- Must be done lazily to avoid sucking in types + ; ty' <- forkM (doc <+> text "dm") $ tcIfaceType ty + ; return (Just (GenericDM ty')) } tc_at cls (IfaceAT tc_decl if_def) = do ATyCon tc <- tc_iface_decl (Just cls) ignore_prags tc_decl diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 5e83305..c6865f5 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -363,7 +363,7 @@ tcRnModuleTcRnM hsc_env hsc_src Nothing -> return tcg_env) ; -- The new type env is already available to stuff slurped from - -- interface files, via TcEnv.updateGlobalTypeEnv + -- interface files, via TcEnv.setGlobalTypeEnv -- It's important that this includes the stuff in checkHiBootIface, -- because the latter might add new bindings for boot_dfuns, -- which may be mentioned in imported unfoldings diff --git a/testsuite/tests/typecheck/should_compile/T12064.hs b/testsuite/tests/typecheck/should_compile/T12064.hs new file mode 100644 index 0000000..0c3d1b3 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T12064.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE ExistentialQuantification #-} +module T12064 where +import T12064a +data D = forall n. K n => DCon n diff --git a/testsuite/tests/typecheck/should_compile/T12064.hs-boot b/testsuite/tests/typecheck/should_compile/T12064.hs-boot new file mode 100644 index 0000000..4536cf3 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T12064.hs-boot @@ -0,0 +1,2 @@ +module T12064 where +data D diff --git a/testsuite/tests/typecheck/should_compile/T12064a.hs b/testsuite/tests/typecheck/should_compile/T12064a.hs new file mode 100644 index 0000000..381edfc --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T12064a.hs @@ -0,0 +1,4 @@ +module T12064a where +import {-# SOURCE #-} T12064 +class K a where + kfun :: D -> a diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index e58feae..0f43d00 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -515,3 +515,5 @@ test('T11811', normal, compile, ['']) test('T11793', normal, compile, ['']) test('T11348', normal, compile, ['']) test('T11947', normal, compile, ['']) +test('T12064', extra_clean(['T12064.hi-boot', 'T12064.o-boot', 'T11062a.hi', 'T11062a.o']), + multimod_compile, ['T12064', '-v0']) From git at git.haskell.org Thu Jun 9 04:24:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Jun 2016 04:24:03 +0000 (UTC) Subject: [commit: ghc] master: Minor performance note about IdInfo. (acb9e85) Message-ID: <20160609042403.611D93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/acb9e85cad6b26a7f69276bac709b6406ff7ab6e/ghc >--------------------------------------------------------------- commit acb9e85cad6b26a7f69276bac709b6406ff7ab6e Author: Edward Z. Yang Date: Mon Jun 6 10:18:57 2016 -0700 Minor performance note about IdInfo. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- acb9e85cad6b26a7f69276bac709b6406ff7ab6e compiler/basicTypes/IdInfo.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs index 2113cd4..97d4186 100644 --- a/compiler/basicTypes/IdInfo.hs +++ b/compiler/basicTypes/IdInfo.hs @@ -198,6 +198,10 @@ pprIdDetails other = brackets (pp other) -- Most of the 'IdInfo' gives information about the value, or definition, of -- the 'Id', independent of its usage. Exceptions to this -- are 'demandInfo', 'occInfo', 'oneShotInfo' and 'callArityInfo'. +-- +-- Performance note: when we update 'IdInfo', we have to reallocate this +-- entire record, so it is a good idea not to let this data structure get +-- too big. data IdInfo = IdInfo { arityInfo :: !ArityInfo, -- ^ 'Id' arity From git at git.haskell.org Thu Jun 9 09:28:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Jun 2016 09:28:45 +0000 (UTC) Subject: [commit: ghc] master: Remove special casing of Windows in generic files (48385cb) Message-ID: <20160609092845.761223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/48385cb2fc295eb8af9188cbe140142c1807d5a7/ghc >--------------------------------------------------------------- commit 48385cb2fc295eb8af9188cbe140142c1807d5a7 Author: Tamar Christina Date: Tue May 31 20:12:55 2016 +0200 Remove special casing of Windows in generic files Summary: Remove some Windows specific code from the .m4 files and have configure figure it out. Unfortunately touchy can't be removed since there is no mingw build of coreutils. Only msys builds which would give us a dependency on the msys runtime. Reviewers: hvr, austin, thomie, bgamari Reviewed By: thomie, bgamari Subscribers: thomie, erikd, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2248 >--------------------------------------------------------------- 48385cb2fc295eb8af9188cbe140142c1807d5a7 aclocal.m4 | 49 +++++++++++++++++++++++++++++++------------------ configure.ac | 13 +++++-------- utils/touchy/touchy.c | 5 +++++ 3 files changed, 41 insertions(+), 26 deletions(-) diff --git a/aclocal.m4 b/aclocal.m4 index dcc3448..cbf51df 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -458,42 +458,55 @@ AC_DEFUN([GET_ARM_ISA], # Set the variables used in the settings file AC_DEFUN([FP_SETTINGS], [ - if test "$windows" = YES + SettingsCCompilerCommand="$CC" + SettingsHaskellCPPCommand="$HaskellCPPCmd" + SettingsHaskellCPPFlags="$HaskellCPPArgs" + SettingsLdCommand="$LdCmd" + SettingsArCommand="$ArCmd" + SettingsPerlCommand="$PerlCmd" + + if test -z "$DllWrap" then - mingw_bin_prefix=mingw/bin/ - SettingsCCompilerCommand="\$topdir/../${mingw_bin_prefix}gcc.exe" - SettingsHaskellCPPCommand="\$topdir/../${mingw_bin_prefix}gcc.exe" - SettingsHaskellCPPFlags="$HaskellCPPArgs" - SettingsLdCommand="\$topdir/../${mingw_bin_prefix}ld.exe" - SettingsArCommand="\$topdir/../${mingw_bin_prefix}ar.exe" - SettingsPerlCommand='$topdir/../perl/perl.exe' - SettingsDllWrapCommand="\$topdir/../${mingw_bin_prefix}dllwrap.exe" - SettingsWindresCommand="\$topdir/../${mingw_bin_prefix}windres.exe" - SettingsTouchCommand='$topdir/bin/touchy.exe' - else - SettingsCCompilerCommand="$CC" - SettingsHaskellCPPCommand="$HaskellCPPCmd" - SettingsHaskellCPPFlags="$HaskellCPPArgs" - SettingsLdCommand="$LdCmd" - SettingsArCommand="$ArCmd" - SettingsPerlCommand="$PerlCmd" SettingsDllWrapCommand="/bin/false" + else + SettingsDllWrapCommand="$DllWrap" + fi + + if test -z "$Windres" + then SettingsWindresCommand="/bin/false" + else + SettingsWindresCommand="$Windres" + fi + + if test -z "$Libtool" + then SettingsLibtoolCommand="libtool" + else + SettingsLibtoolCommand="$Libtool" + fi + + if test -z "$Touch" + then SettingsTouchCommand='touch' + else + SettingsTouchCommand='$Touch' fi + if test -z "$LlcCmd" then SettingsLlcCommand="llc" else SettingsLlcCommand="$LlcCmd" fi + if test -z "$OptCmd" then SettingsOptCommand="opt" else SettingsOptCommand="$OptCmd" fi + SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2" diff --git a/configure.ac b/configure.ac index 15561d0..d7eb738 100644 --- a/configure.ac +++ b/configure.ac @@ -177,13 +177,9 @@ then if test "$ghc_host_os" = "mingw32" then - if test "${OSTYPE}" = "msys" - then - WithGhc=`echo "${WithGhc}" | sed "s#^/\([a-zA-Z]\)/#\1:/#"` - else - # Canonicalise to :/path/to/ghc - WithGhc=`cygpath -m "${WithGhc}"` - fi + # Canonicalise to :/path/to/ghc + WithGhc=`cygpath -m "${WithGhc}"` + echo "GHC path canonicalised to: ${WithGhc}" fi fi @@ -366,6 +362,8 @@ then NM="${mingwbin}nm.exe" RANLIB="${mingwbin}ranlib.exe" OBJDUMP="${mingwbin}objdump.exe" + Windres="${mingwbin}windres.exe" + DllWrap="${mingwbin}dllwrap.exe" fp_prog_ar="${mingwbin}ar.exe" # NB. Download the perl binaries if required @@ -733,7 +731,6 @@ AC_SUBST(HaveDtrace) AC_PATH_PROG(HSCOLOUR,HsColour) # HsColour is passed to Cabal, so we need a native path if test "$HostOS" = "mingw32" && \ - test "${OSTYPE}" != "msys" && \ test "${HSCOLOUR}" != "" then # Canonicalise to :/path/to/gcc diff --git a/utils/touchy/touchy.c b/utils/touchy/touchy.c index 88ababa..dbcf712 100644 --- a/utils/touchy/touchy.c +++ b/utils/touchy/touchy.c @@ -14,6 +14,11 @@ #include /* +touch is used by GHC both during building and during compilation of +Haskell files. Unfortunately this means we need a 'touch' like program +in the GHC bindist. Since touch is not standard on Windows and msys2 +doesn't include a mingw-w64 build of coreutils we need touchy for now. + With Windows 7 in a virtual box VM on OS X, some very odd things happen with dates and time stamps when SSHing into cygwin. e.g. here the "Change" time is in the past: From git at git.haskell.org Thu Jun 9 10:47:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Jun 2016 10:47:33 +0000 (UTC) Subject: [commit: ghc] master: Implement Eq TyCon directly (ceaf7f1) Message-ID: <20160609104733.8CD233A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ceaf7f10865cd27eaa16a5e1fd308799c00e0607/ghc >--------------------------------------------------------------- commit ceaf7f10865cd27eaa16a5e1fd308799c00e0607 Author: Bartosz Nitka Date: Thu Jun 9 03:49:00 2016 -0700 Implement Eq TyCon directly Eq TyCon is defined in terms of Ord TyCon, but we want to remove Ord TyCon, because it's implemented in terms of unique comparison, which is nondeterministic. GHC Trac: #4012 >--------------------------------------------------------------- ceaf7f10865cd27eaa16a5e1fd308799c00e0607 compiler/types/TyCon.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index c60e410..bafcb2c 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -2072,8 +2072,8 @@ tyConRuntimeRepInfo _ = NoRRI -} instance Eq TyCon where - a == b = case (a `compare` b) of { EQ -> True; _ -> False } - a /= b = case (a `compare` b) of { EQ -> False; _ -> True } + a == b = getUnique a == getUnique b + a /= b = getUnique a /= getUnique b instance Ord TyCon where a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False } From git at git.haskell.org Thu Jun 9 10:55:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Jun 2016 10:55:40 +0000 (UTC) Subject: [commit: ghc] master: Remove Ord (CoAxiom br) (68c1c29) Message-ID: <20160609105540.1C4B43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/68c1c29d9c43a22a5cbd34fd67b7c543ede17eac/ghc >--------------------------------------------------------------- commit 68c1c29d9c43a22a5cbd34fd67b7c543ede17eac Author: Bartosz Nitka Date: Thu Jun 9 03:55:38 2016 -0700 Remove Ord (CoAxiom br) It was implemented in terms of Uniques, but fortunately it's unused so we can remove it. GHC Trac: #4012 >--------------------------------------------------------------- 68c1c29d9c43a22a5cbd34fd67b7c543ede17eac compiler/types/CoAxiom.hs | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/compiler/types/CoAxiom.hs b/compiler/types/CoAxiom.hs index fb1b4ff..89d9bef 100644 --- a/compiler/types/CoAxiom.hs +++ b/compiler/types/CoAxiom.hs @@ -381,15 +381,8 @@ See also Note [Implicit TyThings] in HscTypes -} instance Eq (CoAxiom br) where - a == b = case (a `compare` b) of { EQ -> True; _ -> False } - a /= b = case (a `compare` b) of { EQ -> False; _ -> True } - -instance Ord (CoAxiom br) where - a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False } - a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False } - a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True } - a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True } - compare a b = getUnique a `compare` getUnique b + a == b = getUnique a == getUnique b + a /= b = getUnique a /= getUnique b instance Uniquable (CoAxiom br) where getUnique = co_ax_unique From git at git.haskell.org Thu Jun 9 11:32:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Jun 2016 11:32:11 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: delete dead code [skip ci] (9dbf354) Message-ID: <20160609113211.43A013A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9dbf354fbc35d412e442271fb1ed805f2f279b09/ghc >--------------------------------------------------------------- commit 9dbf354fbc35d412e442271fb1ed805f2f279b09 Author: Thomas Miedema Date: Wed Jun 8 15:38:40 2016 +0200 Testsuite: delete dead code [skip ci] >--------------------------------------------------------------- 9dbf354fbc35d412e442271fb1ed805f2f279b09 testsuite/driver/testlib.py | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index fb93721..f6db828 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1918,25 +1918,6 @@ def runCmdFor( name, cmd, timeout_multiplier=1.0 ): def runCmdExitCode( cmd ): return (runCmd(cmd) >> 8); - -# ----------------------------------------------------------------------------- -# Files that are read or written but shouldn't be: -# * ghci_history shouldn't be read or written by tests -# * things under package.conf.d shouldn't be written by tests -bad_file_usages = {} - -def add_bad_file_usage(name, file): - try: - if not file in bad_file_usages[name]: - bad_file_usages[name].append(file) - except: - bad_file_usages[name] = [file] - -def mkPath(curdir, path): - # Given the current full directory is 'curdir', what is the full - # path to 'path'? - return os.path.realpath(os.path.join(curdir, path)) - # ----------------------------------------------------------------------------- # checking if ghostscript is available for checking the output of hp2ps From git at git.haskell.org Thu Jun 9 11:32:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Jun 2016 11:32:14 +0000 (UTC) Subject: [commit: ghc] master: Docs: fix links to ghc-flags (e703a23) Message-ID: <20160609113214.02AEA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e703a232174fd6e6cc42f2b27a2d9a2a17957aa7/ghc >--------------------------------------------------------------- commit e703a232174fd6e6cc42f2b27a2d9a2a17957aa7 Author: Thomas Miedema Date: Thu Jun 9 13:26:35 2016 +0200 Docs: fix links to ghc-flags >--------------------------------------------------------------- e703a232174fd6e6cc42f2b27a2d9a2a17957aa7 docs/users_guide/glasgow_exts.rst | 2 +- utils/mkUserGuidePart/Options/Language.hs | 70 +++++++++++----------- utils/mkUserGuidePart/Options/Linking.hs | 4 +- utils/mkUserGuidePart/Options/Misc.hs | 2 +- utils/mkUserGuidePart/Options/Optimizations.hs | 50 ++++++++-------- utils/mkUserGuidePart/Options/Phases.hs | 2 +- .../Options/RecompilationChecking.hs | 2 +- utils/mkUserGuidePart/Options/Verbosity.hs | 6 +- utils/mkUserGuidePart/Options/Warnings.hs | 28 ++++----- 9 files changed, 83 insertions(+), 83 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 e703a232174fd6e6cc42f2b27a2d9a2a17957aa7 From git at git.haskell.org Thu Jun 9 11:47:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Jun 2016 11:47:49 +0000 (UTC) Subject: [commit: ghc] master: Remove Ord Class (70e0a56) Message-ID: <20160609114749.3342D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/70e0a5644b8c20f70d6349cb4e0a0f0f1c06f5a0/ghc >--------------------------------------------------------------- commit 70e0a5644b8c20f70d6349cb4e0a0f0f1c06f5a0 Author: Bartosz Nitka Date: Thu Jun 9 04:48:15 2016 -0700 Remove Ord Class It was implemented in terms of Unique which is nondeterministic GHC Trac: #4012 >--------------------------------------------------------------- 70e0a5644b8c20f70d6349cb4e0a0f0f1c06f5a0 compiler/types/Class.hs | 7 ------- 1 file changed, 7 deletions(-) diff --git a/compiler/types/Class.hs b/compiler/types/Class.hs index 93cc72f..27afe4d 100644 --- a/compiler/types/Class.hs +++ b/compiler/types/Class.hs @@ -279,13 +279,6 @@ instance Eq Class where c1 == c2 = classKey c1 == classKey c2 c1 /= c2 = classKey c1 /= classKey c2 -instance Ord Class where - c1 <= c2 = classKey c1 <= classKey c2 - c1 < c2 = classKey c1 < classKey c2 - c1 >= c2 = classKey c1 >= classKey c2 - c1 > c2 = classKey c1 > classKey c2 - compare c1 c2 = classKey c1 `compare` classKey c2 - instance Uniquable Class where getUnique c = classKey c From git at git.haskell.org Thu Jun 9 11:50:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Jun 2016 11:50:21 +0000 (UTC) Subject: [commit: ghc] master: Remove Ord PatSyn (b2624ee) Message-ID: <20160609115021.22E7E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b2624ee3efe847d553a9a8b822f88ff5bb056377/ghc >--------------------------------------------------------------- commit b2624ee3efe847d553a9a8b822f88ff5bb056377 Author: Bartosz Nitka Date: Thu Jun 9 04:52:48 2016 -0700 Remove Ord PatSyn It's implemented in terms of Unique which is nondeterministic GHC Trac: #4012 >--------------------------------------------------------------- b2624ee3efe847d553a9a8b822f88ff5bb056377 compiler/basicTypes/PatSyn.hs | 7 ------- 1 file changed, 7 deletions(-) diff --git a/compiler/basicTypes/PatSyn.hs b/compiler/basicTypes/PatSyn.hs index 5ff99e0..3c5e709 100644 --- a/compiler/basicTypes/PatSyn.hs +++ b/compiler/basicTypes/PatSyn.hs @@ -270,13 +270,6 @@ instance Eq PatSyn where (==) = (==) `on` getUnique (/=) = (/=) `on` getUnique -instance Ord PatSyn where - (<=) = (<=) `on` getUnique - (<) = (<) `on` getUnique - (>=) = (>=) `on` getUnique - (>) = (>) `on` getUnique - compare = compare `on` getUnique - instance Uniquable PatSyn where getUnique = psUnique From git at git.haskell.org Thu Jun 9 14:25:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Jun 2016 14:25:00 +0000 (UTC) Subject: [commit: ghc] master: Remove Ord AltCon (77b8c29) Message-ID: <20160609142500.8B3E13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/77b8c29b8baf9b84df6c8352d7f785c75522eff4/ghc >--------------------------------------------------------------- commit 77b8c29b8baf9b84df6c8352d7f785c75522eff4 Author: Bartosz Nitka Date: Thu Jun 9 07:25:11 2016 -0700 Remove Ord AltCon It uses Ord DataCon which uses Ord Unique which is nondeterministic GHC Trac: #4012 >--------------------------------------------------------------- 77b8c29b8baf9b84df6c8352d7f785c75522eff4 compiler/coreSyn/CoreSyn.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 6fb1a33..a6f8f82 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -292,7 +292,7 @@ data AltCon -- See Note [Literal alternatives] | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@ - deriving (Eq, Ord, Data) + deriving (Eq, Data) -- | Binding, used for top level bindings in a module and local bindings in a @let at . From git at git.haskell.org Thu Jun 9 15:37:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Jun 2016 15:37:27 +0000 (UTC) Subject: [commit: ghc] master: Docs: delete PatternGuards documentation (c22ab1a) Message-ID: <20160609153727.870CC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c22ab1a6d72bc03a6c459d7b6991730b5b1d9b1f/ghc >--------------------------------------------------------------- commit c22ab1a6d72bc03a6c459d7b6991730b5b1d9b1f Author: Thomas Miedema Date: Thu Jun 9 13:51:09 2016 +0200 Docs: delete PatternGuards documentation Since `-XPatternGuards` is enabled by default, invert the logic and mention `-XNoPatternGuards` first. Also, since this is a Haskell 2010 feature, refer to the language report instead of explaining it. In general, I would like to follow the guideline of assuming the latest language report as a given, and then only report GHC's deviations and extensions relative to that report. Reviewed by: bgamari Differential Revision: https://phabricator.haskell.org/D2319 GHC Trac Issues: #12172 >--------------------------------------------------------------- c22ab1a6d72bc03a6c459d7b6991730b5b1d9b1f docs/users_guide/glasgow_exts.rst | 101 ++---------------------------- utils/mkUserGuidePart/Options/Language.hs | 14 +++-- 2 files changed, 14 insertions(+), 101 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 205b49c..1b24db2 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -417,103 +417,13 @@ instance, the binary integer literal ``0b11001001`` will be desugared into Pattern guards -------------- -.. ghc-flag:: -XPatternGuards +.. ghc-flag:: -XNoPatternGuards - Enable pattern matches in guards. + :implied by: :ghc-flag:`-XHaskell98` + :since: 6.8.1 -The discussion that follows is an abbreviated version of Simon Peyton Jones's -original `proposal -`__. (Note that the -proposal was written before pattern guards were implemented, so refers to them -as unimplemented.) - -Suppose we have an abstract data type of finite maps, with a lookup -operation: :: - - lookup :: FiniteMap -> Int -> Maybe Int - -The lookup returns ``Nothing`` if the supplied key is not in the domain -of the mapping, and ``(Just v)`` otherwise, where ``v`` is the value -that the key maps to. Now consider the following definition: :: - - clunky env var1 var2 - | ok1 && ok2 = val1 + val2 - | otherwise = var1 + var2 - where - m1 = lookup env var1 - m2 = lookup env var2 - ok1 = maybeToBool m1 - ok2 = maybeToBool m2 - val1 = expectJust m1 - val2 = expectJust m2 - -The auxiliary functions are :: - - maybeToBool :: Maybe a -> Bool - maybeToBool (Just x) = True - maybeToBool Nothing = False - - expectJust :: Maybe a -> a - expectJust (Just x) = x - expectJust Nothing = error "Unexpected Nothing" - -What is ``clunky`` doing? The guard ``ok1 && ok2`` checks that both -lookups succeed, using ``maybeToBool`` to convert the ``Maybe`` types to -booleans. The (lazily evaluated) ``expectJust`` calls extract the values -from the results of the lookups, and binds the returned values to -``val1`` and ``val2`` respectively. If either lookup fails, then clunky -takes the ``otherwise`` case and returns the sum of its arguments. - -This is certainly legal Haskell, but it is a tremendously verbose and -un-obvious way to achieve the desired effect. Arguably, a more direct -way to write clunky would be to use case expressions: :: - - clunky env var1 var2 = case lookup env var1 of - Nothing -> fail - Just val1 -> case lookup env var2 of - Nothing -> fail - Just val2 -> val1 + val2 - where - fail = var1 + var2 - -This is a bit shorter, but hardly better. Of course, we can rewrite any -set of pattern-matching, guarded equations as case expressions; that is -precisely what the compiler does when compiling equations! The reason -that Haskell provides guarded equations is because they allow us to -write down the cases we want to consider, one at a time, independently -of each other. This structure is hidden in the case version. Two of the -right-hand sides are really the same (``fail``), and the whole -expression tends to become more and more indented. - -Here is how I would write ``clunky``: :: - - clunky env var1 var2 - | Just val1 <- lookup env var1 - , Just val2 <- lookup env var2 - = val1 + val2 - ...other equations for clunky... - -The semantics should be clear enough. The qualifiers are matched in -order. For a ``<-`` qualifier, which I call a pattern guard, the right -hand side is evaluated and matched against the pattern on the left. If -the match fails then the whole guard fails and the next equation is -tried. If it succeeds, then the appropriate binding takes place, and the -next qualifier is matched, in the augmented environment. Unlike list -comprehensions, however, the type of the expression to the right of the -``<-`` is the same as the type of the pattern to its left. The bindings -introduced by pattern guards scope over all the remaining guard -qualifiers, and over the right hand side of the equation. - -Just as with list comprehensions, boolean expressions can be freely -mixed with among the pattern guards. For example: :: - - f x | [y] <- x - , y > 3 - , Just z <- h y - = ... - -Haskell's current guards therefore emerge as a special case, in which -the qualifier list has just one element, a boolean expression. +Disable `pattern guards +`__. .. _view-patterns: @@ -660,6 +570,7 @@ n+k patterns .. ghc-flag:: -XNPlusKPatterns + :implied by: :ghc-flag:`-XHaskell98` :since: 6.12 Enable use of ``n+k`` patterns. diff --git a/utils/mkUserGuidePart/Options/Language.hs b/utils/mkUserGuidePart/Options/Language.hs index 1bc0624..750342c 100644 --- a/utils/mkUserGuidePart/Options/Language.hs +++ b/utils/mkUserGuidePart/Options/Language.hs @@ -447,10 +447,11 @@ languageOptions = , flagReverse = "-XNoNegativeLiterals" , flagSince = "7.8.1" } - , flag { flagName = "-XNoNPlusKPatterns" - , flagDescription = "Disable support for ``n+k`` patterns." + , flag { flagName = "-XNPlusKPatterns" + , flagDescription = "Enable support for ``n+k`` patterns. "++ + "Implied by :ghc-flag:`-XHaskell98`." , flagType = DynamicFlag - , flagReverse = "-XNPlusKPatterns" + , flagReverse = "-XNoNPlusKPatterns" , flagSince = "6.12.1" } , flag { flagName = "-XNullaryTypeClasses" @@ -520,10 +521,11 @@ languageOptions = , flagReverse = "-XNoPartialTypeSignatures" , flagSince = "7.10.1" } - , flag { flagName = "-XPatternGuards" - , flagDescription = "Enable :ref:`pattern guards `." + , flag { flagName = "-XNoPatternGuards" + , flagDescription = "Disable :ref:`pattern guards `. "++ + "Implied by :ghc-flag:`-XHaskell98`." , flagType = DynamicFlag - , flagReverse = "-XNoPatternGuards" + , flagReverse = "-XPatternGuards" , flagSince = "6.8.1" } , flag { flagName = "-XPatternSynonyms" From git at git.haskell.org Thu Jun 9 16:10:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Jun 2016 16:10:37 +0000 (UTC) Subject: [commit: ghc] master: Fix Ticky histogram on Windows (b020db2) Message-ID: <20160609161037.6A68F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b020db2a841c397a02ec352f8b6dc110b38b927b/ghc >--------------------------------------------------------------- commit b020db2a841c397a02ec352f8b6dc110b38b927b Author: Tamar Christina Date: Thu Jun 9 17:49:20 2016 +0200 Fix Ticky histogram on Windows Summary: The histogram types are defined in `Ticky.c` as `StgInt` values. ``` EXTERN StgInt RET_NEW_hst[TICKY_BIN_COUNT] INIT({0}); EXTERN StgInt RET_OLD_hst[TICKY_BIN_COUNT] INIT({0}); EXTERN StgInt RET_UNBOXED_TUP_hst[TICKY_BIN_COUNT] INIT({0}); ``` which means they'll be `32-bits` on `x86` and `64-bits` on `x86_64`. However the `bumpHistogram` in `StgCmmTicky` is incrementing them as if they're a `cLong`. A long on Windows `x86_64` is `32-bit`. As such when then value for the `_hst_1` is being set what it's actually doing is setting the value of the high bits of the first entry. This ends up giving us `0b?100000000000000000000000000000000?` or `4294967296` as is displayed in the ticket on #8308. Since `StgInt` is defined using the `WORD` size. Just use that directly in `bumpHistogram`. Also since `cLong` is no longer used after this commit it will also be dropped. Test Plan: make TEST=T8308 Reviewers: mlen, jstolarek, bgamari, thomie, goldfire, simonmar, austin Reviewed By: bgamari, thomie Subscribers: #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2318 GHC Trac Issues: #8308 >--------------------------------------------------------------- b020db2a841c397a02ec352f8b6dc110b38b927b compiler/cmm/CmmType.hs | 16 +++++----------- compiler/codeGen/StgCmmTicky.hs | 10 +++++----- testsuite/tests/rts/T8308/all.T | 2 +- 3 files changed, 11 insertions(+), 17 deletions(-) diff --git a/compiler/cmm/CmmType.hs b/compiler/cmm/CmmType.hs index ae46330..4abbeaf 100644 --- a/compiler/cmm/CmmType.hs +++ b/compiler/cmm/CmmType.hs @@ -3,14 +3,14 @@ module CmmType ( CmmType -- Abstract , b8, b16, b32, b64, b128, b256, b512, f32, f64, bWord, bHalfWord, gcWord - , cInt, cLong + , cInt , cmmBits, cmmFloat , typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood , isFloatType, isGcPtrType, isWord32, isWord64, isFloat64, isFloat32 , Width(..) , widthInBits, widthInBytes, widthInLog, widthFromBytes - , wordWidth, halfWordWidth, cIntWidth, cLongWidth + , wordWidth, halfWordWidth, cIntWidth , halfWordMask , narrowU, narrowS , rEP_CostCentreStack_mem_alloc @@ -129,10 +129,8 @@ bHalfWord dflags = cmmBits (halfWordWidth dflags) gcWord :: DynFlags -> CmmType gcWord dflags = CmmType GcPtrCat (wordWidth dflags) -cInt, cLong :: DynFlags -> CmmType -cInt dflags = cmmBits (cIntWidth dflags) -cLong dflags = cmmBits (cLongWidth dflags) - +cInt :: DynFlags -> CmmType +cInt dflags = cmmBits (cIntWidth dflags) ------------ Predicates ---------------- isFloatType, isGcPtrType :: CmmType -> Bool @@ -207,15 +205,11 @@ halfWordMask dflags | otherwise = panic "MachOp.halfWordMask: Unknown word size" -- cIntRep is the Width for a C-language 'int' -cIntWidth, cLongWidth :: DynFlags -> Width +cIntWidth :: DynFlags -> Width cIntWidth dflags = case cINT_SIZE dflags of 4 -> W32 8 -> W64 s -> panic ("cIntWidth: Unknown cINT_SIZE: " ++ show s) -cLongWidth dflags = case cLONG_SIZE dflags of - 4 -> W32 - 8 -> W64 - s -> panic ("cIntWidth: Unknown cLONG_SIZE: " ++ show s) widthInBits :: Width -> Int widthInBits W8 = 8 diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs index 273e9c0..8df2dca 100644 --- a/compiler/codeGen/StgCmmTicky.hs +++ b/compiler/codeGen/StgCmmTicky.hs @@ -499,12 +499,12 @@ tickyAllocHeap genuine hp (CmmLit (cmmLabelOffB ticky_ctr (oFFSET_StgEntCounter_allocs dflags))) bytes, -- Bump the global allocation total ALLOC_HEAP_tot - addToMemLbl (cLong dflags) + addToMemLbl (bWord dflags) (mkCmmDataLabel rtsUnitId (fsLit "ALLOC_HEAP_tot")) bytes, -- Bump the global allocation counter ALLOC_HEAP_ctr if not genuine then mkNop - else addToMemLbl (cLong dflags) + else addToMemLbl (bWord dflags) (mkCmmDataLabel rtsUnitId (fsLit "ALLOC_HEAP_ctr")) 1 ]} @@ -613,11 +613,11 @@ bumpHistogram :: FastString -> Int -> FCode () bumpHistogram lbl n = do dflags <- getDynFlags let offset = n `min` (tICKY_BIN_COUNT dflags - 1) - emit (addToMem (cLong dflags) + emit (addToMem (bWord dflags) (cmmIndexExpr dflags - (cLongWidth dflags) + (wordWidth dflags) (CmmLit (CmmLabel (mkCmmDataLabel rtsUnitId lbl))) - (CmmLit (CmmInt (fromIntegral offset) (cLongWidth dflags)))) + (CmmLit (CmmInt (fromIntegral offset) (wordWidth dflags)))) 1) ------------------------------------------------------------------ diff --git a/testsuite/tests/rts/T8308/all.T b/testsuite/tests/rts/T8308/all.T index 7204e40..094140f 100644 --- a/testsuite/tests/rts/T8308/all.T +++ b/testsuite/tests/rts/T8308/all.T @@ -1,2 +1,2 @@ -test('T8308', when(opsys('mingw32'), expect_broken(8308)), +test('T8308', normal, run_command, ['$MAKE -s --no-print-directory T8308']) From git at git.haskell.org Thu Jun 9 16:27:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Jun 2016 16:27:21 +0000 (UTC) Subject: [commit: ghc] master: Improve the error messages for static forms. (e9dfb6e) Message-ID: <20160609162721.E98753A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e9dfb6e51f0cd585611a742ce7167e307ee7e7e8/ghc >--------------------------------------------------------------- commit e9dfb6e51f0cd585611a742ce7167e307ee7e7e8 Author: Facundo Dom?nguez Date: Thu Jun 9 17:37:42 2016 +0200 Improve the error messages for static forms. Now the message explains why closed variables are not closed when encountered in the body of (static ...). This required adding to the local environment the free variables of the local bindings in scope. Thus we can analyze and explain why a variable is not closed when encountered. Test Plan: ./validate Reviewers: austin, simonpj, bgamari Reviewed By: bgamari Subscribers: mboes, thomie Differential Revision: https://phabricator.haskell.org/D2167 GHC Trac Issues: #12003 >--------------------------------------------------------------- e9dfb6e51f0cd585611a742ce7167e307ee7e7e8 compiler/typecheck/TcBinds.hs | 47 ++++--- compiler/typecheck/TcEnv.hs | 48 ++++--- compiler/typecheck/TcExpr.hs | 155 ++++++++++++++++++++- compiler/typecheck/TcRnDriver.hs | 5 +- compiler/typecheck/TcRnTypes.hs | 48 ++++++- .../should_fail/RnStaticPointersFail01.stderr | 3 +- .../rename/should_fail/RnStaticPointersFail03.hs | 9 ++ .../should_fail/RnStaticPointersFail03.stderr | 35 +++-- testsuite/tests/rename/should_fail/all.T | 2 +- 9 files changed, 288 insertions(+), 64 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 e9dfb6e51f0cd585611a742ce7167e307ee7e7e8 From git at git.haskell.org Fri Jun 10 10:17:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 10 Jun 2016 10:17:55 +0000 (UTC) Subject: [commit: ghc] master: prettyPrintClosure(): Untag the closure before accessing fields (b0a7664) Message-ID: <20160610101755.E81393A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b0a76643e979a2e5198875a9c99f5f625f318668/ghc >--------------------------------------------------------------- commit b0a76643e979a2e5198875a9c99f5f625f318668 Author: ?mer Sinan A?acan Date: Fri Jun 10 06:20:00 2016 -0400 prettyPrintClosure(): Untag the closure before accessing fields (This fixes segfaults) >--------------------------------------------------------------- b0a76643e979a2e5198875a9c99f5f625f318668 rts/Printer.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/rts/Printer.c b/rts/Printer.c index c33e341..a6f26c2 100644 --- a/rts/Printer.c +++ b/rts/Printer.c @@ -805,6 +805,8 @@ void prettyPrintClosure_ (const StgClosure *obj) { const StgInfoTable *info; + obj = UNTAG_CONST_CLOSURE(obj); + /* collapse any indirections */ unsigned int type; type = get_itbl(obj)->type; From git at git.haskell.org Fri Jun 10 11:10:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 10 Jun 2016 11:10:40 +0000 (UTC) Subject: [commit: ghc] master: Remove Printer.c:prettyPrintClosure() (47d8173) Message-ID: <20160610111040.76DEB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/47d81732022e0327f7a5798898b40d1f1bdbb157/ghc >--------------------------------------------------------------- commit 47d81732022e0327f7a5798898b40d1f1bdbb157 Author: ?mer Sinan A?acan Date: Fri Jun 10 07:13:47 2016 -0400 Remove Printer.c:prettyPrintClosure() It turns out this function was unused and broken for a long time (fixed with b0a7664). Removing it as it will probably get broken again in the future and it's unused. Reviewers: austin, erikd, simonmar, nomeata, bgamari Reviewed By: nomeata, bgamari Subscribers: Phyx, thomie, nomeata Differential Revision: https://phabricator.haskell.org/D2322 >--------------------------------------------------------------- 47d81732022e0327f7a5798898b40d1f1bdbb157 rts/Printer.c | 81 ----------------------------------------------------------- rts/Printer.h | 1 - 2 files changed, 82 deletions(-) diff --git a/rts/Printer.c b/rts/Printer.c index a6f26c2..1ee1c6c 100644 --- a/rts/Printer.c +++ b/rts/Printer.c @@ -785,87 +785,6 @@ findPtr(P_ p, int follow) } } -/* prettyPrintClosure() is for printing out a closure using the data constructor - names found in the info tables. Closures are printed in a fashion that resembles - their Haskell representation. Useful during debugging. - - Todo: support for more closure types, and support for non pointer fields in the - payload. -*/ - -void prettyPrintClosure_ (const StgClosure *); - -void prettyPrintClosure (const StgClosure *obj) -{ - prettyPrintClosure_ (obj); - debugBelch ("\n"); -} - -void prettyPrintClosure_ (const StgClosure *obj) -{ - const StgInfoTable *info; - - obj = UNTAG_CONST_CLOSURE(obj); - - /* collapse any indirections */ - unsigned int type; - type = get_itbl(obj)->type; - - while (type == IND || - type == IND_STATIC) - { - obj = ((StgInd *)obj)->indirectee; - type = get_itbl(obj)->type; - } - - /* find the info table for this object */ - info = get_itbl(obj); - - /* determine what kind of object we have */ - switch (info->type) - { - /* full applications of data constructors */ - case CONSTR: - case CONSTR_1_0: - case CONSTR_0_1: - case CONSTR_1_1: - case CONSTR_0_2: - case CONSTR_2_0: - case CONSTR_STATIC: - case CONSTR_NOCAF_STATIC: - { - const StgConInfoTable *con_info; - const char *descriptor; - uint32_t i; - - /* find the con_info for the constructor */ - con_info = get_con_itbl (obj); - - /* obtain the name of the constructor */ - descriptor = GET_CON_DESC(con_info); - - debugBelch ("(%s", descriptor); - - /* process the payload of the closure */ - /* we don't handle non pointers at the moment */ - for (i = 0; i < info->layout.payload.ptrs; i++) - { - debugBelch (" "); - prettyPrintClosure_ ((StgClosure *) obj->payload[i]); - } - debugBelch (")"); - break; - } - - /* if it isn't a constructor then just print the closure type */ - default: - { - debugBelch ("<%s>", info_type(obj)); - break; - } - } -} - const char *what_next_strs[] = { [0] = "(unknown)", [ThreadRunGHC] = "ThreadRunGHC", diff --git a/rts/Printer.h b/rts/Printer.h index bd2db35..4db7605 100644 --- a/rts/Printer.h +++ b/rts/Printer.h @@ -22,7 +22,6 @@ const char * info_type_by_ip ( const StgInfoTable *ip ); const char * info_update_frame ( const StgClosure *closure ); #ifdef DEBUG -extern void prettyPrintClosure (const StgClosure *obj); extern void printClosure ( const StgClosure *obj ); extern void printStackChunk ( StgPtr sp, StgPtr spLim ); extern void printTSO ( StgTSO *tso ); From git at git.haskell.org Fri Jun 10 14:18:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 10 Jun 2016 14:18:52 +0000 (UTC) Subject: [commit: ghc] master: Fix #12099: Remove bogus flags (bcb419a) Message-ID: <20160610141852.DECCD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bcb419a41754bbd883973c96d4b0bca4639e4f2d/ghc >--------------------------------------------------------------- commit bcb419a41754bbd883973c96d4b0bca4639e4f2d Author: Sean Gillespie Date: Fri Jun 10 12:53:37 2016 +0200 Fix #12099: Remove bogus flags Remove -fwarn- and -fno-warn- from flagsForCompletion Testcase: Fix linter error on T12099 For Issue #12099 Reviewers: austin, thomie, bgamari Reviewed By: austin, thomie, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2281 GHC Trac Issues: #12099 >--------------------------------------------------------------- bcb419a41754bbd883973c96d4b0bca4639e4f2d compiler/main/DynFlags.hs | 8 +++---- testsuite/tests/ghc-api/T12099.hs | 27 ++++++++++++++++++++++ .../{arityanal/Makefile => ghc-api/T12099.stdout} | 0 testsuite/tests/ghc-api/all.T | 1 + 4 files changed, 32 insertions(+), 4 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 30d4d30..5515b8c 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2994,9 +2994,9 @@ dynamic_flags_deps = [ wWarningFlagsDeps ++ map (mkFlag turnOff "fno-warn-" unSetWarningFlag . hideFlag) wWarningFlagsDeps - ++ [ (NotDeprecated, unrecognisedWarning "W") - , (NotDeprecated, unrecognisedWarning "fwarn-") - , (NotDeprecated, unrecognisedWarning "fno-warn-") ] + ++ [ (NotDeprecated, unrecognisedWarning "W"), + (Deprecated, unrecognisedWarning "fwarn-"), + (Deprecated, unrecognisedWarning "fno-warn-") ] ++ map (mkFlag turnOn "f" setExtensionFlag ) fLangFlagsDeps ++ map (mkFlag turnOff "fno-" unSetExtensionFlag) fLangFlagsDeps ++ map (mkFlag turnOn "X" setExtensionFlag ) xFlagsDeps @@ -3015,7 +3015,7 @@ dynamic_flags_deps = [ -- | This is where we handle unrecognised warning flags. We only issue a warning -- if -Wunrecognised-warning-flags is set. See Trac #11429 for context. unrecognisedWarning :: String -> Flag (CmdLineP DynFlags) -unrecognisedWarning prefix = defFlag prefix (Prefix action) +unrecognisedWarning prefix = defHiddenFlag prefix (Prefix action) where action :: String -> EwM (CmdLineP DynFlags) () action flag = do diff --git a/testsuite/tests/ghc-api/T12099.hs b/testsuite/tests/ghc-api/T12099.hs new file mode 100644 index 0000000..d5d5d54 --- /dev/null +++ b/testsuite/tests/ghc-api/T12099.hs @@ -0,0 +1,27 @@ +module Main where + +import DynFlags + +import Control.Monad +import Data.List + +-- Verify bogus flags aren't printed on flagsForCompletion and +-- allNonDeprecatedFlags: +-- * -fwarn- +-- * -fno-warn- +-- +-- Should print nothing +main :: IO () +main = mapM_ print $ fwarnFlags (flagsForCompletion True) ++ nonDepFwarnFlags + +-- Get flags beginning with -fwarn- and -fno-warn- +fwarnFlags :: [String] -> [String] +fwarnFlags = filter isFwarn + where isFwarn flag = any (flip isPrefixOf $ flag) ["-fwarn-", "-fno-warn"] + +-- Get suggested flags for -fwarn-, -fno-warn- +nonDepFwarnFlags :: [String] +nonDepFwarnFlags = filter isFwarn allNonDeprecatedFlags + where isFwarn "-fwarn-" = True + isFwarn "-fno-warn-" = True + isFwarn _ = False diff --git a/testsuite/tests/arityanal/Makefile b/testsuite/tests/ghc-api/T12099.stdout similarity index 100% copy from testsuite/tests/arityanal/Makefile copy to testsuite/tests/ghc-api/T12099.stdout diff --git a/testsuite/tests/ghc-api/all.T b/testsuite/tests/ghc-api/all.T index 12c64eb..377c1e3 100644 --- a/testsuite/tests/ghc-api/all.T +++ b/testsuite/tests/ghc-api/all.T @@ -26,3 +26,4 @@ test('T9015', extra_run_opts('"' + config.libdir + '"'), ['-package ghc']) test('T11579', extra_run_opts('"' + config.libdir + '"'), compile_and_run, ['-package ghc']) +test('T12099', normal, compile_and_run, ['-package ghc']) From git at git.haskell.org Fri Jun 10 16:15:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 10 Jun 2016 16:15:16 +0000 (UTC) Subject: [commit: ghc] master: Comments only (0f0b002) Message-ID: <20160610161516.B46013A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0f0b002ce4593a78b8996c77c063c89e09b284e4/ghc >--------------------------------------------------------------- commit 0f0b002ce4593a78b8996c77c063c89e09b284e4 Author: Simon Peyton Jones Date: Thu Jun 9 14:42:26 2016 +0100 Comments only ...about unarisation and unboxed tuples >--------------------------------------------------------------- 0f0b002ce4593a78b8996c77c063c89e09b284e4 compiler/simplStg/UnariseStg.hs | 16 ++++++++++++++++ compiler/stgSyn/CoreToStg.hs | 2 +- compiler/types/Type.hs | 24 +----------------------- 3 files changed, 18 insertions(+), 24 deletions(-) diff --git a/compiler/simplStg/UnariseStg.hs b/compiler/simplStg/UnariseStg.hs index d580942..1b94cbc 100644 --- a/compiler/simplStg/UnariseStg.hs +++ b/compiler/simplStg/UnariseStg.hs @@ -50,6 +50,22 @@ Of course all this applies recursively, so that we flatten out nested tuples. Note [Unarisation and nullary tuples] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The above scheme has a special cases for nullary unboxed tuples, x :: (# #) +To see why, consider + f2 :: (# Int, Int #) -> Int + f1 :: (# Int #) -> Int + f0 :: (# #) -> Int + +When we "unarise" to eliminate unboxed tuples (this is done at the STG level), +we'll transform to + f2 :: Int -> Int -> Int + f1 :: Int -> Int + f0 :: ?? + +We do not want to give f0 zero arguments, otherwise a lambda will +turn into a thunk! So we want to get + f0 :: Void# -> Int + +So here is what we do for nullary tuples * Extend the UnariseEnv with x :-> [voidPrimId] diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs index d2010a8..273cbdb 100644 --- a/compiler/stgSyn/CoreToStg.hs +++ b/compiler/stgSyn/CoreToStg.hs @@ -451,7 +451,7 @@ mkStgAltType bndr alts = case repType (idType bndr) of PolyAlt Nothing -> PolyAlt UbxTupleRep rep_tys -> UbxTupAlt (length rep_tys) - -- NB Nullary unboxed tuples have UnaryRep, and generate a PrimAlt + -- UbxTupAlt includes nullary and and singleton unboxed tuples where _is_poly_alt_tycon tc = isFunTyCon tc diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 9aaf3de..724a9a4 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1714,33 +1714,11 @@ typeSize (CoercionTy co) = coercionSize co * * ********************************************************************** -} -{- Note [Nullary unboxed tuple] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -At runtime we represent the nullary unboxed tuple as the type Void#. -To see why, consider - f2 :: (# Int, Int #) -> Int - f1 :: (# Int #) -> Int - f0 :: (# #) -> Int - -When we "unarise" to eliminate unboxed tuples (this is done at the STG level), -we'll transform to - f2 :: Int -> Int -> Int - f1 :: Int -> Int - f0 :: ?? - -We do not want to give f0 zero arguments, otherwise a lambda will -turn into a thunk! So we want to get - f0 :: Void# -> Int - -See Note [Unarisation and nullary tuples] in UnariseStg for more detail. --} - type UnaryType = Type data RepType = UbxTupleRep [UnaryType] -- Represented by multiple values - -- INVARIANT: never an empty list - -- (see Note [Nullary unboxed tuple]) + -- Can be zero, one, or more | UnaryRep UnaryType -- Represented by a single value instance Outputable RepType where From git at git.haskell.org Fri Jun 10 16:15:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 10 Jun 2016 16:15:19 +0000 (UTC) Subject: [commit: ghc] master: Minor refactoring (3ae18df) Message-ID: <20160610161519.65DD33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3ae18df176081474ecc1ae90d5b6957d660afbb6/ghc >--------------------------------------------------------------- commit 3ae18df176081474ecc1ae90d5b6957d660afbb6 Author: Simon Peyton Jones Date: Thu Jun 9 14:44:00 2016 +0100 Minor refactoring Use tauifyExpType rather than something hand-rolled >--------------------------------------------------------------- 3ae18df176081474ecc1ae90d5b6957d660afbb6 compiler/typecheck/TcExpr.hs | 14 ++++++++------ compiler/typecheck/TcMatches.hs | 10 ++++------ 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 25a62cb..f078ba4 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -533,9 +533,10 @@ tcExpr (HsCase scrut matches) res_ty tcExpr (HsIf Nothing pred b1 b2) res_ty -- Ordinary 'if' = do { pred' <- tcMonoExpr pred (mkCheckExpType boolTy) - -- this forces the branches to be fully instantiated - -- (See #10619) - ; res_ty <- mkCheckExpType <$> expTypeToType res_ty + ; res_ty <- tauifyExpType res_ty + -- Just like Note [Case branches must never infer a non-tau type] + -- in TcMatches (See #10619) + ; b1' <- tcMonoExpr b1 res_ty ; b2' <- tcMonoExpr b2 res_ty ; return (HsIf Nothing pred' b1' b2') } @@ -553,9 +554,10 @@ tcExpr (HsIf (Just fun) pred b1 b2) res_ty tcExpr (HsMultiIf _ alts) res_ty = do { res_ty <- if isSingleton alts then return res_ty - else mkCheckExpType <$> expTypeToType res_ty - -- Just like Note [Case branches must never infer a non-tau type] - -- in TcMatches + else tauifyExpType res_ty + -- Just like TcMatches + -- Note [Case branches must never infer a non-tau type] + ; alts' <- mapM (wrapLocM $ tcGRHS match_ctxt res_ty) alts ; res_ty <- readExpType res_ty ; return (HsMultiIf res_ty alts') } diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index d4867f5..8d59b8f 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -90,8 +90,7 @@ tcMatchesFun fn@(L _ fun_name) matches exp_ty do { (matches', wrap_fun) <- matchExpectedFunTys herald arity exp_rho $ \ pat_tys rhs_ty -> - -- See Note [Case branches must never infer a non-tau type] - do { tcMatches match_ctxt pat_tys rhs_ty matches } + tcMatches match_ctxt pat_tys rhs_ty matches ; return (wrap_fun, matches') } ; return (wrap_gen <.> wrap_fun, group) } where @@ -187,10 +186,7 @@ tauifyMultipleMatches group exp_tys | otherwise = mapM tauifyExpType exp_tys -- NB: In the empty-match case, this ensures we fill in the ExpType --- | Type-check a MatchGroup. If there are multiple RHSs, the expected type --- must already be tauified. --- See Note [Case branches must never infer a non-tau type] --- about tauifyMultipleMatches +-- | Type-check a MatchGroup. tcMatches :: (Outputable (body Name)) => TcMatchCtxt body -> [ExpSigmaType] -- Expected pattern types -> ExpRhoType -- Expected result-type of the Match. @@ -207,6 +203,8 @@ data TcMatchCtxt body -- c.f. TcStmtCtxt, also in this module tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches , mg_origin = origin }) = do { rhs_ty:pat_tys <- tauifyMultipleMatches matches (rhs_ty:pat_tys) + -- See Note [Case branches must never infer a non-tau type] + ; matches' <- mapM (tcMatch ctxt pat_tys rhs_ty) matches ; pat_tys <- mapM readExpType pat_tys ; rhs_ty <- readExpType rhs_ty From git at git.haskell.org Fri Jun 10 16:15:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 10 Jun 2016 16:15:22 +0000 (UTC) Subject: [commit: ghc] master: Refine imports slightly (6905ce2) Message-ID: <20160610161522.1168F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6905ce26080ee30119d1949e8bbd3c36bfe754af/ghc >--------------------------------------------------------------- commit 6905ce26080ee30119d1949e8bbd3c36bfe754af Author: Simon Peyton Jones Date: Wed Jun 1 14:48:56 2016 +0100 Refine imports slightly >--------------------------------------------------------------- 6905ce26080ee30119d1949e8bbd3c36bfe754af compiler/main/PprTyThing.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs index e738d7a..c02dd23 100644 --- a/compiler/main/PprTyThing.hs +++ b/compiler/main/PprTyThing.hs @@ -26,7 +26,7 @@ import MkIface ( tyThingToIfaceDecl ) import Type ( tidyOpenType ) import IfaceSyn ( pprIfaceDecl, ShowSub(..), ShowHowMuch(..) ) import FamInstEnv( FamInst( .. ), FamFlavor(..) ) -import TcType +import Type( Type, pprTypeApp, pprSigmaType ) import Name import VarEnv( emptyTidyEnv ) import Outputable From git at git.haskell.org Fri Jun 10 16:15:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 10 Jun 2016 16:15:24 +0000 (UTC) Subject: [commit: ghc] master: Comments only (6adff01) Message-ID: <20160610161524.BD4063A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6adff0107421e973d276f1524232e5ef0718d3f2/ghc >--------------------------------------------------------------- commit 6adff0107421e973d276f1524232e5ef0718d3f2 Author: Simon Peyton Jones Date: Wed Jun 1 14:48:36 2016 +0100 Comments only >--------------------------------------------------------------- 6adff0107421e973d276f1524232e5ef0718d3f2 compiler/rename/RnSource.hs | 8 +++++++- compiler/types/TyCoRep.hs | 2 +- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index 4a71f2d..d43945f 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -1529,7 +1529,7 @@ modules), we get better error messages, too. ---------------------------------------------------------- -- | 'InstDeclFreeVarsMap is an association of an -- @InstDecl@ with @FreeVars at . The @FreeVars@ are --- the names that are +-- the tycon names that are both -- a) free in the instance declaration -- b) bound by this group of type/class/instance decls type InstDeclFreeVarsMap = [(LInstDecl Name, FreeVars)] @@ -1546,6 +1546,12 @@ mkInstDeclFreeVarsMap rdr_env tycl_bndrs inst_ds_fvs -- | Get the @LInstDecl at s which have empty @FreeVars@ sets, and the -- @InstDeclFreeVarsMap@ with these entries removed. +-- We call (getInsts tcs instd_map) when we've completed the declarations +-- for 'tcs'. The call returns (inst_decls, instd_map'), where +-- inst_decls are the instance declarations all of +-- whose free vars are now defined +-- instd_map' is the inst-decl map with 'tcs' removed from +-- the free-var set getInsts :: [Name] -> InstDeclFreeVarsMap -> ([LInstDecl Name], InstDeclFreeVarsMap) getInsts bndrs inst_decl_map = partitionWith pick_me inst_decl_map diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 053101c..70d8bba 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -493,7 +493,7 @@ In type declarations: * Specified (k) data T2 (a::k->*) b = MkT (a b) Here T's kind is T :: forall (k:*). (k->*) -> k -> * - The kind vairable 'k' is Specified, since it is mentioned in + The kind variable 'k' is Specified, since it is mentioned in the signature. * Visible (k) From git at git.haskell.org Fri Jun 10 16:15:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 10 Jun 2016 16:15:27 +0000 (UTC) Subject: [commit: ghc] master: Small refactor to mkRuntimErrorId (b9fa72a) Message-ID: <20160610161527.73D663A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b9fa72a24ba2cc3120912e6afedc9280d28d2077/ghc >--------------------------------------------------------------- commit b9fa72a24ba2cc3120912e6afedc9280d28d2077 Author: Simon Peyton Jones Date: Thu Jun 9 14:44:36 2016 +0100 Small refactor to mkRuntimErrorId >--------------------------------------------------------------- b9fa72a24ba2cc3120912e6afedc9280d28d2077 compiler/coreSyn/MkCore.hs | 53 +++++++++++++++++++++------------------------- 1 file changed, 24 insertions(+), 29 deletions(-) diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index ab4caf8..7d9ef14 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -716,35 +716,16 @@ aBSENT_ERROR_ID = mkRuntimeErrorId absentErrorName tYPE_ERROR_ID = mkRuntimeErrorId typeErrorName mkRuntimeErrorId :: Name -> Id -mkRuntimeErrorId name = pc_bottoming_Id1 name runtimeErrorTy - -runtimeErrorTy :: Type --- The runtime error Ids take a UTF8-encoded string as argument -runtimeErrorTy = mkSpecSigmaTy [runtimeRep1TyVar, openAlphaTyVar] [] - (mkFunTy addrPrimTy openAlphaTy) - -{- -Note [Error and friends have an "open-tyvar" forall] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -'error' and 'undefined' have types - error :: forall (v :: RuntimeRep) (a :: TYPE v). String -> a - undefined :: forall (v :: RuntimeRep) (a :: TYPE v). a -Notice the runtime-representation polymophism. This ensures that -"error" can be instantiated at unboxed as well as boxed types. -This is OK because it never returns, so the return type is irrelevant. - - -************************************************************************ -* * -\subsection{Utilities} -* * -************************************************************************ --} - -pc_bottoming_Id1 :: Name -> Type -> Id --- Function of arity 1, which diverges after being given one argument -pc_bottoming_Id1 name ty - = mkVanillaGlobalWithInfo name ty bottoming_info +-- Error function +-- with type: forall (r:RuntimeRep) (a:TYPE r). Addr# -> a +-- with arity: 1 +-- which diverges after being given one argument +-- The Addr# is expected to be the address of +-- a UTF8-encoded error string +-- For the RuntimeRep part, see +-- Note [Error and friends have an "open-tyvar" forall] +mkRuntimeErrorId name + = mkVanillaGlobalWithInfo name runtime_err_ty bottoming_info where bottoming_info = vanillaIdInfo `setStrictnessInfo` strict_sig `setArityInfo` 1 @@ -761,3 +742,17 @@ pc_bottoming_Id1 name ty strict_sig = mkClosedStrictSig [evalDmd] exnRes -- exnRes: these throw an exception, not just diverge + + runtime_err_ty = mkSpecSigmaTy [runtimeRep1TyVar, openAlphaTyVar] [] + (mkFunTy addrPrimTy openAlphaTy) + +{- Note [Error and friends have an "open-tyvar" forall] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +'error' and 'undefined' have types + error :: forall (v :: RuntimeRep) (a :: TYPE v). String -> a + undefined :: forall (v :: RuntimeRep) (a :: TYPE v). a +Notice the runtime-representation polymophism. This ensures that +"error" can be instantiated at unboxed as well as boxed types. +This is OK because it never returns, so the return type is irrelevant. +-} + From git at git.haskell.org Fri Jun 10 20:22:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 10 Jun 2016 20:22:22 +0000 (UTC) Subject: [commit: ghc] master: Rts flags cleanup (c88f31a) Message-ID: <20160610202222.E596C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c88f31a08943764217b69adb1085ba423c9bcf91/ghc >--------------------------------------------------------------- commit c88f31a08943764217b69adb1085ba423c9bcf91 Author: Simon Marlow Date: Mon May 23 10:42:31 2016 +0100 Rts flags cleanup * Remove unused/old flags from the structs * Update old comments * Add missing flags to GHC.RTS * Simplify GHC.RTS, remove C code and use hsc2hs instead * Make ParFlags unconditional, and add support to GHC.RTS >--------------------------------------------------------------- c88f31a08943764217b69adb1085ba423c9bcf91 includes/rts/Flags.h | 7 --- includes/rts/storage/GC.h | 40 ++++++------- libraries/base/GHC/RTS/Flags.hsc | 122 +++++++++++++++++++++------------------ libraries/base/base.cabal | 1 - libraries/base/cbits/rts.c | 42 -------------- rts/sm/GC.c | 8 +-- rts/sm/GCAux.c | 2 +- 7 files changed, 88 insertions(+), 134 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 c88f31a08943764217b69adb1085ba423c9bcf91 From git at git.haskell.org Fri Jun 10 20:22:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 10 Jun 2016 20:22:26 +0000 (UTC) Subject: [commit: ghc] master: NUMA support (9e5ea67) Message-ID: <20160610202226.15E5C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9e5ea67e268be2659cd30ebaed7044d298198ab0/ghc >--------------------------------------------------------------- commit 9e5ea67e268be2659cd30ebaed7044d298198ab0 Author: Simon Marlow Date: Sat Apr 23 21:14:49 2016 +0100 NUMA support Summary: The aim here is to reduce the number of remote memory accesses on systems with a NUMA memory architecture, typically multi-socket servers. Linux provides a NUMA API for doing two things: * Allocating memory local to a particular node * Binding a thread to a particular node When given the +RTS --numa flag, the runtime will * Determine the number of NUMA nodes (N) by querying the OS * Assign capabilities to nodes, so cap C is on node C%N * Bind worker threads on a capability to the correct node * Keep a separate free lists in the block layer for each node * Allocate the nursery for a capability from node-local memory * Allocate blocks in the GC from node-local memory For example, using nofib/parallel/queens on a 24-core 2-socket machine: ``` $ ./Main 15 +RTS -N24 -s -A64m Total time 173.960s ( 7.467s elapsed) $ ./Main 15 +RTS -N24 -s -A64m --numa Total time 150.836s ( 6.423s elapsed) ``` The biggest win here is expected to be allocating from node-local memory, so that means programs using a large -A value (as here). According to perf, on this program the number of remote memory accesses were reduced by more than 50% by using `--numa`. Test Plan: * validate * There's a new flag --debug-numa= that pretends to do NUMA without actually making the OS calls, which is useful for testing the code on non-NUMA systems. * TODO: I need to add some unit tests Reviewers: erikd, austin, rwbarton, ezyang, bgamari, hvr, niteria Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2199 >--------------------------------------------------------------- 9e5ea67e268be2659cd30ebaed7044d298198ab0 configure.ac | 7 + docs/users_guide/runtime_control.rst | 50 ++++ includes/Cmm.h | 1 - includes/Rts.h | 1 - includes/RtsAPI.h | 6 +- includes/rts/Constants.h | 6 + includes/rts/Flags.h | 8 +- includes/rts/OSThreads.h | 4 +- includes/rts/Threads.h | 4 +- includes/rts/storage/Block.h | 20 +- includes/rts/storage/MBlock.h | 2 + rts/Capability.c | 38 +-- rts/Capability.h | 14 +- rts/HeapStackCheck.cmm | 1 + rts/Inlines.c | 1 + rts/Messages.h | 1 + rts/PrimOps.cmm | 1 + rts/ProfHeap.c | 1 + rts/RtsFlags.c | 118 +++++++-- {includes/rts/storage => rts}/SMPClosureOps.h | 4 + rts/STM.c | 1 + rts/Schedule.c | 5 +- rts/Task.c | 26 +- rts/Task.h | 6 + rts/eventlog/EventLog.c | 2 +- rts/package.conf.in | 4 +- rts/posix/OSMem.c | 64 +++++ rts/posix/OSThreads.c | 30 ++- rts/sm/BlockAlloc.c | 350 ++++++++++++++++---------- rts/sm/BlockAlloc.h | 1 + rts/sm/GC.c | 8 +- rts/sm/GCUtils.c | 15 +- rts/sm/GCUtils.h | 14 +- rts/sm/MBlock.c | 19 +- rts/sm/MarkStack.h | 1 + rts/sm/OSMem.h | 4 + rts/sm/Storage.c | 190 ++++++++------ rts/win32/OSMem.c | 22 ++ rts/win32/OSThreads.c | 3 + testsuite/config/ghc | 6 +- testsuite/tests/codeGen/should_run/all.T | 5 +- testsuite/tests/concurrent/prog001/all.T | 0 testsuite/tests/concurrent/should_run/all.T | 5 +- 43 files changed, 788 insertions(+), 281 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 9e5ea67e268be2659cd30ebaed7044d298198ab0 From git at git.haskell.org Sat Jun 11 14:00:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Jun 2016 14:00:47 +0000 (UTC) Subject: [commit: ghc] master: ModuleSet: Use an actual set instead of map to units (5990016) Message-ID: <20160611140047.E4EF13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5990016ac87ebc39466b736fb94bba7643e0fc97/ghc >--------------------------------------------------------------- commit 5990016ac87ebc39466b736fb94bba7643e0fc97 Author: ?mer Sinan A?acan Date: Sat Jun 11 10:01:49 2016 -0400 ModuleSet: Use an actual set instead of map to units >--------------------------------------------------------------- 5990016ac87ebc39466b736fb94bba7643e0fc97 compiler/basicTypes/Module.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs index aa886bb..a80df19 100644 --- a/compiler/basicTypes/Module.hs +++ b/compiler/basicTypes/Module.hs @@ -92,7 +92,9 @@ import GHC.PackageDb (BinaryStringRep(..), DbModuleRep(..), DbModule(..)) import Data.Data import Data.Map (Map) +import Data.Set (Set) import qualified Data.Map as Map +import qualified Data.Set as Set import qualified FiniteMap as Map import System.FilePath @@ -580,7 +582,7 @@ foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e -- | A set of 'Module's -type ModuleSet = Map Module () +type ModuleSet = Set Module mkModuleSet :: [Module] -> ModuleSet extendModuleSet :: ModuleSet -> Module -> ModuleSet @@ -588,11 +590,11 @@ emptyModuleSet :: ModuleSet moduleSetElts :: ModuleSet -> [Module] elemModuleSet :: Module -> ModuleSet -> Bool -emptyModuleSet = Map.empty -mkModuleSet ms = Map.fromList [(m,()) | m <- ms ] -extendModuleSet s m = Map.insert m () s -moduleSetElts = Map.keys -elemModuleSet = Map.member +emptyModuleSet = Set.empty +mkModuleSet = Set.fromList +extendModuleSet s m = Set.insert m s +moduleSetElts = Set.toList +elemModuleSet = Set.member {- A ModuleName has a Unique, so we can build mappings of these using From git at git.haskell.org Sun Jun 12 05:08:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Jun 2016 05:08:45 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: rts: Fix build when USE_LARGE_ADDRESS_SPACE is undefined (6f551b4) Message-ID: <20160612050845.3E7D03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/6f551b41c1debca9e24603511bbd2374f31bbdc2/ghc >--------------------------------------------------------------- commit 6f551b41c1debca9e24603511bbd2374f31bbdc2 Author: Erik de Castro Lopo Date: Sun Jun 12 07:36:35 2016 +1000 rts: Fix build when USE_LARGE_ADDRESS_SPACE is undefined Summary: The recently added NUMA related functions were mistakenly defined within a `#ifdef USE_LARGE_ADDRESS_SPACE` ... `#endif` block. Moving them outside this block fixes the build on PowerPC and Arm Linux. Test Plan: Build on PowerPC or Arm Linux Reviewers: bgamari, simonmar, hvr, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2326 >--------------------------------------------------------------- 6f551b41c1debca9e24603511bbd2374f31bbdc2 rts/posix/OSMem.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index a534219..58310fe 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -544,6 +544,8 @@ void osReleaseHeapMemory(void) sysErrorBelch("unable to release address space"); } +#endif + rtsBool osNumaAvailable(void) { #ifdef HAVE_NUMA_H @@ -575,5 +577,3 @@ StgWord osNumaMask(void) return 1; #endif } - -#endif From git at git.haskell.org Sun Jun 12 05:08:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Jun 2016 05:08:48 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: rts: Add `-Wundef` to CFLAGS and fix warnings (d2142bb) Message-ID: <20160612050848.17EE33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/d2142bb0c6ab05dafdc655569e961a5703f20175/ghc >--------------------------------------------------------------- commit d2142bb0c6ab05dafdc655569e961a5703f20175 Author: Erik de Castro Lopo Date: Wed May 18 20:04:26 2016 +1000 rts: Add `-Wundef` to CFLAGS and fix warnings >--------------------------------------------------------------- d2142bb0c6ab05dafdc655569e961a5703f20175 compiler/utils/Panic.hs | 4 +- ghc/GHCi/UI.hs | 2 +- includes/Rts.h | 8 +- includes/RtsAPI.h | 2 +- includes/Stg.h | 6 +- includes/rts/IOManager.h | 2 +- includes/rts/Linker.h | 2 +- includes/rts/Messages.h | 2 +- includes/rts/OSThreads.h | 6 +- includes/rts/Threads.h | 2 +- includes/rts/storage/GC.h | 2 +- includes/rts/storage/InfoTables.h | 2 +- includes/rts/storage/TSO.h | 4 +- includes/stg/DLL.h | 6 +- includes/stg/MachRegs.h | 26 ++--- includes/stg/RtsMachRegs.h | 2 + includes/stg/SMP.h | 15 ++- includes/stg/Types.h | 2 +- libraries/base/GHC/Conc/IO.hs | 22 ++-- libraries/base/GHC/Conc/Sync.hs | 2 +- libraries/base/GHC/Conc/Windows.hs | 2 +- libraries/base/cbits/DarwinUtils.c | 2 +- libraries/base/cbits/PrelIOUtils.c | 2 +- libraries/base/include/HsBase.h | 2 +- libraries/ghc-prim/cbits/ctz.c | 2 +- rts/Adjustor.c | 79 ++++++------- rts/BeginPrivate.h | 2 +- rts/Capability.c | 6 +- rts/Capability.h | 2 +- rts/EndPrivate.h | 2 +- rts/Excn.h | 2 +- rts/HeapStackCheck.cmm | 2 +- rts/Interpreter.c | 7 +- rts/Libdw.c | 4 +- rts/Linker.c | 220 ++++++++++++++++++------------------ rts/LinkerInternals.h | 5 +- rts/PosixSource.h | 4 +- rts/PrimOps.cmm | 12 +- rts/Profiling.c | 2 +- rts/RaiseAsync.c | 8 +- rts/RaiseAsync.h | 2 +- rts/RtsFlags.c | 14 +-- rts/RtsMessages.c | 14 +-- rts/RtsSignals.h | 4 +- rts/RtsStartup.c | 14 +-- rts/RtsSymbols.c | 26 ++--- rts/RtsUtils.c | 10 +- rts/Schedule.c | 8 +- rts/Stats.h | 2 +- rts/StgCRun.c | 54 ++++----- rts/StgRun.h | 2 +- rts/Task.h | 8 +- rts/Threads.c | 4 +- rts/Trace.c | 2 +- rts/eventlog/EventLog.c | 2 +- rts/ghc.mk | 3 + rts/posix/Clock.h | 2 +- rts/posix/GetEnv.c | 2 +- rts/posix/GetTime.c | 6 +- rts/posix/Itimer.c | 6 +- rts/posix/OSMem.c | 2 +- rts/posix/OSThreads.c | 24 ++-- rts/posix/Signals.c | 6 +- rts/sm/Evac.h | 2 +- rts/sm/GCTDecl.h | 7 +- rts/sm/GCUtils.c | 2 +- rts/sm/GCUtils.h | 2 +- rts/sm/Storage.c | 15 ++- testsuite/tests/rts/T5435_asm.c | 4 +- testsuite/tests/rts/linker_error.c | 6 +- testsuite/tests/rts/linker_unload.c | 2 +- testsuite/tests/rts/spalign.c | 6 +- utils/ghc-pkg/Main.hs | 14 +-- utils/runghc/Main.hs | 10 +- 74 files changed, 397 insertions(+), 376 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 d2142bb0c6ab05dafdc655569e961a5703f20175 From git at git.haskell.org Sun Jun 12 05:08:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Jun 2016 05:08:51 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts's head updated: rts: Add `-Wundef` to CFLAGS and fix warnings (d2142bb) Message-ID: <20160612050851.013EF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/erikd/rts' now includes: 7e4f3dc StgCmmUtils.emitMultiAssign: Make assertion msg more helpful 0ffa23d Remove unused FAST_STRING_NOT_NEEDED macro defs 930e74f Update a Cmm note 0676e68 Fix detection and use of `USE_LIBDW` cb2c042 Use nameSetAny in findUses f2b3be0 Improve failed knot-tying error message. 99ace83 Kill nameSetElems in getInfo 36d254a Testsuite: run tests in /tmp/ghctest-xxx instead of /tmp/ghctest/xxx 940229c Travis: llvm's apt repository is offline cb9f635 Localize orphan-related nondeterminism d348acd Serialize vParallelTyCons in a stable order 3eac3a0 Add nameSetElemsStable and fix the build dad39ff Remove dead generics-related code from OccName d753ea2 Use UniqDSet for finding free names in the Linker e2446c0 Kill nameSetElems in findImportUsage be47085 Kill nameSetElems in rnCmdTop 060c176 Whitespace only 1d1987e HscMain: Minor simplification 9cc6fac Make FieldLabelEnv a deterministic set 2046297 Document putSymbolTable determinism 4842a80 Derive instances in Data.Data 1dadd9a testsuite: Mark broken tests on powerpc64le 3747372 Refactored SymbolInfo to lower memory usage in RTS 079c1b8 Use useful names for Symbol Addr and Names in Linker.c 02f893e integer-gmp: Make minusInteger more efficient 4aa299d PrelInfo: Ensure that tuple promoted datacon names are in knownKeyNames eda73a3 RTS SMP: Use compiler built-ins on all platforms. 4dbacbc Rename isPinnedByteArray# to isByteArrayPinned# b948a1d Refactor the SymbolName and SymbolAddr types to be pointers 5965117 Replace hand-written Bounded instances with derived ones 0d963ca Add relocation type R_X86_64_REX_GOTPCRELX 4848ab9 Testsuite: fixup comments for T9872d [skip ci] 886f4c1 Better comment for orIfNotFound. f91d87d Failing test-case for #12135. 3042a9d Use UniqDFM for HomePackageTable 48e9a1f Implement deterministic CallInfoSet a90085b Add @since annotations to base instances e684f54 Desugar ApplicativeDo and RecDo deterministically 31ba8d6 Kill nameSetElems 46d2da0 Document putDictionary determinism 3e7a876 Kill foldUniqSet 1937ef1 Make UnitIdMap a deterministic map a13cb27 Merge MatchFixity and HsMatchContext 77ccdf3 Kill occSetElts 7fea712 Use a deterministic map for imp_dep_mods d05dee3 CoreToStg: Remove hand-written Eq instances of HowBound and LetInfo 4426c5f Kill two instances of uniqSetToList 0d6f428 Fix build by removing unused import c148212 Kill varSetElems in checkValidInferredKinds ad8e203 Use DVarSet in Vectorise.Exp 3b698e8 Document determinism in pprintClosureCommand 5db93d2 Make vectInfoParallelVars a DVarSet 7008515 Kill varSetElems 7d58a97 Use pprUFM in pprStgLVs 00e3a5d Typofix. 4d5b2f6 Testsuite driver: always quote opts.testdir f5f5a8a Testsuite Windows: mark T8308 expect_broken (#8308) d4b548e Add some determinism tests dd33245 Desugar: Display resulting program stats with -v2 44a3c18 Revert "Desugar: Display resulting program stats with -v2" c2bbc8b Report term sizes with -v3 even when -ddump is enabled 80cf4cf Literal: Remove unused hashLiteral function d7933cb Show sources of cost centers in .prof 8f6d292 Fix #12064 by making IfaceClass typechecking more lazy. acb9e85 Minor performance note about IdInfo. 11ff1df Fix #12076 by inlining trivial expressions in CorePrep. 48385cb Remove special casing of Windows in generic files ceaf7f1 Implement Eq TyCon directly 68c1c29 Remove Ord (CoAxiom br) 9dbf354 Testsuite: delete dead code [skip ci] e703a23 Docs: fix links to ghc-flags 70e0a56 Remove Ord Class b2624ee Remove Ord PatSyn 77b8c29 Remove Ord AltCon c22ab1a Docs: delete PatternGuards documentation b020db2 Fix Ticky histogram on Windows e9dfb6e Improve the error messages for static forms. b0a7664 prettyPrintClosure(): Untag the closure before accessing fields 47d8173 Remove Printer.c:prettyPrintClosure() bcb419a Fix #12099: Remove bogus flags 6adff01 Comments only 6905ce2 Refine imports slightly 0f0b002 Comments only 3ae18df Minor refactoring b9fa72a Small refactor to mkRuntimErrorId 9e5ea67 NUMA support c88f31a Rts flags cleanup 5990016 ModuleSet: Use an actual set instead of map to units 6f551b4 rts: Fix build when USE_LARGE_ADDRESS_SPACE is undefined d2142bb rts: Add `-Wundef` to CFLAGS and fix warnings From git at git.haskell.org Sun Jun 12 05:31:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Jun 2016 05:31:35 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: rts: Add `-Wundef` to CFLAGS and fix warnings (0f624db) Message-ID: <20160612053135.9BD293A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/0f624db4179786deec0dbe7432899358cf9b71a8/ghc >--------------------------------------------------------------- commit 0f624db4179786deec0dbe7432899358cf9b71a8 Author: Erik de Castro Lopo Date: Wed May 18 20:04:26 2016 +1000 rts: Add `-Wundef` to CFLAGS and fix warnings >--------------------------------------------------------------- 0f624db4179786deec0dbe7432899358cf9b71a8 compiler/utils/Panic.hs | 4 +- ghc/GHCi/UI.hs | 2 +- includes/MachineDefines.h | 134 ++++++++++++++++++++++ includes/Rts.h | 8 +- includes/RtsAPI.h | 2 +- includes/Stg.h | 6 +- includes/rts/IOManager.h | 2 +- includes/rts/Linker.h | 2 +- includes/rts/Messages.h | 2 +- includes/rts/OSThreads.h | 6 +- includes/rts/Threads.h | 2 +- includes/rts/storage/GC.h | 2 +- includes/rts/storage/InfoTables.h | 2 +- includes/rts/storage/TSO.h | 4 +- includes/stg/DLL.h | 6 +- includes/stg/MachRegs.h | 26 ++--- includes/stg/RtsMachRegs.h | 2 + includes/stg/SMP.h | 15 ++- includes/stg/Types.h | 2 +- libraries/base/GHC/Conc/IO.hs | 22 ++-- libraries/base/GHC/Conc/Sync.hs | 2 +- libraries/base/GHC/Conc/Windows.hs | 2 +- libraries/base/cbits/DarwinUtils.c | 2 +- libraries/base/cbits/PrelIOUtils.c | 2 +- libraries/base/include/HsBase.h | 2 +- libraries/ghc-prim/cbits/ctz.c | 2 +- rts/Adjustor.c | 79 ++++++------- rts/BeginPrivate.h | 2 +- rts/Capability.c | 6 +- rts/Capability.h | 2 +- rts/EndPrivate.h | 2 +- rts/Excn.h | 2 +- rts/HeapStackCheck.cmm | 2 +- rts/Interpreter.c | 7 +- rts/Libdw.c | 4 +- rts/Linker.c | 220 ++++++++++++++++++------------------ rts/LinkerInternals.h | 5 +- rts/PosixSource.h | 4 +- rts/PrimOps.cmm | 12 +- rts/Profiling.c | 2 +- rts/RaiseAsync.c | 8 +- rts/RaiseAsync.h | 2 +- rts/RtsFlags.c | 14 +-- rts/RtsMessages.c | 14 +-- rts/RtsSignals.h | 4 +- rts/RtsStartup.c | 14 +-- rts/RtsSymbols.c | 26 ++--- rts/RtsUtils.c | 10 +- rts/Schedule.c | 8 +- rts/Stats.h | 2 +- rts/StgCRun.c | 54 ++++----- rts/StgRun.h | 2 +- rts/Task.h | 8 +- rts/Threads.c | 4 +- rts/Trace.c | 2 +- rts/eventlog/EventLog.c | 2 +- rts/ghc.mk | 3 + rts/posix/Clock.h | 2 +- rts/posix/GetEnv.c | 2 +- rts/posix/GetTime.c | 6 +- rts/posix/Itimer.c | 6 +- rts/posix/OSMem.c | 2 +- rts/posix/OSThreads.c | 24 ++-- rts/posix/Signals.c | 6 +- rts/sm/Evac.h | 2 +- rts/sm/GCTDecl.h | 7 +- rts/sm/GCUtils.c | 2 +- rts/sm/GCUtils.h | 2 +- rts/sm/Storage.c | 15 ++- testsuite/tests/rts/T5435_asm.c | 4 +- testsuite/tests/rts/linker_error.c | 6 +- testsuite/tests/rts/linker_unload.c | 2 +- testsuite/tests/rts/spalign.c | 6 +- utils/ghc-pkg/Main.hs | 14 +-- utils/runghc/Main.hs | 10 +- 75 files changed, 531 insertions(+), 376 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 0f624db4179786deec0dbe7432899358cf9b71a8 From git at git.haskell.org Sun Jun 12 05:52:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Jun 2016 05:52:15 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: rts: Add `-Wundef` to CFLAGS and fix warnings (f9d4672) Message-ID: <20160612055215.304163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/f9d467225fd8feb80c6af0ae117de045a47bb9f6/ghc >--------------------------------------------------------------- commit f9d467225fd8feb80c6af0ae117de045a47bb9f6 Author: Erik de Castro Lopo Date: Wed May 18 20:04:26 2016 +1000 rts: Add `-Wundef` to CFLAGS and fix warnings >--------------------------------------------------------------- f9d467225fd8feb80c6af0ae117de045a47bb9f6 compiler/utils/Panic.hs | 4 +- ghc/GHCi/UI.hs | 2 +- includes/MachineDefines.h | 134 ++++++++++++++++++++++ includes/Rts.h | 8 +- includes/RtsAPI.h | 2 +- includes/Stg.h | 6 +- includes/rts/IOManager.h | 2 +- includes/rts/Linker.h | 2 +- includes/rts/Messages.h | 2 +- includes/rts/OSThreads.h | 6 +- includes/rts/Threads.h | 2 +- includes/rts/storage/GC.h | 2 +- includes/rts/storage/InfoTables.h | 2 +- includes/rts/storage/TSO.h | 4 +- includes/stg/DLL.h | 6 +- includes/stg/MachRegs.h | 26 ++--- includes/stg/RtsMachRegs.h | 2 + includes/stg/SMP.h | 15 ++- includes/stg/Types.h | 2 +- libraries/base/GHC/Conc/IO.hs | 22 ++-- libraries/base/GHC/Conc/Sync.hs | 2 +- libraries/base/GHC/Conc/Windows.hs | 2 +- libraries/base/cbits/DarwinUtils.c | 2 +- libraries/base/cbits/PrelIOUtils.c | 2 +- libraries/base/include/HsBase.h | 2 +- libraries/ghc-prim/cbits/ctz.c | 2 +- rts/Adjustor.c | 79 ++++++------- rts/BeginPrivate.h | 2 +- rts/Capability.c | 6 +- rts/Capability.h | 2 +- rts/EndPrivate.h | 2 +- rts/Excn.h | 2 +- rts/HeapStackCheck.cmm | 2 +- rts/Interpreter.c | 7 +- rts/Libdw.c | 4 +- rts/Linker.c | 220 ++++++++++++++++++------------------ rts/LinkerInternals.h | 5 +- rts/PosixSource.h | 2 +- rts/PrimOps.cmm | 12 +- rts/Profiling.c | 2 +- rts/RaiseAsync.c | 8 +- rts/RaiseAsync.h | 2 +- rts/RtsFlags.c | 14 +-- rts/RtsMessages.c | 14 +-- rts/RtsSignals.h | 4 +- rts/RtsStartup.c | 14 +-- rts/RtsSymbols.c | 26 ++--- rts/RtsUtils.c | 10 +- rts/Schedule.c | 8 +- rts/Stats.h | 2 +- rts/StgCRun.c | 54 ++++----- rts/StgRun.h | 2 +- rts/Task.h | 8 +- rts/Threads.c | 4 +- rts/Trace.c | 2 +- rts/eventlog/EventLog.c | 2 +- rts/ghc.mk | 3 + rts/posix/Clock.h | 2 +- rts/posix/GetEnv.c | 2 +- rts/posix/GetTime.c | 6 +- rts/posix/Itimer.c | 6 +- rts/posix/OSMem.c | 2 +- rts/posix/OSThreads.c | 24 ++-- rts/posix/Signals.c | 6 +- rts/sm/Evac.h | 2 +- rts/sm/GCTDecl.h | 7 +- rts/sm/GCUtils.c | 2 +- rts/sm/GCUtils.h | 2 +- rts/sm/Storage.c | 15 ++- testsuite/tests/rts/T5435_asm.c | 4 +- testsuite/tests/rts/linker_error.c | 6 +- testsuite/tests/rts/linker_unload.c | 2 +- testsuite/tests/rts/spalign.c | 6 +- utils/ghc-pkg/Main.hs | 14 +-- utils/runghc/Main.hs | 10 +- 75 files changed, 529 insertions(+), 376 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 f9d467225fd8feb80c6af0ae117de045a47bb9f6 From git at git.haskell.org Sun Jun 12 07:45:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Jun 2016 07:45:59 +0000 (UTC) Subject: [commit: ghc] wip/erikd/rts: rts: Add `-Wundef` to CFLAGS and fix warnings (3c9ca2f) Message-ID: <20160612074559.319553A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/rts Link : http://ghc.haskell.org/trac/ghc/changeset/3c9ca2f5b11583961ad5a8ad973632f308eaf498/ghc >--------------------------------------------------------------- commit 3c9ca2f5b11583961ad5a8ad973632f308eaf498 Author: Erik de Castro Lopo Date: Wed May 18 20:04:26 2016 +1000 rts: Add `-Wundef` to CFLAGS and fix warnings >--------------------------------------------------------------- 3c9ca2f5b11583961ad5a8ad973632f308eaf498 compiler/utils/Panic.hs | 4 +- ghc/GHCi/UI.hs | 2 +- ghc/hschooks.c | 1 - includes/MachineDefines.h | 134 ++++++++++++++++++++++ includes/Rts.h | 8 +- includes/RtsAPI.h | 2 +- includes/Stg.h | 6 +- includes/rts/IOManager.h | 2 +- includes/rts/Linker.h | 2 +- includes/rts/Messages.h | 2 +- includes/rts/OSThreads.h | 6 +- includes/rts/Threads.h | 2 +- includes/rts/storage/GC.h | 2 +- includes/rts/storage/InfoTables.h | 2 +- includes/rts/storage/TSO.h | 4 +- includes/stg/DLL.h | 6 +- includes/stg/MachRegs.h | 26 ++--- includes/stg/RtsMachRegs.h | 2 + includes/stg/SMP.h | 15 ++- includes/stg/Types.h | 2 +- libraries/base/GHC/Conc/IO.hs | 22 ++-- libraries/base/GHC/Conc/Sync.hs | 2 +- libraries/base/GHC/Conc/Windows.hs | 2 +- libraries/base/cbits/DarwinUtils.c | 2 +- libraries/base/cbits/PrelIOUtils.c | 2 +- libraries/base/include/HsBase.h | 2 +- libraries/ghc-prim/cbits/ctz.c | 2 +- rts/Adjustor.c | 79 ++++++------- rts/BeginPrivate.h | 2 +- rts/Capability.c | 6 +- rts/Capability.h | 2 +- rts/EndPrivate.h | 2 +- rts/Excn.h | 2 +- rts/HeapStackCheck.cmm | 2 +- rts/Interpreter.c | 7 +- rts/Libdw.c | 4 +- rts/Linker.c | 220 ++++++++++++++++++------------------ rts/LinkerInternals.h | 7 +- rts/PosixSource.h | 4 +- rts/PrimOps.cmm | 12 +- rts/Profiling.c | 2 +- rts/RaiseAsync.c | 8 +- rts/RaiseAsync.h | 2 +- rts/RtsFlags.c | 14 +-- rts/RtsMessages.c | 14 +-- rts/RtsSignals.h | 4 +- rts/RtsStartup.c | 14 +-- rts/RtsSymbols.c | 26 ++--- rts/RtsUtils.c | 10 +- rts/Schedule.c | 8 +- rts/Stats.h | 2 +- rts/StgCRun.c | 54 ++++----- rts/StgRun.h | 2 +- rts/Task.h | 8 +- rts/Threads.c | 4 +- rts/Trace.c | 2 +- rts/eventlog/EventLog.c | 2 +- rts/ghc.mk | 3 + rts/posix/Clock.h | 2 +- rts/posix/GetEnv.c | 2 +- rts/posix/GetTime.c | 6 +- rts/posix/Itimer.c | 6 +- rts/posix/OSMem.c | 2 +- rts/posix/OSThreads.c | 24 ++-- rts/posix/Signals.c | 6 +- rts/sm/Evac.h | 2 +- rts/sm/GCTDecl.h | 7 +- rts/sm/GCUtils.c | 2 +- rts/sm/GCUtils.h | 2 +- rts/sm/Storage.c | 15 ++- testsuite/tests/rts/T5435_asm.c | 4 +- testsuite/tests/rts/linker_error.c | 6 +- testsuite/tests/rts/linker_unload.c | 2 +- testsuite/tests/rts/spalign.c | 6 +- utils/ghc-pkg/Main.hs | 14 +-- utils/runghc/Main.hs | 10 +- 76 files changed, 531 insertions(+), 379 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 3c9ca2f5b11583961ad5a8ad973632f308eaf498 From git at git.haskell.org Sun Jun 12 09:48:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Jun 2016 09:48:19 +0000 (UTC) Subject: [commit: ghc] master: rts: Fix build when USE_LARGE_ADDRESS_SPACE is undefined (6ace660) Message-ID: <20160612094819.732053A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6ace660a0354303797c033dabc164df91f7cb956/ghc >--------------------------------------------------------------- commit 6ace660a0354303797c033dabc164df91f7cb956 Author: Erik de Castro Lopo Date: Sun Jun 12 17:50:39 2016 +1000 rts: Fix build when USE_LARGE_ADDRESS_SPACE is undefined The recently added NUMA related functions were mistakenly defined within a `#ifdef USE_LARGE_ADDRESS_SPACE` ... `#endif` block. Moving them outside this block fixes the build on PowerPC and Arm Linux. Test Plan: Build on PowerPC or Arm Linux Reviewers: hvr, austin, bgamari, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2326 >--------------------------------------------------------------- 6ace660a0354303797c033dabc164df91f7cb956 rts/posix/OSMem.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index a534219..58310fe 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -544,6 +544,8 @@ void osReleaseHeapMemory(void) sysErrorBelch("unable to release address space"); } +#endif + rtsBool osNumaAvailable(void) { #ifdef HAVE_NUMA_H @@ -575,5 +577,3 @@ StgWord osNumaMask(void) return 1; #endif } - -#endif From git at git.haskell.org Sun Jun 12 10:00:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Jun 2016 10:00:59 +0000 (UTC) Subject: [commit: ghc] master: Skip retc001 on OSX (9130867) Message-ID: <20160612100059.577CB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/913086797af8060808973e8f6a11a3702afffe14/ghc >--------------------------------------------------------------- commit 913086797af8060808973e8f6a11a3702afffe14 Author: Matthew Pickering Date: Sun Jun 12 11:03:43 2016 +0100 Skip retc001 on OSX See #11204, this test sometimes fails and sometimes passes on OSX which causes intermittent validate failures if it is run. >--------------------------------------------------------------- 913086797af8060808973e8f6a11a3702afffe14 testsuite/tests/driver/retc001/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/driver/retc001/all.T b/testsuite/tests/driver/retc001/all.T index 7e7c59a..aa36d77 100644 --- a/testsuite/tests/driver/retc001/all.T +++ b/testsuite/tests/driver/retc001/all.T @@ -1,6 +1,7 @@ test('retc001', [clean_cmd('$MAKE -s clean'), - when(opsys('darwin'), expect_broken(11204))], +# See issue 11204, this test sometimes passes and sometimes fails on OSX + when(opsys('darwin'), skip)], run_command, ['$MAKE -s --no-print-directory retc001']) From git at git.haskell.org Sun Jun 12 11:39:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Jun 2016 11:39:53 +0000 (UTC) Subject: [commit: ghc] master: Fix incorrect calculated relocations on Windows x86_64 (b40e1b4) Message-ID: <20160612113953.627A73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b40e1b4c6746bdc34e6a53548a3925d309201c4d/ghc >--------------------------------------------------------------- commit b40e1b4c6746bdc34e6a53548a3925d309201c4d Author: Tamar Christina Date: Sat Jun 11 10:18:19 2016 +0200 Fix incorrect calculated relocations on Windows x86_64 Summary: See #12031 for analysis, but essentially what happens is: To sum up the issue, the reason this seems to go wrong is because of how we initialize the `.bss` section for Windows in the runtime linker. The first issue is where we calculate the zero space for the section: ``` zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)"); sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image)); ``` Where ``` UInt32 PointerToRawData; ``` This means we're stuffing a `64-bit` value into a `32-bit` one. Also `zspace` can be larger than `oc->image`. In which case it'll overflow and then get truncated in the cast. The address of a value in the `.bss` section is then calculated as: ``` addr = ((UChar*)(oc->image)) + (sectabent->PointerToRawData + symtab_i->Value); ``` If it does truncate then this calculation won't be correct (which is what is happening). We then later use the value of `addr` as the `S` (Symbol) value for the relocations ``` S = (size_t) lookupSymbol_( (char*)symbol ); ``` Now the majority of the relocations are `R_X86_64_PC32` etc. e.g. They are guaranteed to fit in a `32-bit` value. The `R_X86_64_64` introduced for these pseudo-relocations so they can use the full `48-bit` addressing space isn't as lucky. As for why it sometimes work has to do on whether the value is truncated or not. `PointerToRawData` can't be changed because it's size is fixed by the PE specification. Instead just like with the other platforms, we now use `section` on Windows as well. This gives us a `start` parameter of type `void*` which solves the issue. This refactors the code to use `section.start` and to fix the issues. Test Plan: ./validate and new test added T12031 Reviewers: RyanGlScott, erikd, bgamari, austin, simonmar Reviewed By: simonmar Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2316 GHC Trac Issues: #12031, #11317 >--------------------------------------------------------------- b40e1b4c6746bdc34e6a53548a3925d309201c4d rts/Linker.c | 73 ++++++++++++++++++-------------- rts/LinkerInternals.h | 4 +- testsuite/tests/rts/T12031/ExternBug.hs | 9 ++++ testsuite/tests/rts/T12031/Makefile | 8 ++++ testsuite/tests/rts/T12031/T12031.stdout | 1 + testsuite/tests/rts/T12031/all.T | 4 ++ testsuite/tests/rts/T12031/bar.c | 11 +++++ testsuite/tests/rts/T12031/baz.c | 9 ++++ testsuite/tests/rts/T12031/foo.h | 11 +++++ 9 files changed, 97 insertions(+), 33 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 b40e1b4c6746bdc34e6a53548a3925d309201c4d From git at git.haskell.org Sun Jun 12 12:37:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Jun 2016 12:37:43 +0000 (UTC) Subject: [commit: ghc] master: Disable T12031 on linux (29e1464) Message-ID: <20160612123743.B83443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/29e1464319f40fe30fd63d8648f0d0a05541abe0/ghc >--------------------------------------------------------------- commit 29e1464319f40fe30fd63d8648f0d0a05541abe0 Author: Tamar Christina Date: Sun Jun 12 14:41:18 2016 +0200 Disable T12031 on linux >--------------------------------------------------------------- 29e1464319f40fe30fd63d8648f0d0a05541abe0 testsuite/tests/rts/T12031/all.T | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/rts/T12031/all.T b/testsuite/tests/rts/T12031/all.T index b051514..5e1a0a8 100644 --- a/testsuite/tests/rts/T12031/all.T +++ b/testsuite/tests/rts/T12031/all.T @@ -1,4 +1,5 @@ test('T12031', [ extra_clean(['bar.o', 'baz.o', 'ExternBug.o']) , extra_files(['bar.c', 'baz.c', 'ExternBug.hs', 'foo.h']) + , unless(opsys('mingw32'), skip) ], run_command, ['$MAKE -s --no-print-directory T12031']) From git at git.haskell.org Mon Jun 13 09:21:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 09:21:25 +0000 (UTC) Subject: [commit: ghc] master: rts: Fix NUMA when cross compiling (2bb6ba6) Message-ID: <20160613092125.5F3BE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2bb6ba62b8d0e9c79b59e39e225758cf999eff83/ghc >--------------------------------------------------------------- commit 2bb6ba62b8d0e9c79b59e39e225758cf999eff83 Author: Erik de Castro Lopo Date: Mon Jun 13 19:24:18 2016 +1000 rts: Fix NUMA when cross compiling The NUMA code was enabled whenever numa.h and numaif.h are detected. Unfortunately, the hosts' header files were being detected even then cross compiling in the absence of a target libnuma. Fix that by relying on the the presence of libnuma instead of the presence of the header files. The test for libnuma does `AC_TRY_LINK` which will fail if the test program (compiled for the target) can't be linked against libnuma. Test Plan: Build on x86_64/linux and make sure NUMA works and cross compile to armhf/linux. Reviewers: austin, bgamari, hvr, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2329 >--------------------------------------------------------------- 2bb6ba62b8d0e9c79b59e39e225758cf999eff83 configure.ac | 9 ++++++--- rts/posix/OSMem.c | 8 ++++---- rts/posix/OSThreads.c | 2 +- 3 files changed, 11 insertions(+), 8 deletions(-) diff --git a/configure.ac b/configure.ac index 070bae5..664deb4 100644 --- a/configure.ac +++ b/configure.ac @@ -1105,10 +1105,13 @@ AC_DEFINE_UNQUOTED([USE_LIBDW], [$USE_LIBDW], [Set to 1 to use libdw]) dnl ** Have libnuma? dnl -------------------------------------------------------------- +HaveLibNuma=0 AC_CHECK_HEADERS([numa.h numaif.h]) -AC_CHECK_LIB(numa, numa_available, - [AC_DEFINE([HAVE_LIBNUMA], [1], [Define to 1 if you have libnuma.])] - []) + +if test "$ac_cv_header_numa_h$ac_cv_header_numaif_h" = "yesyes" ; then + AC_CHECK_LIB(numa, numa_available,HaveLibNuma=1) +fi +AC_DEFINE_UNQUOTED([USE_LIBNUMA], [$HaveLibNuma], [Define to 1 if you have libnuma]) dnl ** Documentation dnl -------------------------------------------------------------- diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index 58310fe..99620ee 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -306,7 +306,7 @@ void osBindMBlocksToNode( StgWord size STG_UNUSED, uint32_t node STG_UNUSED) { -#ifdef HAVE_NUMAIF_H +#if HAVE_LIBNUMA int ret; StgWord mask = 0; mask |= 1 << node; @@ -548,7 +548,7 @@ void osReleaseHeapMemory(void) rtsBool osNumaAvailable(void) { -#ifdef HAVE_NUMA_H +#if HAVE_LIBNUMA return (numa_available() != -1); #else return rtsFalse; @@ -557,7 +557,7 @@ rtsBool osNumaAvailable(void) uint32_t osNumaNodes(void) { -#ifdef HAVE_NUMA_H +#if HAVE_LIBNUMA return numa_num_configured_nodes(); #else return 1; @@ -566,7 +566,7 @@ uint32_t osNumaNodes(void) StgWord osNumaMask(void) { -#ifdef HAVE_NUMA_H +#if HAVE_LIBNUMA struct bitmask *mask; mask = numa_get_mems_allowed(); if (mask->size > sizeof(StgWord)*8) { diff --git a/rts/posix/OSThreads.c b/rts/posix/OSThreads.c index 72538c1..35ea2bd 100644 --- a/rts/posix/OSThreads.c +++ b/rts/posix/OSThreads.c @@ -318,7 +318,7 @@ setThreadAffinity (uint32_t n STG_UNUSED, } #endif -#ifdef HAVE_NUMA_H +#if HAVE_LIBNUMA void setThreadNode (uint32_t node) { ASSERT(node < RtsFlags.GcFlags.nNumaNodes); From git at git.haskell.org Mon Jun 13 09:53:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 09:53:53 +0000 (UTC) Subject: [commit: ghc] master: Kill off redundant SigTv check in occurCheckExpand (d25cb61) Message-ID: <20160613095353.08A773A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d25cb61a1c2a135a2564143a332f8b2962f134bc/ghc >--------------------------------------------------------------- commit d25cb61a1c2a135a2564143a332f8b2962f134bc Author: Simon Peyton Jones Date: Mon May 16 22:08:08 2016 +0100 Kill off redundant SigTv check in occurCheckExpand This patch simply deletes code, the SigTv check in occurCheckExpand. As the new comment says In the past we also rejected a SigTv matched with a non-tyvar But it is wrong to reject that for Givens; and SigTv is in any case handled separately by - TcUnify.checkTauTvUpdate (on-the-fly unifier) - TcInteract.canSolveByUnification (main constraint solver) >--------------------------------------------------------------- d25cb61a1c2a135a2564143a332f8b2962f134bc compiler/typecheck/TcType.hs | 19 ++++++------------- 1 file changed, 6 insertions(+), 13 deletions(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 3a469bc..06f6a45 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1570,7 +1570,6 @@ See also Note [occurCheckExpand] in TcCanonical data OccCheckResult a = OC_OK a | OC_Forall - | OC_NonTyVar | OC_Occurs instance Functor OccCheckResult where @@ -1583,7 +1582,6 @@ instance Applicative OccCheckResult where instance Monad OccCheckResult where OC_OK x >>= k = k x OC_Forall >>= _ = OC_Forall - OC_NonTyVar >>= _ = OC_NonTyVar OC_Occurs >>= _ = OC_Occurs occurCheckExpand :: DynFlags -> TcTyVar -> Type -> OccCheckResult Type @@ -1591,16 +1589,19 @@ occurCheckExpand :: DynFlags -> TcTyVar -> Type -> OccCheckResult Type -- Check whether -- a) the given variable occurs in the given type. -- b) there is a forall in the type (unless we have -XImpredicativeTypes) --- c) if it's a SigTv, ty should be a tyvar -- -- We may have needed to do some type synonym unfolding in order to -- get rid of the variable (or forall), so we also return the unfolded -- version of the type, which is guaranteed to be syntactically free -- of the given type variable. If the type is already syntactically -- free of the variable, then the same type is returned. +-- +-- NB: in the past we also rejected a SigTv matched with a non-tyvar +-- But it is wrong to reject that for Givens; +-- and SigTv is in any case handled separately by +-- - TcUnify.checkTauTvUpdate (on-the-fly unifier) +-- - TcInteract.canSolveByUnification (main constraint solver) occurCheckExpand dflags tv ty - | MetaTv { mtv_info = SigTv } <- details - = go_sig_tv ty | fast_check ty = return ty | otherwise = go emptyVarEnv ty where @@ -1608,14 +1609,6 @@ occurCheckExpand dflags tv ty impredicative = canUnifyWithPolyType dflags details - -- Check 'ty' is a tyvar, or can be expanded into one - go_sig_tv ty@(TyVarTy tv') - | fast_check (tyVarKind tv') = return ty - | otherwise = do { k' <- go emptyVarEnv (tyVarKind tv') - ; return (mkTyVarTy (setTyVarKind tv' k')) } - go_sig_tv ty | Just ty' <- coreView ty = go_sig_tv ty' - go_sig_tv _ = OC_NonTyVar - -- True => fine fast_check (LitTy {}) = True fast_check (TyVarTy tv') = tv /= tv' && fast_check (tyVarKind tv') From git at git.haskell.org Mon Jun 13 09:53:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 09:53:55 +0000 (UTC) Subject: [commit: ghc] master: Improve typechecking of let-bindings (15b9bf4) Message-ID: <20160613095355.F2E473A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/15b9bf4ba4ab47e6809bf2b3b36ec16e502aea72/ghc >--------------------------------------------------------------- commit 15b9bf4ba4ab47e6809bf2b3b36ec16e502aea72 Author: Simon Peyton Jones Date: Sat Jun 11 23:49:27 2016 +0100 Improve typechecking of let-bindings This major commit was initially triggered by #11339, but it spiraled into a major review of the way in which type signatures for bindings are handled, especially partial type signatures. On the way I fixed a number of other bugs, namely #12069 #12033 #11700 #11339 #11670 The main change is that I completely reorganised the way in which type signatures in bindings are handled. The new story is in TcSigs Note [Overview of type signatures]. Some specific: * Changes in the data types for signatures in TcRnTypes: TcIdSigInfo and new TcIdSigInst * New module TcSigs deals with typechecking type signatures and pragmas. It contains code mostly moved from TcBinds, which is already too big * HsTypes: I swapped the nesting of HsWildCardBndrs and HsImplicitBndsrs, so that the wildcards are on the oustide not the insidde in a LHsSigWcType. This is just a matter of convenient, nothing deep. There are a host of other changes as knock-on effects, and it all took FAR longer than I anticipated :-). But it is a significant improvement, I think. Lots of error messages changed slightly, some just variants but some modest improvements. New tests * typecheck/should_compile * SigTyVars: a scoped-tyvar test * ExPat, ExPatFail: existential pattern bindings * T12069 * T11700 * T11339 * partial-sigs/should_compile * T12033 * T11339a * T11670 One thing to check: * Small change to output from ghc-api/landmines. Need to check with Alan Zimmerman >--------------------------------------------------------------- 15b9bf4ba4ab47e6809bf2b3b36ec16e502aea72 compiler/deSugar/DsMeta.hs | 14 +- compiler/deSugar/DsMonad.hs | 1 - compiler/ghc.cabal.in | 1 + compiler/hsSyn/HsTypes.hs | 34 +- compiler/hsSyn/HsUtils.hs | 2 +- compiler/rename/RnTypes.hs | 184 ++-- compiler/typecheck/TcBinds.hs | 1041 +++++++------------- compiler/typecheck/TcClassDcl.hs | 45 +- compiler/typecheck/TcEnv.hs | 2 +- compiler/typecheck/TcErrors.hs | 20 +- compiler/typecheck/TcExpr.hs | 88 +- compiler/typecheck/TcHsType.hs | 306 ++++-- compiler/typecheck/TcInstDcls.hs | 26 +- compiler/typecheck/TcMType.hs | 59 +- compiler/typecheck/TcPat.hs | 174 +--- compiler/typecheck/TcPatSyn.hs | 204 +--- compiler/typecheck/TcPatSyn.hs-boot | 10 +- compiler/typecheck/TcRnDriver.hs | 8 +- compiler/typecheck/TcRnMonad.hs | 41 +- compiler/typecheck/TcRnTypes.hs | 280 +++--- compiler/typecheck/TcRules.hs | 2 +- compiler/typecheck/TcSigs.hs | 763 ++++++++++++++ compiler/typecheck/TcSimplify.hs | 66 +- compiler/typecheck/TcType.hs | 16 +- compiler/vectorise/Vectorise/Generic/PData.hs | 2 +- testsuite/tests/arrows/should_fail/T5380.stderr | 4 +- .../tests/dependent/should_compile/T11241.stderr | 4 +- testsuite/tests/deriving/should_fail/T7148.stderr | 4 +- testsuite/tests/deriving/should_fail/T7148a.stderr | 2 +- testsuite/tests/gadt/T3169.stderr | 2 +- testsuite/tests/gadt/T7558.stderr | 2 +- testsuite/tests/gadt/gadt-escape1.stderr | 2 +- testsuite/tests/gadt/gadt13.stderr | 2 +- testsuite/tests/gadt/gadt7.stderr | 4 +- testsuite/tests/gadt/rw.stderr | 4 +- testsuite/tests/ghc-api/landmines/landmines.stdout | 2 +- testsuite/tests/ghci/scripts/Defer02.stderr | 75 +- testsuite/tests/ghci/scripts/T10248.stderr | 4 +- testsuite/tests/ghci/scripts/ghci050.stderr | 2 +- .../indexed-types/should_compile/Simple14.stderr | 5 +- .../indexed-types/should_fail/GADTwrong1.stderr | 4 +- .../indexed-types/should_fail/Overlap6.stderr | 2 +- .../indexed-types/should_fail/SimpleFail5a.stderr | 2 +- .../tests/indexed-types/should_fail/T2664.stderr | 4 +- .../tests/indexed-types/should_fail/T3330a.hs | 7 +- .../tests/indexed-types/should_fail/T3330a.stderr | 4 +- .../tests/indexed-types/should_fail/T3440.stderr | 4 +- .../tests/indexed-types/should_fail/T4093a.stderr | 2 +- .../tests/indexed-types/should_fail/T4093b.stderr | 2 +- .../tests/indexed-types/should_fail/T4174.stderr | 2 +- .../tests/indexed-types/should_fail/T4272.stderr | 2 +- .../tests/indexed-types/should_fail/T7786.stderr | 38 +- .../tests/indexed-types/should_fail/T9662.stderr | 2 +- testsuite/tests/module/mod71.stderr | 2 +- .../should_compile/Defaulting2MROff.stderr | 2 +- .../should_compile/Defaulting2MROn.stderr | 4 +- .../partial-sigs/should_compile/Either.stderr | 2 +- .../partial-sigs/should_compile/EveryNamed.stderr | 2 +- .../should_compile/ExprSigLocal.stderr | 10 +- .../should_compile/ExtraConstraints3.stderr | 8 +- .../partial-sigs/should_compile/SimpleGen.stderr | 2 +- .../partial-sigs/should_compile/SplicesUsed.stderr | 73 +- .../partial-sigs/should_compile/SuperCls.stderr | 4 +- .../partial-sigs/should_compile/T10403.stderr | 28 +- .../partial-sigs/should_compile/T10438.stderr | 6 +- .../partial-sigs/should_compile/T10519.stderr | 8 +- .../partial-sigs/should_compile/T11016.stderr | 9 +- .../partial-sigs/should_compile/T11192.stderr | 20 +- .../tests/partial-sigs/should_compile/T11339a.hs | 6 + .../partial-sigs/should_compile/T11339a.stderr | 6 + .../tests/partial-sigs/should_compile/T11670.hs | 16 + .../partial-sigs/should_compile/T11670.stderr | 36 + .../tests/partial-sigs/should_compile/T12033.hs | 13 + .../partial-sigs/should_compile/T12033.stderr | 24 + .../partial-sigs/should_compile/Uncurry.stderr | 2 +- .../should_compile/UncurryNamed.stderr | 2 +- .../WarningWildcardInstantiations.stderr | 54 +- testsuite/tests/partial-sigs/should_compile/all.T | 3 + .../should_fail/Defaulting1MROff.stderr | 5 +- ...xtraConstraintsWildcardInExpressionSignature.hs | 2 + ...ConstraintsWildcardInExpressionSignature.stderr | 34 +- .../ExtraConstraintsWildcardNotEnabled.stderr | 10 +- .../InstantiatedNamedWildcardsInConstraints.stderr | 18 +- .../NamedExtraConstraintsWildcard.stderr | 8 +- .../should_fail/NamedWildcardExplicitForall.stderr | 21 +- .../should_fail/NamedWildcardsEnabled.stderr | 10 +- .../should_fail/NamedWildcardsNotEnabled.stderr | 4 +- .../should_fail/NamedWildcardsNotInMonotype.stderr | 10 +- .../PartialTypeSignaturesDisabled.stderr | 10 +- .../tests/partial-sigs/should_fail/PatBind3.stderr | 8 +- .../tests/partial-sigs/should_fail/T10045.stderr | 8 +- .../tests/partial-sigs/should_fail/T10615.stderr | 12 +- .../tests/partial-sigs/should_fail/T10999.stderr | 36 +- .../tests/partial-sigs/should_fail/T11122.stderr | 5 +- .../tests/partial-sigs/should_fail/T11976.stderr | 6 +- .../partial-sigs/should_fail/TidyClash.stderr | 18 +- .../partial-sigs/should_fail/TidyClash2.stderr | 46 +- .../should_fail/WildcardInstantiations.stderr | 54 +- .../WildcardsInPatternAndExprSig.stderr | 56 +- testsuite/tests/partial-sigs/should_fail/all.T | 3 +- testsuite/tests/patsyn/should_fail/T11010.stderr | 2 +- testsuite/tests/patsyn/should_fail/T11039.stderr | 2 +- testsuite/tests/patsyn/should_fail/T11667.stderr | 2 +- testsuite/tests/polykinds/T10503.stderr | 2 +- testsuite/tests/polykinds/T11399.hs | 5 +- testsuite/tests/polykinds/T11399.stderr | 10 +- testsuite/tests/polykinds/T7438.stderr | 6 +- testsuite/tests/polykinds/T7594.stderr | 2 +- testsuite/tests/polykinds/T9017.stderr | 2 +- .../tests/rename/should_fail/rnfail026.stderr | 3 +- testsuite/tests/th/T10267.stderr | 26 +- testsuite/tests/typecheck/should_compile/ExPat.hs | 17 + .../tests/typecheck/should_compile/ExPatFail.hs | 13 + .../typecheck/should_compile/ExPatFail.stderr | 14 + .../tests/typecheck/should_compile/FD1.stderr | 2 +- .../tests/typecheck/should_compile/FD2.stderr | 4 +- .../tests/typecheck/should_compile/FD3.stderr | 2 +- .../tests/typecheck/should_compile/SigTyVars.hs | 12 + .../tests/typecheck/should_compile/T10072.stderr | 2 +- .../tests/typecheck/should_compile/T10632.stderr | 0 testsuite/tests/typecheck/should_compile/T11339.hs | 32 + .../tests/typecheck/should_compile/T11339.stderr | 15 + .../tests/typecheck/should_compile/T11339b.hs | 32 + .../tests/typecheck/should_compile/T11339c.hs | 32 + .../tests/typecheck/should_compile/T11339d.hs | 15 + testsuite/tests/typecheck/should_compile/T11700.hs | 18 + testsuite/tests/typecheck/should_compile/T12069.hs | 4 + testsuite/tests/typecheck/should_compile/T2357.hs | 10 +- .../tests/typecheck/should_compile/T2494.stderr | 8 +- .../tests/typecheck/should_compile/T9834.stderr | 4 +- .../tests/typecheck/should_compile/T9939.stderr | 0 testsuite/tests/typecheck/should_compile/all.T | 9 + .../tests/typecheck/should_compile/holes.stderr | 2 +- .../tests/typecheck/should_compile/holes3.stderr | 2 +- .../tests/typecheck/should_compile/tc141.stderr | 2 +- .../tests/typecheck/should_fail/T10285.stderr | 4 +- .../tests/typecheck/should_fail/T10534.stderr | 4 +- .../tests/typecheck/should_fail/T10715.stderr | 23 +- .../tests/typecheck/should_fail/T11347.stderr | 4 +- testsuite/tests/typecheck/should_fail/T1899.stderr | 2 +- testsuite/tests/typecheck/should_fail/T2714.stderr | 2 +- testsuite/tests/typecheck/should_fail/T3102.stderr | 2 +- testsuite/tests/typecheck/should_fail/T5691.stderr | 28 +- testsuite/tests/typecheck/should_fail/T7264.stderr | 2 +- .../tests/typecheck/should_fail/T7748a.stderr | 2 +- testsuite/tests/typecheck/should_fail/T7869.stderr | 2 +- testsuite/tests/typecheck/should_fail/T8450.stderr | 2 +- testsuite/tests/typecheck/should_fail/T9109.stderr | 2 +- testsuite/tests/typecheck/should_fail/mc19.stderr | 2 +- testsuite/tests/typecheck/should_fail/mc21.stderr | 2 +- testsuite/tests/typecheck/should_fail/mc22.stderr | 2 +- .../tests/typecheck/should_fail/tcfail032.stderr | 2 +- .../tests/typecheck/should_fail/tcfail065.stderr | 4 +- .../tests/typecheck/should_fail/tcfail068.stderr | 16 +- .../tests/typecheck/should_fail/tcfail076.stderr | 4 +- .../tests/typecheck/should_fail/tcfail103.stderr | 4 +- .../tests/typecheck/should_fail/tcfail131.stderr | 2 +- .../tests/typecheck/should_fail/tcfail153.stderr | 2 +- .../tests/typecheck/should_fail/tcfail174.stderr | 2 +- .../tests/typecheck/should_fail/tcfail175.stderr | 2 +- .../tests/typecheck/should_fail/tcfail179.stderr | 4 +- .../tests/typecheck/should_fail/tcfail191.stderr | 2 +- .../tests/typecheck/should_fail/tcfail193.stderr | 2 +- .../tests/typecheck/should_fail/tcfail198.stderr | 2 +- .../tests/typecheck/should_fail/tcfail201.stderr | 2 +- .../tests/typecheck/should_fail/tcfail206.stderr | 4 +- 166 files changed, 2623 insertions(+), 2137 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 15b9bf4ba4ab47e6809bf2b3b36ec16e502aea72 From git at git.haskell.org Mon Jun 13 09:53:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 09:53:58 +0000 (UTC) Subject: [commit: ghc] master: Tidy up zonkQuantifiedTyVar (c28dde3) Message-ID: <20160613095358.A789A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c28dde37f3f274a2a1207dd4e175ea79769f5ead/ghc >--------------------------------------------------------------- commit c28dde37f3f274a2a1207dd4e175ea79769f5ead Author: Simon Peyton Jones Date: Sat Jun 11 23:51:44 2016 +0100 Tidy up zonkQuantifiedTyVar I managed to eliminate the strange zonkQuantifiedTyVarOrType, which is no longer used. >--------------------------------------------------------------- c28dde37f3f274a2a1207dd4e175ea79769f5ead compiler/typecheck/TcMType.hs | 28 +++++++--------------------- 1 file changed, 7 insertions(+), 21 deletions(-) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 8f64594..5f11e10 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -71,7 +71,7 @@ module TcMType ( zonkTyCoVarsAndFV, zonkTcTypeAndFV, zonkTyCoVarsAndFVList, zonkTcTypeAndSplitDepVars, zonkTcTypesAndSplitDepVars, - zonkQuantifiedTyVar, zonkQuantifiedTyVarOrType, + zonkQuantifiedTyVar, quantifyTyVars, quantifyZonkedTyVars, zonkTcTyCoVarBndr, zonkTcTyBinder, zonkTcType, zonkTcTypes, zonkCo, zonkTyCoVarKind, zonkTcTypeMapper, @@ -934,23 +934,9 @@ zonkQuantifiedTyVar :: Bool -- True <=> this is a kind var and -XNoPolyKind -- * RuntimeRep variables: we never quantify over these zonkQuantifiedTyVar default_kind tv - = do { mb_tv' <- zonkQuantifiedTyVarOrType default_kind tv - ; return (case mb_tv' of - Left x -> Just x -- Quantify over this - Right _ -> Nothing) -- Do not quantify over this - } - --- | Like zonkQuantifiedTyVar, but if zonking reveals that the tyvar --- should become a type (when defaulting a RuntimeRep var to PtrRepLifted), it --- returns the type instead. -zonkQuantifiedTyVarOrType :: Bool -- True <=> this is a kind var and -XNoPolyKinds - -- False <=> not a kind var or -XPolyKindsBool - -> TcTyVar - -> TcM (Either TcTyVar TcType) -zonkQuantifiedTyVarOrType default_kind tv = case tcTyVarDetails tv of SkolemTv {} -> do { kind <- zonkTcType (tyVarKind tv) - ; return $ Left $ setTyVarKind tv kind } + ; return $ Just (setTyVarKind tv kind) } -- It might be a skolem type variable, -- for example from a user type signature @@ -961,19 +947,19 @@ zonkQuantifiedTyVarOrType default_kind tv _other -> pprPanic "zonkQuantifiedTyVar" (ppr tv) -- FlatSkol, RuntimeUnk where - zonk_meta_tv :: TcTyVar -> TcM (Either TcTyVar TcType) + zonk_meta_tv :: TcTyVar -> TcM (Maybe TcTyVar) zonk_meta_tv tv | isRuntimeRepVar tv -- Never quantify over a RuntimeRep var = do { writeMetaTyVar tv ptrRepLiftedTy - ; return (Right ptrRepLiftedTy) } + ; return Nothing } | default_kind -- -XNoPolyKinds and this is a kind var - = do { kind <- default_kind_var tv - ; return (Right kind) } + = do { _ <- default_kind_var tv + ; return Nothing } | otherwise = do { tv' <- skolemiseUnboundMetaTyVar tv vanillaSkolemTv - ; return (Left tv') } + ; return (Just tv') } default_kind_var :: TyVar -> TcM Type -- defaultKindVar is used exclusively with -XNoPolyKinds From git at git.haskell.org Mon Jun 13 09:54:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 09:54:01 +0000 (UTC) Subject: [commit: ghc] master: Get in-scope set right in top_instantiate (7afb7ad) Message-ID: <20160613095401.4E17C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7afb7adf45216701e4f645676ecc0668f64b424d/ghc >--------------------------------------------------------------- commit 7afb7adf45216701e4f645676ecc0668f64b424d Author: Simon Peyton Jones Date: Sat Jun 11 23:55:10 2016 +0100 Get in-scope set right in top_instantiate ...thereby being able to replace substThetaUnchecked with substTheta >--------------------------------------------------------------- 7afb7adf45216701e4f645676ecc0668f64b424d compiler/typecheck/Inst.hs | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index 25aa3cc..27382c5 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -172,7 +172,8 @@ topInstantiateInferred :: CtOrigin -> TcSigmaType -- then wrap e :: rho topInstantiateInferred = top_instantiate False -top_instantiate :: Bool -- True <=> instantiate *all* variables +top_instantiate :: Bool -- True <=> instantiate *all* variables + -- False <=> instantiate only the invisible ones -> CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType) top_instantiate inst_all orig ty | not (null binders && null theta) @@ -180,16 +181,21 @@ top_instantiate inst_all orig ty (inst_theta, leave_theta) | null leave_bndrs = (theta, []) | otherwise = ([], theta) - ; (subst, inst_tvs') <- newMetaTyVars (map (binderVar "top_inst") inst_bndrs) - ; let inst_theta' = substThetaUnchecked subst inst_theta - sigma' = substTyAddInScope subst (mkForAllTys leave_bndrs $ - mkFunTys leave_theta rho) + in_scope = mkInScopeSet (tyCoVarsOfType ty) + empty_subst = mkEmptyTCvSubst in_scope + inst_tvs = map (binderVar "top_inst") inst_bndrs + ; (subst, inst_tvs') <- mapAccumLM newMetaTyVarX empty_subst inst_tvs + ; let inst_theta' = substTheta subst inst_theta + sigma' = substTy subst (mkForAllTys leave_bndrs $ + mkFunTys leave_theta rho) ; wrap1 <- instCall orig (mkTyVarTys inst_tvs') inst_theta' ; traceTc "Instantiating" (vcat [ text "all tyvars?" <+> ppr inst_all , text "origin" <+> pprCtOrigin orig , text "type" <+> ppr ty + , text "theta" <+> ppr theta + , text "leave_bndrs" <+> ppr leave_bndrs , text "with" <+> ppr inst_tvs' , text "theta:" <+> ppr inst_theta' ]) From git at git.haskell.org Mon Jun 13 09:54:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 09:54:03 +0000 (UTC) Subject: [commit: ghc] master: Move the constraint-kind validity check (35c9de7) Message-ID: <20160613095403.F0AFC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/35c9de7ca053eda472cb446c53bcd2007bfd8394/ghc >--------------------------------------------------------------- commit 35c9de7ca053eda472cb446c53bcd2007bfd8394 Author: Simon Peyton Jones Date: Sat Jun 11 23:56:42 2016 +0100 Move the constraint-kind validity check For type synonyms, we need to check that if the RHS has kind Constraint, then we have -XConstraintKinds. For some reason this was done in checkValidType, but it makes more sense to do it in checkValidTyCon. I can't remember quite why I made this change; maybe it fixes a Trac ticket, but if so I forget which. But it's a modest improvement anyway. >--------------------------------------------------------------- 35c9de7ca053eda472cb446c53bcd2007bfd8394 compiler/typecheck/TcTyClsDecls.hs | 3 ++- compiler/typecheck/TcValidity.hs | 27 +++++++-------------------- 2 files changed, 9 insertions(+), 21 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index f07d877..7f0023e 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -2113,7 +2113,8 @@ checkValidTyCon tc -> checkValidClass cl | Just syn_rhs <- synTyConRhs_maybe tc - -> checkValidType syn_ctxt syn_rhs + -> do { checkValidType syn_ctxt syn_rhs + ; checkTySynRhs syn_ctxt syn_rhs } | Just fam_flav <- famTyConFlav_maybe tc -> case fam_flav of diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index f137d1e..b4f2d88 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -10,7 +10,7 @@ module TcValidity ( ContextKind(..), expectedKindInCtxt, checkValidTheta, checkValidFamPats, checkValidInstance, validDerivPred, - checkInstTermination, + checkInstTermination, checkTySynRhs, ClsInstInfo, checkValidCoAxiom, checkValidCoAxBranch, checkValidTyFamEqn, arityErr, badATErr, @@ -355,11 +355,6 @@ checkValidType ctxt ty -- Check the internal validity of the type itself ; check_type env ctxt rank ty - -- Check that the thing has kind Type, and is lifted if necessary. - -- Do this *after* check_type, because we can't usefully take - -- the kind of an ill-formed type such as (a~Int) - ; check_kind env ctxt ty - ; checkUserTypeError ty -- Check for ambiguous types. See Note [When to call checkAmbiguity] @@ -375,23 +370,18 @@ checkValidMonoType ty = do { env <- tcInitOpenTidyEnv (tyCoVarsOfTypeList ty) ; check_type env SigmaCtxt MustBeMonoType ty } -check_kind :: TidyEnv -> UserTypeCtxt -> TcType -> TcM () --- Check that the type's kind is acceptable for the context -check_kind env ctxt ty - | TySynCtxt {} <- ctxt - , returnsConstraintKind actual_kind +checkTySynRhs :: UserTypeCtxt -> TcType -> TcM () +checkTySynRhs ctxt ty + | returnsConstraintKind actual_kind = do { ck <- xoptM LangExt.ConstraintKinds ; if ck then when (isConstraintKind actual_kind) (do { dflags <- getDynFlags - ; check_pred_ty env dflags ctxt ty }) - else addErrTcM (constraintSynErr env actual_kind) } + ; check_pred_ty emptyTidyEnv dflags ctxt ty }) + else addErrTcM (constraintSynErr emptyTidyEnv actual_kind) } | otherwise - = case expectedKindInCtxt ctxt of - TheKind k -> checkTcM (tcEqType actual_kind k) (kindErr env actual_kind) - OpenKind -> checkTcM (classifiesTypeWithValues actual_kind) (kindErr env actual_kind) - AnythingKind -> return () + = return () where actual_kind = typeKind ty @@ -653,9 +643,6 @@ forAllEscapeErr env ty tau_kind ubxArgTyErr :: TidyEnv -> Type -> (TidyEnv, SDoc) ubxArgTyErr env ty = (env, sep [text "Illegal unboxed tuple type as function argument:", ppr_tidy env ty]) -kindErr :: TidyEnv -> Kind -> (TidyEnv, SDoc) -kindErr env kind = (env, sep [text "Expecting an ordinary type, but found a type of kind", ppr_tidy env kind]) - {- Note [Liberal type synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Mon Jun 13 09:54:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 09:54:06 +0000 (UTC) Subject: [commit: ghc] master: Beef up mkNakedCastTy (1f66128) Message-ID: <20160613095406.99D1D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f661281a23b6eab83a1144c43e464c0e2d2195a/ghc >--------------------------------------------------------------- commit 1f661281a23b6eab83a1144c43e464c0e2d2195a Author: Simon Peyton Jones Date: Sun Jun 12 00:00:53 2016 +0100 Beef up mkNakedCastTy By spotting Refl coercions we can avoid building an awful lot of CastTys. Simple and effective. >--------------------------------------------------------------- 1f661281a23b6eab83a1144c43e464c0e2d2195a compiler/typecheck/TcType.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index b48a0c1..5a453dd 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1186,7 +1186,13 @@ mkNakedAppTy :: Type -> Type -> Type mkNakedAppTy ty1 ty2 = mkNakedAppTys ty1 [ty2] mkNakedCastTy :: Type -> Coercion -> Type -mkNakedCastTy = CastTy +-- Do simple, fast compaction; especially dealing with Refl +-- for which it's plain stupid to create a cast +-- This simple function killed off a huge number of Refl casts +-- in types, at birth. +mkNakedCastTy ty co | isReflCo co = ty +mkNakedCastTy (CastTy ty co1) co2 = CastTy ty (co1 `mkTransCo` co2) +mkNakedCastTy ty co = CastTy ty co {- ************************************************************************ From git at git.haskell.org Mon Jun 13 09:54:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 09:54:09 +0000 (UTC) Subject: [commit: ghc] master: Fix the in-scope set for extendTvSubstWithClone (15fc528) Message-ID: <20160613095409.421773A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/15fc52819c440f9e9b91ce92fcfda3c264cbe1c1/ghc >--------------------------------------------------------------- commit 15fc52819c440f9e9b91ce92fcfda3c264cbe1c1 Author: Simon Peyton Jones Date: Sun Jun 12 00:04:30 2016 +0100 Fix the in-scope set for extendTvSubstWithClone We'd forgotten the variables free in the kind. Ditto extendCvSubstWithClone >--------------------------------------------------------------- 15fc52819c440f9e9b91ce92fcfda3c264cbe1c1 compiler/typecheck/TcType.hs | 3 +++ compiler/types/TyCoRep.hs | 8 ++++++-- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 5a453dd..d6cd5b2 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1190,6 +1190,9 @@ mkNakedCastTy :: Type -> Coercion -> Type -- for which it's plain stupid to create a cast -- This simple function killed off a huge number of Refl casts -- in types, at birth. +-- Note that it's fine to do this even for a "mkNaked" function, +-- because we don't look at TyCons. isReflCo checks if the coercion +-- is structurally Refl; it does not check for shape k ~ k. mkNakedCastTy ty co | isReflCo co = ty mkNakedCastTy (CastTy ty co1) co2 = CastTy ty (co1 `mkTransCo` co2) mkNakedCastTy ty co = CastTy ty co diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 70d8bba..7df02b6 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -1829,9 +1829,11 @@ extendTvSubst (TCvSubst in_scope tenv cenv) tv ty extendTvSubstWithClone :: TCvSubst -> TyVar -> TyVar -> TCvSubst -- Adds a new tv -> tv mapping, /and/ extends the in-scope set extendTvSubstWithClone (TCvSubst in_scope tenv cenv) tv tv' - = TCvSubst (extendInScopeSet in_scope tv') + = TCvSubst (extendInScopeSetSet in_scope new_in_scope) (extendVarEnv tenv tv (mkTyVarTy tv')) cenv + where + new_in_scope = tyCoVarsOfType (tyVarKind tv') `extendVarSet` tv' extendCvSubst :: TCvSubst -> CoVar -> Coercion -> TCvSubst extendCvSubst (TCvSubst in_scope tenv cenv) v co @@ -1839,9 +1841,11 @@ extendCvSubst (TCvSubst in_scope tenv cenv) v co extendCvSubstWithClone :: TCvSubst -> CoVar -> CoVar -> TCvSubst extendCvSubstWithClone (TCvSubst in_scope tenv cenv) cv cv' - = TCvSubst (extendInScopeSet in_scope cv') + = TCvSubst (extendInScopeSetSet in_scope new_in_scope) tenv (extendVarEnv cenv cv (mkCoVarCo cv')) + where + new_in_scope = tyCoVarsOfType (varType cv') `extendVarSet` cv' extendTvSubstAndInScope :: TCvSubst -> TyVar -> Type -> TCvSubst -- Also extends the in-scope set From git at git.haskell.org Mon Jun 13 09:54:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 09:54:11 +0000 (UTC) Subject: [commit: ghc] master: Beef up isPredTy (599d912) Message-ID: <20160613095411.DE6113A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/599d912f0b85583e389661d85ed2f198e2621bb0/ghc >--------------------------------------------------------------- commit 599d912f0b85583e389661d85ed2f198e2621bb0 Author: Simon Peyton Jones Date: Sun Jun 12 00:06:31 2016 +0100 Beef up isPredTy isPredTy can be called on ill-kinded types, especially (of course) if there is a kind error. We don't wnat it to crash, but it was, in piResultTy. This patch introduces piResultTy_maybe, and uses it in isPredTy. Ugh. I dislike this code. It's mainly used to know when we should print types with '=>', and we should probably have a better way to signal that. >--------------------------------------------------------------- 599d912f0b85583e389661d85ed2f198e2621bb0 compiler/types/Type.hs | 29 ++++++++++++++++++++++------- 1 file changed, 22 insertions(+), 7 deletions(-) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 724a9a4..181f8e5 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -820,22 +820,28 @@ funArgTy ty | Just ty' <- coreView ty = funArgTy ty' funArgTy (ForAllTy (Anon arg) _res) = arg funArgTy ty = pprPanic "funArgTy" (ppr ty) -piResultTy :: Type -> Type -> Type +piResultTy :: Type -> Type -> Type +piResultTy ty arg = case piResultTy_maybe ty arg of + Just res -> res + Nothing -> pprPanic "piResultTy" (ppr ty $$ ppr arg) + +piResultTy_maybe :: Type -> Type -> Maybe Type + -- ^ Just like 'piResultTys' but for a single argument -- Try not to iterate 'piResultTy', because it's inefficient to substitute -- one variable at a time; instead use 'piResultTys" -piResultTy ty arg - | Just ty' <- coreView ty = piResultTy ty' arg +piResultTy_maybe ty arg + | Just ty' <- coreView ty = piResultTy_maybe ty' arg | ForAllTy bndr res <- ty = case bndr of - Anon {} -> res - Named tv _ -> substTy (extendTvSubst empty_subst tv arg) res + Anon {} -> Just res + Named tv _ -> Just (substTy (extendTvSubst empty_subst tv arg) res) where empty_subst = mkEmptyTCvSubst $ mkInScopeSet $ tyCoVarsOfTypes [arg,res] | otherwise - = pprPanic "piResultTy" (ppr ty $$ ppr arg) + = Nothing -- | (piResultTys f_ty [ty1, .., tyn]) gives the type of (f ty1 .. tyn) -- where f :: f_ty @@ -1474,6 +1480,7 @@ isPredTy ty = go ty [] | isPredTy arg = isPredTy res -- (Eq a => C a) | otherwise = False -- (Int -> Bool) go (ForAllTy (Named {}) ty) [] = go ty [] + go (CastTy _ co) args = go_k (pSnd (coercionKind co)) args go _ _ = False go_tc :: TyCon -> [KindOrType] -> Bool @@ -1486,7 +1493,15 @@ isPredTy ty = go ty [] go_k :: Kind -> [KindOrType] -> Bool -- True <=> ('k' applied to 'kts') = Constraint - go_k k args = isConstraintKind (piResultTys k args) + go_k k [] = isConstraintKind k + go_k k (arg:args) = case piResultTy_maybe k arg of + Just k' -> go_k k' args + Nothing -> pprTrace "isPredTy" (ppr ty) + False + -- This last case should not happen; but it does if we + -- we call isPredTy during kind checking, especially if + -- there is actually a kind error. Example that showed + -- this up: polykinds/T11399 isClassPred, isEqPred, isNomEqPred, isIPPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of From git at git.haskell.org Mon Jun 13 09:54:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 09:54:14 +0000 (UTC) Subject: [commit: ghc] master: Remove some traceTc calls (8104f7c) Message-ID: <20160613095414.835D73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8104f7c674d7ef2db0c25312f48763202dcef57f/ghc >--------------------------------------------------------------- commit 8104f7c674d7ef2db0c25312f48763202dcef57f Author: Simon Peyton Jones Date: Sun Jun 12 22:01:49 2016 +0100 Remove some traceTc calls During the kind-checking "knot" we have to be careful not to print too eagerly. >--------------------------------------------------------------- 8104f7c674d7ef2db0c25312f48763202dcef57f compiler/typecheck/TcHsType.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 5492a8a..7fb77e6 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -769,10 +769,7 @@ tc_infer_args :: Outputable fun -> Int -- ^ number to start arg counter at -> TcM (TCvSubst, [TyBinder], [TcType], [LHsType Name], Int) tc_infer_args mode orig_ty binders mb_kind_info orig_args n0 - = do { traceTc "tc_infer_args {" (ppr binders $$ ppr orig_args) - ; stuff <- go emptyTCvSubst binders orig_args n0 [] - ; traceTc "tc_infer_args }" (ppr stuff) - ; return stuff } + = go emptyTCvSubst binders orig_args n0 [] where go subst binders [] n acc = return ( subst, binders, reverse acc, [], n ) From git at git.haskell.org Mon Jun 13 09:54:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 09:54:17 +0000 (UTC) Subject: [commit: ghc] master: Add to .gitignore (e064f50) Message-ID: <20160613095417.274103A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e064f501d76c208ddab3c3be551ffe5167d7974f/ghc >--------------------------------------------------------------- commit e064f501d76c208ddab3c3be551ffe5167d7974f Author: Simon Peyton Jones Date: Sun Jun 12 22:32:31 2016 +0100 Add to .gitignore This adds *.patch *.stackdump (Windows) foo* (simonpj uses foo* for junk files) >--------------------------------------------------------------- e064f501d76c208ddab3c3be551ffe5167d7974f .gitignore | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.gitignore b/.gitignore index cd556d5..1ca350b 100644 --- a/.gitignore +++ b/.gitignore @@ -12,6 +12,9 @@ Thumbs.db *.orig *.prof *.rej +*.patch +*.stackdump +foo* *.hi *.hi-boot From git at git.haskell.org Mon Jun 13 10:53:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 10:53:07 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #12055 (921ebc9) Message-ID: <20160613105307.65FCC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/921ebc9f0854d033cbafd43d3b2c5ba679c27b3c/ghc >--------------------------------------------------------------- commit 921ebc9f0854d033cbafd43d3b2c5ba679c27b3c Author: Simon Peyton Jones Date: Mon Jun 13 11:56:44 2016 +0100 Test Trac #12055 >--------------------------------------------------------------- 921ebc9f0854d033cbafd43d3b2c5ba679c27b3c testsuite/tests/polykinds/T12055.hs | 45 +++++++++++++++++++++++++++++++++++++ testsuite/tests/polykinds/all.T | 1 + 2 files changed, 46 insertions(+) diff --git a/testsuite/tests/polykinds/T12055.hs b/testsuite/tests/polykinds/T12055.hs new file mode 100644 index 0000000..3ffc221 --- /dev/null +++ b/testsuite/tests/polykinds/T12055.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeInType #-} + +-- The code from the ticket lacked these extensions, +-- but crashed the compiler with "GHC internal error" +-- It doesn't crash now; and in this test case I've added +-- the extensions, which makes it compile cleanly +{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances, FunctionalDependencies #-} + + +module T12055 where + +import GHC.Base ( Constraint, Type ) +import GHC.Exts ( type (~~) ) + +type Cat k = k -> k -> Type + +class Category (p :: Cat k) where + type Ob p :: k -> Constraint + +class (Category (Dom f), Category (Cod f)) => Functor (f :: j -> k) where + type Dom f :: Cat j + type Cod f :: Cat k + functor :: forall a b. + Iso Constraint (:-) (:-) + (Ob (Dom f) a) (Ob (Dom f) b) + (Ob (Cod f) (f a)) (Ob (Cod f) (f b)) + +class (Functor f , Dom f ~ p, Cod f ~ q) => + Fun (p :: Cat j) (q :: Cat k) (f :: j -> k) | f -> p q +instance (Functor f , Dom f ~ p, Cod f ~ q) => + Fun (p :: Cat j) (q :: Cat k) (f :: j -> k) + +data Nat (p :: Cat j) (q :: Cat k) (f :: j -> k) (g :: j -> k) + +type Iso k (c :: Cat k) (d :: Cat k) s t a b = + forall p. (Cod p ~~ Nat d (->)) => p a b -> p s t + +data (p :: Constraint) :- (q :: Constraint) diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 2c3d1df..c731441 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -148,3 +148,4 @@ test('T11648b', normal, compile_fail, ['']) test('KindVType', normal, compile_fail, ['']) test('T11821', normal, compile, ['']) test('T11640', normal, compile, ['']) +test('T12055', normal, compile, ['']) From git at git.haskell.org Mon Jun 13 11:00:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 11:00:17 +0000 (UTC) Subject: [commit: ghc] master: A second test for Trac #12055 (1dcb32d) Message-ID: <20160613110017.AC85D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1dcb32ddba605bced2e0e0ce3f52b58e8ff33f5b/ghc >--------------------------------------------------------------- commit 1dcb32ddba605bced2e0e0ce3f52b58e8ff33f5b Author: Simon Peyton Jones Date: Mon Jun 13 12:02:54 2016 +0100 A second test for Trac #12055 This one omits the extension, thereby making GHC 8.0 produce "GHC internal error". >--------------------------------------------------------------- 1dcb32ddba605bced2e0e0ce3f52b58e8ff33f5b testsuite/tests/polykinds/{T12055.hs => T12055a.hs} | 12 ++++++------ testsuite/tests/polykinds/T12055a.stderr | 7 +++++++ testsuite/tests/polykinds/all.T | 1 + 3 files changed, 14 insertions(+), 6 deletions(-) diff --git a/testsuite/tests/polykinds/T12055.hs b/testsuite/tests/polykinds/T12055a.hs similarity index 77% copy from testsuite/tests/polykinds/T12055.hs copy to testsuite/tests/polykinds/T12055a.hs index 3ffc221..dab5238 100644 --- a/testsuite/tests/polykinds/T12055.hs +++ b/testsuite/tests/polykinds/T12055a.hs @@ -7,14 +7,14 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeInType #-} --- The code from the ticket lacked these extensions, --- but crashed the compiler with "GHC internal error" --- It doesn't crash now; and in this test case I've added --- the extensions, which makes it compile cleanly -{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances, FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances, UndecidableInstances, FunctionalDependencies #-} +-- The code from the ticket lacked necessary extension FlexibleContexts +-- which crashed the compiler with "GHC internal error" +-- This test case reproduces that scenario +{- # LANGUAGE FlexibleContexts #-} -module T12055 where +module T12055a where import GHC.Base ( Constraint, Type ) import GHC.Exts ( type (~~) ) diff --git a/testsuite/tests/polykinds/T12055a.stderr b/testsuite/tests/polykinds/T12055a.stderr new file mode 100644 index 0000000..fb76dd4 --- /dev/null +++ b/testsuite/tests/polykinds/T12055a.stderr @@ -0,0 +1,7 @@ + +T12055a.hs:27:1: error: + ? Non type-variable argument in the constraint: Category (Dom f) + (Use FlexibleContexts to permit this) + ? In the context: (Category (Dom f), Category (Cod f)) + While checking the super-classes of class ?Functor? + In the class declaration for ?Functor? diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index c731441..bcc8dc4 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -149,3 +149,4 @@ test('KindVType', normal, compile_fail, ['']) test('T11821', normal, compile, ['']) test('T11640', normal, compile, ['']) test('T12055', normal, compile, ['']) +test('T12055a', normal, compile_fail, ['']) From git at git.haskell.org Mon Jun 13 11:31:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 11:31:42 +0000 (UTC) Subject: [commit: ghc] master: Add thin library support to Windows too (5cee88d) Message-ID: <20160613113142.DCF413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5cee88d766723929f789ffcd2ef24d8b5ef62a16/ghc >--------------------------------------------------------------- commit 5cee88d766723929f789ffcd2ef24d8b5ef62a16 Author: Tamar Christina Date: Mon Jun 13 13:29:17 2016 +0200 Add thin library support to Windows too Summary: Code already existed in the RTS to add thin library support for non-Windows operating systems. This adds it to Windows as well. ar thin libraries have the exact same format as normal archives except they have a different magic string and they don't copy the object files into the archive. Instead each header entry points to the location of the object file on disk. This is useful when a library is only created to satisfy a compile time dependency instead of to be distributed. This saves the time required for copying. Test Plan: ./validate and new test T11788 Reviewers: austin, bgamari, simonmar, erikd Reviewed By: bgamari, simonmar Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2323 GHC Trac Issues: #11788 >--------------------------------------------------------------- 5cee88d766723929f789ffcd2ef24d8b5ef62a16 rts/Linker.c | 151 ++++++++++++--------- testsuite/tests/rts/Makefile | 6 + testsuite/tests/rts/{T11223/foo.c => T11788.c} | 0 testsuite/tests/rts/{T11223/foo.hs => T11788.hs} | 0 .../T11223_simple_link.stdout => T11788.stdout} | 0 testsuite/tests/rts/all.T | 3 + 6 files changed, 99 insertions(+), 61 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5cee88d766723929f789ffcd2ef24d8b5ef62a16 From git at git.haskell.org Mon Jun 13 11:53:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 11:53:20 +0000 (UTC) Subject: [commit: ghc] master: Kill unused foldModuleEnv (7de776c) Message-ID: <20160613115320.AAB303A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7de776cfe7825fca6a71fe6b3854c3c86bf9ca12/ghc >--------------------------------------------------------------- commit 7de776cfe7825fca6a71fe6b3854c3c86bf9ca12 Author: Bartosz Nitka Date: Mon Jun 13 04:53:43 2016 -0700 Kill unused foldModuleEnv With the current implementation, it's nondeterministic because Ord Module is nondeterministic. >--------------------------------------------------------------- 7de776cfe7825fca6a71fe6b3854c3c86bf9ca12 compiler/basicTypes/Module.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs index a80df19..74b15bc 100644 --- a/compiler/basicTypes/Module.hs +++ b/compiler/basicTypes/Module.hs @@ -69,7 +69,7 @@ module Module lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv, moduleEnvKeys, moduleEnvElts, moduleEnvToList, unitModuleEnv, isEmptyModuleEnv, - foldModuleEnv, extendModuleEnvWith, filterModuleEnv, + extendModuleEnvWith, filterModuleEnv, -- * ModuleName mappings ModuleNameEnv, DModuleNameEnv, @@ -578,9 +578,6 @@ unitModuleEnv m x = ModuleEnv (Map.singleton m x) isEmptyModuleEnv :: ModuleEnv a -> Bool isEmptyModuleEnv (ModuleEnv e) = Map.null e -foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b -foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e - -- | A set of 'Module's type ModuleSet = Set Module From git at git.haskell.org Mon Jun 13 18:31:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 18:31:42 +0000 (UTC) Subject: [commit: ghc] master: Use UniqFM for SigOf (586d558) Message-ID: <20160613183142.9FE483A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/586d55815401c54f4687d053fb033e53865e0bf1/ghc >--------------------------------------------------------------- commit 586d55815401c54f4687d053fb033e53865e0bf1 Author: Bartosz Nitka Date: Mon Jun 13 07:35:32 2016 -0700 Use UniqFM for SigOf Summary: The Ord instance for ModuleName is currently implemented in terms of Uniques causing potential determinism problems. I plan to change it to use the actual FastStrings and in preparation for that I'm switching to UniqFM where it's possible (you need *one* Unique per key, and you can't get the keys back), so that the performance doesn't suffer. Test Plan: ./validate Reviewers: simonmar, austin, ezyang, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2320 GHC Trac Issues: #4012 >--------------------------------------------------------------- 586d55815401c54f4687d053fb033e53865e0bf1 compiler/main/DynFlags.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 5515b8c..ffb5b33 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -164,6 +164,7 @@ import CmdLineParser import Constants import Panic import Util +import UniqFM import Maybes import MonadUtils import qualified Pretty @@ -633,10 +634,10 @@ instance Show SafeHaskellMode where instance Outputable SafeHaskellMode where ppr = text . show -type SigOf = Map ModuleName Module +type SigOf = ModuleNameEnv Module getSigOf :: DynFlags -> ModuleName -> Maybe Module -getSigOf dflags n = Map.lookup n (sigOf dflags) +getSigOf dflags n = lookupUFM (sigOf dflags) n -- | Contains not only a collection of 'GeneralFlag's but also a plethora of -- information relating to the compilation of a single file or GHC session @@ -1442,7 +1443,7 @@ defaultDynFlags mySettings = ghcMode = CompManager, ghcLink = LinkBinary, hscTarget = defaultHscTarget (sTargetPlatform mySettings), - sigOf = Map.empty, + sigOf = emptyUFM, verbosity = 0, optLevel = 0, debugLevel = 0, @@ -1991,7 +1992,7 @@ parseSigOf :: String -> SigOf parseSigOf str = case filter ((=="").snd) (readP_to_S parse str) of [(r, "")] -> r _ -> throwGhcException $ CmdLineError ("Can't parse -sig-of: " ++ str) - where parse = Map.fromList <$> sepBy parseEntry (R.char ',') + where parse = listToUFM <$> sepBy parseEntry (R.char ',') parseEntry = do n <- tok $ parseModuleName -- ToDo: deprecate this 'is' syntax? From git at git.haskell.org Mon Jun 13 18:31:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 18:31:45 +0000 (UTC) Subject: [commit: ghc] master: Make the Ord Module independent of Unique order (0497ee5) Message-ID: <20160613183145.4C0F63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0497ee504cc9ac5d6babee9b98bf779b3fc50b98/ghc >--------------------------------------------------------------- commit 0497ee504cc9ac5d6babee9b98bf779b3fc50b98 Author: Bartosz Nitka Date: Thu Jun 9 08:50:32 2016 -0700 Make the Ord Module independent of Unique order The `Ord Module` instance currently uses `Unique`s for comparison. We don't want to use the `Unique` order because it can introduce nondeterminism. This switches `Ord ModuleName` and `Ord UnitId` to use lexicographic ordering making `Ord Module` deterministic transitively. I've run `nofib` and it doesn't make a measurable difference. See also Note [ModuleEnv determinism and performance]. Test Plan: ./validate run nofib: P112 Reviewers: simonpj, simonmar, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2030 GHC Trac Issues: #4012 >--------------------------------------------------------------- 0497ee504cc9ac5d6babee9b98bf779b3fc50b98 compiler/basicTypes/Module.hs | 84 +++++++++++++++------- testsuite/tests/driver/sigof01/all.T | 2 +- .../should_fail/overloadedrecfldsfail10.stderr | 4 +- testsuite/tests/rename/should_fail/T11071.stderr | 2 +- testsuite/tests/rename/should_fail/T11071a.stderr | 32 ++++----- .../tests/typecheck/should_fail/T6018fail.stderr | 4 +- testsuite/tests/typecheck/should_run/T7861.stderr | 22 +++--- 7 files changed, 92 insertions(+), 58 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 0497ee504cc9ac5d6babee9b98bf779b3fc50b98 From git at git.haskell.org Mon Jun 13 22:49:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Jun 2016 22:49:20 +0000 (UTC) Subject: [commit: ghc] master: Update Haddock to follow change in LHsSigWcType (d55a9b4) Message-ID: <20160613224920.867A03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d55a9b4fd5a3ce24b13311962bca66155b17a558/ghc >--------------------------------------------------------------- commit d55a9b4fd5a3ce24b13311962bca66155b17a558 Author: Simon Peyton Jones Date: Mon Jun 13 18:28:30 2016 +0100 Update Haddock to follow change in LHsSigWcType Update submodule to accompany this commit: commit 15b9bf4ba4ab47e6809bf2b3b36ec16e502aea72 Author: Simon Peyton Jones Date: Sat Jun 11 23:49:27 2016 +0100 Improve typechecking of let-bindings Sorry it's late! >--------------------------------------------------------------- d55a9b4fd5a3ce24b13311962bca66155b17a558 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 8d47c8b..09054c2 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 8d47c8b733a0b9406d99a97c7eaeba3d6b51ec7c +Subproject commit 09054c2c6ac346b19d0dec9a43956fcea1c272fb From git at git.haskell.org Tue Jun 14 06:53:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Jun 2016 06:53:09 +0000 (UTC) Subject: [commit: ghc] master: Adjust error message slightly (4f35646) Message-ID: <20160614065309.9129B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4f356466b733e51e72c92df4c7fce6b967e4ea5e/ghc >--------------------------------------------------------------- commit 4f356466b733e51e72c92df4c7fce6b967e4ea5e Author: Simon Peyton Jones Date: Tue Jun 14 07:55:01 2016 +0100 Adjust error message slightly >--------------------------------------------------------------- 4f356466b733e51e72c92df4c7fce6b967e4ea5e compiler/typecheck/TcBinds.hs | 4 ++-- testsuite/tests/typecheck/should_compile/T11339.stderr | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 10d5901..4517b73 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -955,7 +955,7 @@ checkOverloadedSig monomorphism_restriction_applies sig , let orig_sig = sig_inst_sig sig = setSrcSpan (sig_loc orig_sig) $ failWith $ - hang (text "Illegal overloaded signature conflicts with monomorphism restriction") + hang (text "Overloaded signature conflicts with monomorphism restriction") 2 (ppr orig_sig) | otherwise = return () @@ -1484,7 +1484,7 @@ For (2) it would look like in We typecheck pattern bindings as follows: - 1. In tcLhs we bind q'::alpha, for each varibable q bound by the + 1. In tcLhs we bind q'::alpha, for each variable q bound by the pattern, where q' is a fresh name, and alpha is a fresh unification variable; it will be the monomorphic verion of q that we later generalise diff --git a/testsuite/tests/typecheck/should_compile/T11339.stderr b/testsuite/tests/typecheck/should_compile/T11339.stderr index 9e8a8ec..b43c45f 100644 --- a/testsuite/tests/typecheck/should_compile/T11339.stderr +++ b/testsuite/tests/typecheck/should_compile/T11339.stderr @@ -1,6 +1,6 @@ T11339.hs:15:5: error: - ? Illegal overloaded signature conflicts with monomorphism restriction + ? Overloaded signature conflicts with monomorphism restriction t :: forall (f :: * -> *). Applicative f => (a -> f b) -> f t ? In an equation for ?failing?: failing left right afb s From git at git.haskell.org Tue Jun 14 15:20:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Jun 2016 15:20:18 +0000 (UTC) Subject: [commit: ghc] master: Build system: mention ghc version in bindist's `configure --help` docdir (8dfd4ae) Message-ID: <20160614152018.B944B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8dfd4aeb1cd0929d4733df4bd7baf3f02e44236c/ghc >--------------------------------------------------------------- commit 8dfd4aeb1cd0929d4733df4bd7baf3f02e44236c Author: Thomas Miedema Date: Tue Jun 14 12:32:37 2016 +0200 Build system: mention ghc version in bindist's `configure --help` docdir This is a follow up to a74a3846c84ad55de3deeed8b2401a2ed514b2e1 , which made the same change but for the toplevel configure.ac. Reviewed by: erikd Differential Revision: https://phabricator.haskell.org/D2330 GHC Trac Issues: #11659 >--------------------------------------------------------------- 8dfd4aeb1cd0929d4733df4bd7baf3f02e44236c distrib/configure.ac.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in index 33023a7..19ea5f0 100644 --- a/distrib/configure.ac.in +++ b/distrib/configure.ac.in @@ -4,7 +4,7 @@ dnl #!/bin/sh # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [@ProjectVersion@], [glasgow-haskell-bugs at haskell.org], [ghc]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [@ProjectVersion@], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) dnl-------------------------------------------------------------------- dnl * Deal with arguments telling us gmp is somewhere odd From git at git.haskell.org Tue Jun 14 15:20:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Jun 2016 15:20:21 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: enable ghci.prog010 (#2542) (a2deee0) Message-ID: <20160614152021.CE80A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a2deee068caa5b774adc62db4077e22fa0173ddc/ghc >--------------------------------------------------------------- commit a2deee068caa5b774adc62db4077e22fa0173ddc Author: Thomas Miedema Date: Mon Jun 13 14:48:24 2016 +0200 Testsuite: enable ghci.prog010 (#2542) This test didn't have a `.T` file, so the testsuite driver never ran it. Luckily the features it tested for didn't break in the past 8 years. >--------------------------------------------------------------- a2deee068caa5b774adc62db4077e22fa0173ddc .../tests/{annotations/should_compile => ghci/prog010}/Makefile | 0 testsuite/tests/ghci/prog010/all.T | 4 ++++ testsuite/tests/ghci/prog010/ghci.prog010.script | 7 +++++-- testsuite/tests/ghci/prog010/ghci.prog010.stderr | 4 +++- testsuite/tests/ghci/prog010/ghci.prog010.stdout | 2 -- 5 files changed, 12 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/annotations/should_compile/Makefile b/testsuite/tests/ghci/prog010/Makefile similarity index 100% copy from testsuite/tests/annotations/should_compile/Makefile copy to testsuite/tests/ghci/prog010/Makefile diff --git a/testsuite/tests/ghci/prog010/all.T b/testsuite/tests/ghci/prog010/all.T new file mode 100644 index 0000000..d30de29 --- /dev/null +++ b/testsuite/tests/ghci/prog010/all.T @@ -0,0 +1,4 @@ +test('ghci.prog010', + [cmd_prefix('ghciWayFlags=' + config.ghci_way_flags), + extra_files(['../shell.hs', 'A.hs', 'B.hs'])], + ghci_script, ['ghci.prog010.script']) diff --git a/testsuite/tests/ghci/prog010/ghci.prog010.script b/testsuite/tests/ghci/prog010/ghci.prog010.script index 563e471..f86829b 100644 --- a/testsuite/tests/ghci/prog010/ghci.prog010.script +++ b/testsuite/tests/ghci/prog010/ghci.prog010.script @@ -10,7 +10,7 @@ :type f :type g -:shell $HC $HC_OPTS -fforce-recomp -c A.hs +:shell "$HC" $HC_OPTS $ghciWayFlags -fforce-recomp -c A.hs :load A -- we can now see only f @@ -24,9 +24,12 @@ :type f :type g -:shell $HC $HC_OPTS -fforce-recomp -c B.hs +:shell "$HC" $HC_OPTS $ghciWayFlags -fforce-recomp -c B.hs :load B + +-- this will tell us we need to load A interpreted :module *A + :add *A :module *A :type f diff --git a/testsuite/tests/ghci/prog010/ghci.prog010.stderr b/testsuite/tests/ghci/prog010/ghci.prog010.stderr index c7cbb11..75c4fb4 100644 --- a/testsuite/tests/ghci/prog010/ghci.prog010.stderr +++ b/testsuite/tests/ghci/prog010/ghci.prog010.stderr @@ -1,2 +1,4 @@ -:1:0: Not in scope: `g' +:1:1: error: Variable not in scope: g +module 'A' is not interpreted; try ':add *A' first +module 'A' is not interpreted; try ':add *A' first diff --git a/testsuite/tests/ghci/prog010/ghci.prog010.stdout b/testsuite/tests/ghci/prog010/ghci.prog010.stdout index ccb6dcd..0cc49e2 100644 --- a/testsuite/tests/ghci/prog010/ghci.prog010.stdout +++ b/testsuite/tests/ghci/prog010/ghci.prog010.stdout @@ -1,9 +1,7 @@ f :: t -> [t] g :: a -> Maybe a f :: t -> [t] -module 'A' is not interpreted; try ':add *A' first f :: t -> [t] g :: a -> Maybe a -module 'A' is not interpreted; try ':add *A' first f :: t -> [t] g :: a -> Maybe a From git at git.haskell.org Tue Jun 14 15:21:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Jun 2016 15:21:14 +0000 (UTC) Subject: [commit: ghc] master: Don't GC sparks for CAFs (23b73c9) Message-ID: <20160614152114.E989E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23b73c97312e4d812812ed25a6396fff44d1da28/ghc >--------------------------------------------------------------- commit 23b73c97312e4d812812ed25a6396fff44d1da28 Author: Simon Marlow Date: Fri Jun 10 17:07:13 2016 +0100 Don't GC sparks for CAFs We can't tell whether the CAF is actually garbage or not. >--------------------------------------------------------------- 23b73c97312e4d812812ed25a6396fff44d1da28 rts/Sparks.c | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/rts/Sparks.c b/rts/Sparks.c index e0b2e66..ecd3c38 100644 --- a/rts/Sparks.c +++ b/rts/Sparks.c @@ -211,15 +211,12 @@ pruneSparkQueue (Capability *cap) } } else { if (INFO_PTR_TO_STRUCT(info)->type == THUNK_STATIC) { - if (*THUNK_STATIC_LINK(spark) != NULL) { - elements[botInd] = spark; // keep entry (new address) - botInd++; - n++; - } else { - pruned_sparks++; // discard spark - cap->spark_stats.gcd++; - traceEventSparkGC(cap); - } + // We can't tell whether a THUNK_STATIC is garbage or not. + // See also Note [STATIC_LINK fields] + // isAlive() also ignores static closures (see GCAux.c) + elements[botInd] = spark; // keep entry (new address) + botInd++; + n++; } else { pruned_sparks++; // discard spark cap->spark_stats.fizzled++; From git at git.haskell.org Tue Jun 14 15:58:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Jun 2016 15:58:03 +0000 (UTC) Subject: [commit: ghc] master: Rename cmpType to nonDetCmpType (9d22fbe) Message-ID: <20160614155803.E19873A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9d22fbe2d3d8c4609919040007ea8bb561bf9a38/ghc >--------------------------------------------------------------- commit 9d22fbe2d3d8c4609919040007ea8bb561bf9a38 Author: Bartosz Nitka Date: Tue Jun 14 08:59:07 2016 -0700 Rename cmpType to nonDetCmpType This makes it obvious that it's nondeterministic and hopefully will prevent someone from using it accidentally. GHC Trac: #4012 >--------------------------------------------------------------- 9d22fbe2d3d8c4609919040007ea8bb561bf9a38 compiler/specialise/Specialise.hs | 4 +-- compiler/typecheck/TcDeriv.hs | 8 ++--- compiler/typecheck/TcType.hs | 2 +- compiler/typecheck/TcValidity.hs | 4 ++- compiler/types/Type.hs | 62 ++++++++++++++++++++++----------------- 5 files changed, 45 insertions(+), 35 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9d22fbe2d3d8c4609919040007ea8bb561bf9a38 From git at git.haskell.org Tue Jun 14 16:06:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Jun 2016 16:06:26 +0000 (UTC) Subject: [commit: ghc] master: Simplify readProcessEnvWithExitCode + set LANGUAGE=C (753c5b2) Message-ID: <20160614160626.0485A3A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/753c5b24304fa1dd1af774be268794baef820f75/ghc >--------------------------------------------------------------- commit 753c5b24304fa1dd1af774be268794baef820f75 Author: Thomas Miedema Date: Sat Jun 11 10:43:59 2016 +0200 Simplify readProcessEnvWithExitCode + set LANGUAGE=C `readProcessEnvWithExitCode` was added in 4d4d07704ee78221607a18b8118294b0aea1bac4, to start an external process after making some modifications to the environment. Since then, the `process` library has exposed `readCreateProcessWithExitCode`, which allows for the refactoring we do here. Also change "en" to "C", as suggested in ticket:8825#comment:11. Reviewed by: trofi Differential Revision: https://phabricator.haskell.org/D2332 GHC Trac Issues: #8825 >--------------------------------------------------------------- 753c5b24304fa1dd1af774be268794baef820f75 compiler/main/SysTools.hs | 52 ++++++++++++----------------------------------- 1 file changed, 13 insertions(+), 39 deletions(-) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 9423b00..c86935e 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -509,51 +509,25 @@ readCreateProcessWithExitCode' proc = do return (ex, output) +replaceVar :: (String, String) -> [(String, String)] -> [(String, String)] +replaceVar (var, value) env = + (var, value) : filter (\(var',_) -> var /= var') env + +-- | Version of @System.Process.readProcessWithExitCode@ that takes a +-- key-value tuple to insert into the environment. readProcessEnvWithExitCode :: String -- ^ program path -> [String] -- ^ program args - -> [(String, String)] -- ^ environment to override + -> (String, String) -- ^ addition to the environment -> IO (ExitCode, String, String) -- ^ (exit_code, stdout, stderr) readProcessEnvWithExitCode prog args env_update = do current_env <- getEnvironment - let new_env = env_update ++ [ (k, v) - | let overriden_keys = map fst env_update - , (k, v) <- current_env - , k `notElem` overriden_keys - ] - p = proc prog args - - (_stdin, Just stdoh, Just stdeh, pid) <- - createProcess p{ std_out = CreatePipe - , std_err = CreatePipe - , env = Just new_env - } - - outMVar <- newEmptyMVar - errMVar <- newEmptyMVar - - _ <- forkIO $ do - stdo <- hGetContents stdoh - _ <- evaluate (length stdo) - putMVar outMVar stdo - - _ <- forkIO $ do - stde <- hGetContents stdeh - _ <- evaluate (length stde) - putMVar errMVar stde - - out <- takeMVar outMVar - hClose stdoh - err <- takeMVar errMVar - hClose stdeh - - ex <- waitForProcess pid - - return (ex, out, err) + readCreateProcessWithExitCode (proc prog args) { + env = Just (replaceVar env_update current_env) } "" -- Don't let gcc localize version info string, #8825 -en_locale_env :: [(String, String)] -en_locale_env = [("LANGUAGE", "en")] +c_locale_env :: (String, String) +c_locale_env = ("LANGUAGE", "C") -- If the -B option is set, add to PATH. This works around -- a bug in gcc on Windows Vista where it can't find its auxiliary @@ -864,7 +838,7 @@ getLinkerInfo' dflags = do -- -Wl,--version to get linker version info. (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm (["-Wl,--version"] ++ args3) - en_locale_env + c_locale_env -- Split the output by lines to make certain kinds -- of processing easier. In particular, 'clang' and 'gcc' -- have slightly different outputs for '-Wl,--version', but @@ -920,7 +894,7 @@ getCompilerInfo' dflags = do -- Process the executable call info <- catchIO (do (exitc, stdo, stde) <- - readProcessEnvWithExitCode pgm ["-v"] en_locale_env + readProcessEnvWithExitCode pgm ["-v"] c_locale_env -- Split the output by lines to make certain kinds -- of processing easier. parseCompilerInfo (lines stdo) (lines stde) exitc From git at git.haskell.org Wed Jun 15 11:27:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Jun 2016 11:27:15 +0000 (UTC) Subject: [commit: ghc] master: Revert "Make the Ord Module independent of Unique order" (70a4589) Message-ID: <20160615112715.5FCC43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/70a458938c36849f78c6efc65a088289ebc4e293/ghc >--------------------------------------------------------------- commit 70a458938c36849f78c6efc65a088289ebc4e293 Author: Simon Peyton Jones Date: Wed Jun 15 08:44:11 2016 +0100 Revert "Make the Ord Module independent of Unique order" This reverts commit 0497ee504cc9ac5d6babee9b98bf779b3fc50b98. Reason: See Trac #12191. I'm reverting pending Bartosz's investigation of what went wrong. >--------------------------------------------------------------- 70a458938c36849f78c6efc65a088289ebc4e293 compiler/basicTypes/Module.hs | 84 +++++++--------------- testsuite/tests/driver/sigof01/all.T | 2 +- .../should_fail/overloadedrecfldsfail10.stderr | 4 +- testsuite/tests/rename/should_fail/T11071.stderr | 2 +- testsuite/tests/rename/should_fail/T11071a.stderr | 32 ++++----- .../tests/typecheck/should_fail/T6018fail.stderr | 4 +- testsuite/tests/typecheck/should_run/T7861.stderr | 22 +++--- 7 files changed, 58 insertions(+), 92 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 70a458938c36849f78c6efc65a088289ebc4e293 From git at git.haskell.org Wed Jun 15 12:30:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Jun 2016 12:30:39 +0000 (UTC) Subject: [commit: ghc] master: Fix testsuite wibble (e33ca0e) Message-ID: <20160615123039.EC79C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e33ca0e54f3c20a8b233a3f7b38e4968a4955300/ghc >--------------------------------------------------------------- commit e33ca0e54f3c20a8b233a3f7b38e4968a4955300 Author: Simon Peyton Jones Date: Wed Jun 15 13:33:57 2016 +0100 Fix testsuite wibble ..in typecheck/should_run/T7861 Was concealed behind the haddock perf noise >--------------------------------------------------------------- e33ca0e54f3c20a8b233a3f7b38e4968a4955300 testsuite/tests/typecheck/should_run/T7861.stderr | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/testsuite/tests/typecheck/should_run/T7861.stderr b/testsuite/tests/typecheck/should_run/T7861.stderr index e0aac9a..e9ee5e9 100644 --- a/testsuite/tests/typecheck/should_run/T7861.stderr +++ b/testsuite/tests/typecheck/should_run/T7861.stderr @@ -1,13 +1,13 @@ T7861: T7861.hs:10:5: error: - Couldn't match type ?a? with ?[a]? - ?a? is a rigid type variable bound by - the type signature for: - f :: forall a. (forall b. a) -> a - at T7861.hs:9:6 - Expected type: (forall b. a) -> a - Actual type: (forall b. a) -> [a] - In the expression: doA - In an equation for ?f?: f = doA - Relevant bindings include - f :: (forall b. a) -> a (bound at T7861.hs:10:1) + ? Couldn't match type ?a? with ?[a]? + ?a? is a rigid type variable bound by + the type signature for: + f :: forall a. (forall b. a) -> a + at T7861.hs:9:1-23 + Expected type: (forall b. a) -> a + Actual type: (forall b. a) -> [a] + ? In the expression: doA + In an equation for ?f?: f = doA + ? Relevant bindings include + f :: (forall b. a) -> a (bound at T7861.hs:10:1) (deferred type error) From git at git.haskell.org Wed Jun 15 16:32:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Jun 2016 16:32:29 +0000 (UTC) Subject: [commit: ghc] master: Re-add FunTy (big patch) (77bb092) Message-ID: <20160615163229.8E46F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/77bb09270c70455bbd547470c4e995707d19f37d/ghc >--------------------------------------------------------------- commit 77bb09270c70455bbd547470c4e995707d19f37d Author: Simon Peyton Jones Date: Fri May 27 15:26:46 2016 +0100 Re-add FunTy (big patch) With TypeInType Richard combined ForAllTy and FunTy, but that was often awkward, and yielded little benefit becuase in practice the two were always treated separately. This patch re-introduces FunTy. Specfically * New type data TyVarBinder = TvBndr TyVar VisibilityFlag This /always/ has a TyVar it. In many places that's just what what we want, so there are /lots/ of TyBinder -> TyVarBinder changes * TyBinder still exists: data TyBinder = Named TyVarBinder | Anon Type * data Type = ForAllTy TyVarBinder Type | FunTy Type Type | .... There are a LOT of knock-on changes, but they are all routine. The Haddock submodule needs to be updated too >--------------------------------------------------------------- 77bb09270c70455bbd547470c4e995707d19f37d compiler/basicTypes/DataCon.hs | 112 ++--- compiler/basicTypes/DataCon.hs-boot | 8 +- compiler/basicTypes/MkId.hs | 17 +- compiler/basicTypes/PatSyn.hs | 42 +- compiler/codeGen/StgCmmClosure.hs | 8 +- compiler/coreSyn/CoreArity.hs | 29 +- compiler/coreSyn/CoreFVs.hs | 6 +- compiler/coreSyn/CoreLint.hs | 21 +- compiler/coreSyn/CoreUtils.hs | 2 +- compiler/coreSyn/TrieMap.hs | 16 +- compiler/deSugar/DsBinds.hs | 2 +- compiler/deSugar/DsForeign.hs | 28 +- compiler/hsSyn/HsUtils.hs | 4 +- compiler/iface/BuildTyCl.hs | 60 ++- compiler/iface/IfaceSyn.hs | 4 +- compiler/iface/IfaceType.hs | 76 ++-- compiler/iface/MkIface.hs | 23 +- compiler/iface/TcIface.hs | 33 +- compiler/main/HscTypes.hs | 8 +- compiler/prelude/TysPrim.hs | 14 +- compiler/prelude/TysWiredIn.hs | 15 +- compiler/simplCore/SetLevels.hs | 4 +- compiler/simplCore/Simplify.hs | 8 +- compiler/specialise/SpecConstr.hs | 2 +- compiler/specialise/Specialise.hs | 2 +- compiler/typecheck/FamInst.hs | 4 +- compiler/typecheck/Inst.hs | 24 +- compiler/typecheck/TcArrows.hs | 2 +- compiler/typecheck/TcBinds.hs | 8 +- compiler/typecheck/TcCanonical.hs | 12 +- compiler/typecheck/TcDeriv.hs | 4 +- compiler/typecheck/TcErrors.hs | 20 +- compiler/typecheck/TcExpr.hs | 13 +- compiler/typecheck/TcFlatten.hs | 8 +- compiler/typecheck/TcForeign.hs | 8 +- compiler/typecheck/TcGenDeriv.hs | 11 +- compiler/typecheck/TcHsSyn.hs | 6 +- compiler/typecheck/TcHsType.hs | 41 +- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcInteract.hs | 4 +- compiler/typecheck/TcMType.hs | 6 +- compiler/typecheck/TcMatches.hs | 8 +- compiler/typecheck/TcPatSyn.hs | 74 ++- compiler/typecheck/TcRnDriver.hs | 15 +- compiler/typecheck/TcRnTypes.hs | 2 +- compiler/typecheck/TcSMonad.hs | 8 +- compiler/typecheck/TcSigs.hs | 4 +- compiler/typecheck/TcSplice.hs | 7 +- compiler/typecheck/TcTyClsDecls.hs | 21 +- compiler/typecheck/TcTyDecls.hs | 35 +- compiler/typecheck/TcType.hs | 117 ++--- compiler/typecheck/TcUnify.hs | 17 +- compiler/typecheck/TcValidity.hs | 21 +- compiler/types/Coercion.hs | 13 +- compiler/types/FamInstEnv.hs | 27 +- compiler/types/Kind.hs | 1 + compiler/types/TyCoRep.hs | 251 ++++++----- compiler/types/TyCoRep.hs-boot | 3 +- compiler/types/TyCon.hs | 33 +- compiler/types/Type.hs | 496 +++++++++++---------- compiler/types/Type.hs-boot | 2 +- compiler/types/Unify.hs | 10 +- compiler/vectorise/Vectorise/Convert.hs | 3 +- compiler/vectorise/Vectorise/Generic/PData.hs | 8 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 4 +- compiler/vectorise/Vectorise/Type/Type.hs | 2 +- compiler/vectorise/Vectorise/Utils/PADict.hs | 4 +- libraries/Win32 | 2 +- libraries/bytestring | 2 +- libraries/hpc | 2 +- libraries/time | 2 +- libraries/vector | 2 +- nofib | 2 +- .../tests/dependent/should_fail/T11334b.stderr | 6 +- testsuite/tests/ghci/scripts/T7587.stdout | 2 +- testsuite/tests/ghci/scripts/T7730.stdout | 4 +- .../partial-sigs/should_compile/T10403.stderr | 39 +- .../partial-sigs/should_compile/T11192.stderr | 23 +- .../tests/partial-sigs/should_fail/T10045.stderr | 11 +- testsuite/tests/polykinds/T9017.stderr | 5 +- .../tests/typecheck/should_fail/VtaFail.stderr | 2 +- utils/haddock | 2 +- 82 files changed, 1008 insertions(+), 1001 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 77bb09270c70455bbd547470c4e995707d19f37d From git at git.haskell.org Wed Jun 15 16:32:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Jun 2016 16:32:32 +0000 (UTC) Subject: [commit: ghc] master: Major patch to introduce TyConBinder (e368f32) Message-ID: <20160615163232.632903A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e368f3265b80aeb337fbac3f6a70ee54ab14edfd/ghc >--------------------------------------------------------------- commit e368f3265b80aeb337fbac3f6a70ee54ab14edfd Author: Simon Peyton Jones Date: Wed Jun 15 13:27:12 2016 +0100 Major patch to introduce TyConBinder Before this patch, following the TypeInType innovations, each TyCon had two lists: - tyConBinders :: [TyBinder] - tyConTyVars :: [TyVar] They were in 1-1 correspondence and contained overlapping information. More broadly, there were many places where we had to pass around this pair of lists, instead of a single list. This commit tidies all that up, by having just one list of binders in a TyCon: - tyConBinders :: [TyConBinder] The new data types look like this: Var.hs: data TyVarBndr tyvar vis = TvBndr tyvar vis data VisibilityFlag = Visible | Specified | Invisible type TyVarBinder = TyVarBndr TyVar VisibilityFlag TyCon.hs: type TyConBinder = TyVarBndr TyVar TyConBndrVis data TyConBndrVis = NamedTCB VisibilityFlag | AnonTCB TyCoRep.hs: data TyBinder = Named TyVarBinder | Anon Type Note that Var.TyVarBdr has moved from TyCoRep and has been made polymorphic in the tyvar and visiblity fields: type TyVarBinder = TyVarBndr TyVar VisibilityFlag -- Used in ForAllTy type TyConBinder = TyVarBndr TyVar TyConBndrVis -- Used in TyCon type IfaceForAllBndr = TyVarBndr IfaceTvBndr VisibilityFlag type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis -- Ditto, in interface files There are a zillion knock-on changes, but everything arises from these types. It was a bit fiddly to get the module loops to work out right! Some smaller points ~~~~~~~~~~~~~~~~~~~ * Nice new functions TysPrim.mkTemplateKiTyVars TysPrim.mkTemplateTyConBinders which help you make the tyvar binders for dependently-typed TyCons. See comments with their definition. * The change showed up a bug in TcGenGenerics.tc_mkRepTy, where the code was making an assumption about the order of the kind variables in the kind of GHC.Generics.(:.:). I fixed this; see TcGenGenerics.mkComp. >--------------------------------------------------------------- e368f3265b80aeb337fbac3f6a70ee54ab14edfd compiler/basicTypes/DataCon.hs | 68 +++- compiler/basicTypes/DataCon.hs-boot | 4 +- compiler/basicTypes/MkId.hs | 32 +- compiler/basicTypes/PatSyn.hs | 8 +- compiler/basicTypes/Var.hs | 104 +++++- compiler/coreSyn/CoreFVs.hs | 2 +- compiler/iface/BuildTyCl.hs | 65 ++-- compiler/iface/IfaceSyn.hs | 45 ++- compiler/iface/IfaceType.hs | 98 ++---- compiler/iface/MkIface.hs | 69 ++-- compiler/iface/TcIface.hs | 71 ++-- compiler/main/HscTypes.hs | 2 +- compiler/prelude/TysPrim.hs | 162 +++++---- compiler/prelude/TysWiredIn.hs | 167 ++++----- compiler/prelude/TysWiredIn.hs-boot | 4 + compiler/typecheck/Inst.hs | 4 +- compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcCanonical.hs | 4 +- compiler/typecheck/TcDeriv.hs | 4 +- compiler/typecheck/TcFlatten.hs | 2 +- compiler/typecheck/TcForeign.hs | 2 +- compiler/typecheck/TcGenGenerics.hs | 20 +- compiler/typecheck/TcHsSyn.hs | 25 +- compiler/typecheck/TcHsType.hs | 99 +++--- compiler/typecheck/TcInstDcls.hs | 5 +- compiler/typecheck/TcInteract.hs | 13 +- compiler/typecheck/TcMType.hs | 16 +- compiler/typecheck/TcPatSyn.hs | 22 +- compiler/typecheck/TcRnTypes.hs | 2 +- compiler/typecheck/TcSMonad.hs | 4 +- compiler/typecheck/TcSigs.hs | 2 +- compiler/typecheck/TcSplice.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 116 +++---- compiler/typecheck/TcTyDecls.hs | 4 +- compiler/typecheck/TcType.hs | 7 +- compiler/typecheck/TcTypeNats.hs | 14 +- compiler/typecheck/TcUnify.hs | 9 +- compiler/typecheck/TcValidity.hs | 6 +- compiler/types/Class.hs | 15 +- compiler/types/TyCoRep.hs | 198 ++++------- compiler/types/TyCoRep.hs-boot | 4 - compiler/types/TyCon.hs | 374 ++++++++++++--------- compiler/types/TyCon.hs-boot | 5 - compiler/types/Type.hs | 62 ++-- compiler/types/Type.hs-boot | 1 + compiler/vectorise/Vectorise/Generic/PData.hs | 7 +- compiler/vectorise/Vectorise/Type/Env.hs | 2 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 8 +- testsuite/tests/ado/ado002.stderr | 2 +- testsuite/tests/driver/werror.stderr | 2 +- testsuite/tests/gadt/gadt13.stderr | 6 +- testsuite/tests/gadt/gadt7.stderr | 8 +- .../tests/generics/T10604/T10604_deriving.stderr | 2 +- .../tests/ghci.debugger/scripts/break003.stderr | 2 +- .../tests/ghci.debugger/scripts/break003.stdout | 8 +- .../tests/ghci.debugger/scripts/break005.stdout | 4 +- .../tests/ghci.debugger/scripts/break006.stderr | 12 +- .../tests/ghci.debugger/scripts/break006.stdout | 10 +- .../tests/ghci.debugger/scripts/hist001.stdout | 28 +- testsuite/tests/ghci/prog010/ghci.prog010.stdout | 8 +- testsuite/tests/ghci/scripts/T11524a.stdout | 22 +- testsuite/tests/ghci/scripts/T6018ghcifail.stderr | 2 +- testsuite/tests/ghci/scripts/T7627.stdout | 6 +- testsuite/tests/ghci/scripts/T8535.stdout | 2 +- testsuite/tests/ghci/scripts/T8776.stdout | 2 +- testsuite/tests/ghci/scripts/ghci013.stdout | 2 +- testsuite/tests/ghci/scripts/ghci020.stdout | 2 +- testsuite/tests/ghci/scripts/ghci059.stdout | 2 +- testsuite/tests/ghci/should_run/T10145.stdout | 2 +- .../indexed-types/should_compile/T3017.stderr | 2 +- .../indexed-types/should_fail/ExtraTcsUntch.stderr | 28 +- testsuite/tests/parser/should_fail/T7848.stderr | 4 +- .../partial-sigs/should_compile/T10403.stderr | 29 +- .../partial-sigs/should_compile/T11192.stderr | 27 +- .../partial-sigs/should_compile/T12033.stderr | 10 +- .../WarningWildcardInstantiations.stderr | 4 +- .../tests/partial-sigs/should_fail/T10045.stderr | 15 +- .../should_fail/WildcardInstantiations.stderr | 4 +- .../tests/patsyn/should_compile/T11213.stderr | 12 +- testsuite/tests/patsyn/should_fail/T11053.stderr | 8 +- testsuite/tests/patsyn/should_run/ghci.stdout | 2 +- testsuite/tests/polykinds/T7328.stderr | 5 +- testsuite/tests/polykinds/T7438.stderr | 20 +- testsuite/tests/polykinds/T9017.stderr | 7 +- testsuite/tests/rebindable/rebindable6.stderr | 4 +- testsuite/tests/rename/should_fail/T10618.stderr | 2 +- .../tests/typecheck/should_compile/tc141.stderr | 14 +- .../should_fail/FailDueToGivenOverlapping.stderr | 4 +- .../tests/typecheck/should_fail/T10351.stderr | 4 +- .../tests/typecheck/should_fail/T11355.stderr | 2 +- testsuite/tests/typecheck/should_fail/T5858.stderr | 6 +- .../tests/typecheck/should_fail/T6018fail.stderr | 2 +- testsuite/tests/typecheck/should_fail/T8142.stderr | 14 +- testsuite/tests/typecheck/should_fail/T9109.stderr | 7 +- .../tests/typecheck/should_fail/VtaFail.stderr | 2 +- .../tests/typecheck/should_fail/tcfail001.stderr | 2 +- .../tests/typecheck/should_fail/tcfail010.stderr | 2 +- .../tests/typecheck/should_fail/tcfail012.stderr | 8 +- .../tests/typecheck/should_fail/tcfail013.stderr | 4 +- .../tests/typecheck/should_fail/tcfail016.stderr | 8 +- .../tests/typecheck/should_fail/tcfail033.stderr | 8 +- .../tests/typecheck/should_fail/tcfail069.stderr | 12 +- .../tests/typecheck/should_fail/tcfail182.stderr | 16 +- .../tests/typecheck/should_fail/tcfail201.stderr | 4 +- 104 files changed, 1247 insertions(+), 1150 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 e368f3265b80aeb337fbac3f6a70ee54ab14edfd From git at git.haskell.org Thu Jun 16 08:49:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 16 Jun 2016 08:49:50 +0000 (UTC) Subject: [commit: ghc] master: CoreMonad: Update error msg function docs (c56f8bd) Message-ID: <20160616084950.4793F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c56f8bd0cfd44a4a6812b62fc5dca3190d3e749f/ghc >--------------------------------------------------------------- commit c56f8bd0cfd44a4a6812b62fc5dca3190d3e749f Author: ?mer Sinan A?acan Date: Thu Jun 16 08:51:55 2016 +0000 CoreMonad: Update error msg function docs >--------------------------------------------------------------- c56f8bd0cfd44a4a6812b62fc5dca3190d3e749f compiler/simplCore/CoreMonad.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs index fa43312..853f5be 100644 --- a/compiler/simplCore/CoreMonad.hs +++ b/compiler/simplCore/CoreMonad.hs @@ -837,22 +837,22 @@ putMsgS = putMsg . text putMsg :: SDoc -> CoreM () putMsg = msg SevInfo --- | Output a string error to the screen +-- | Output an error to the screen. Does not cause the compiler to die. errorMsgS :: String -> CoreM () errorMsgS = errorMsg . text --- | Output an error to the screen +-- | Output an error to the screen. Does not cause the compiler to die. errorMsg :: SDoc -> CoreM () errorMsg = msg SevError warnMsg :: SDoc -> CoreM () warnMsg = msg SevWarning --- | Output a fatal string error to the screen. Note this does not by itself cause the compiler to die +-- | Output a fatal error to the screen. Does not cause the compiler to die. fatalErrorMsgS :: String -> CoreM () fatalErrorMsgS = fatalErrorMsg . text --- | Output a fatal error to the screen. Note this does not by itself cause the compiler to die +-- | Output a fatal error to the screen. Does not cause the compiler to die. fatalErrorMsg :: SDoc -> CoreM () fatalErrorMsg = msg SevFatal From git at git.haskell.org Fri Jun 17 08:29:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 08:29:12 +0000 (UTC) Subject: [commit: ghc] master: Abort the build when a Core plugin pass is specified in stage1 compiler (930a525) Message-ID: <20160617082912.178723A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/930a525a5906fdd65ab0c3e804085d5875517a20/ghc >--------------------------------------------------------------- commit 930a525a5906fdd65ab0c3e804085d5875517a20 Author: Ömer Sinan Ağacan Date: Fri Jun 17 07:54:28 2016 +0000 Abort the build when a Core plugin pass is specified in stage1 compiler This also makes the behavior the same with frontend plugin errors -- frontend was failing with an exception (`CmdLineError`) while the simplifier was just ignoring plugins. Now we abort with `CmdLineError` in both cases with a slightly improved error message. Test Plan: - add tests (will add tests once #12197 is implemented) - validate (done) Reviewers: austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2334 GHC Trac Issues: #11690 >--------------------------------------------------------------- 930a525a5906fdd65ab0c3e804085d5875517a20 compiler/main/DynamicLoading.hs | 23 +++++++++++++++++++++++ compiler/simplCore/SimplCore.hs | 8 +++++++- ghc/Main.hs | 5 +++-- 3 files changed, 33 insertions(+), 3 deletions(-) diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs index e7a2b95..2b2365f 100644 --- a/compiler/main/DynamicLoading.hs +++ b/compiler/main/DynamicLoading.hs @@ -19,6 +19,8 @@ module DynamicLoading ( getValueSafely, getHValueSafely, lessUnsafeCoerce +#else + pluginError, #endif ) where @@ -55,6 +57,16 @@ import Hooks import Data.Maybe ( mapMaybe ) import GHC.Exts ( unsafeCoerce# ) +#else + +import Module ( ModuleName, moduleNameString ) +import Panic + +import Data.List ( intercalate ) + +#endif + +#ifdef GHCI loadPlugins :: HscEnv -> IO [(ModuleName, Plugin, [CommandLineOption])] loadPlugins hsc_env @@ -243,4 +255,15 @@ throwCmdLineErrorS dflags = throwCmdLineError . showSDoc dflags throwCmdLineError :: String -> IO a throwCmdLineError = throwGhcExceptionIO . CmdLineError + +#else + +pluginError :: [ModuleName] -> a +pluginError modnames = throwGhcException (CmdLineError msg) + where + msg = "not built for interactive use - can't load plugins (" + -- module names are not z-encoded + ++ intercalate ", " (map moduleNameString modnames) + ++ ")" + #endif diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs index 6884696..85ae8cd 100644 --- a/compiler/simplCore/SimplCore.hs +++ b/compiler/simplCore/SimplCore.hs @@ -59,6 +59,8 @@ import qualified GHC.LanguageExtensions as LangExt #ifdef GHCI import DynamicLoading ( loadPlugins ) import Plugins ( installCoreToDos ) +#else +import DynamicLoading ( pluginError ) #endif {- @@ -350,7 +352,11 @@ getCoreToDo dflags addPluginPasses :: [CoreToDo] -> CoreM [CoreToDo] #ifndef GHCI -addPluginPasses builtin_passes = return builtin_passes +addPluginPasses builtin_passes + = do { dflags <- getDynFlags + ; let pluginMods = pluginModNames dflags + ; unless (null pluginMods) (pluginError pluginMods) + ; return builtin_passes } #else addPluginPasses builtin_passes = do { hsc_env <- getHscEnv diff --git a/ghc/Main.hs b/ghc/Main.hs index 5605438..1a6cbeb 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -32,6 +32,8 @@ import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings ) #ifdef GHCI import DynamicLoading import Plugins +#else +import DynamicLoading ( pluginError ) #endif import Module ( ModuleName ) @@ -841,8 +843,7 @@ dumpPackagesSimple dflags = putMsg dflags (pprPackagesSimple dflags) doFrontend :: ModuleName -> [(String, Maybe Phase)] -> Ghc () #ifndef GHCI -doFrontend _ _ = - throwGhcException (CmdLineError "not built for interactive use") +doFrontend modname _ = pluginError [modname] #else doFrontend modname srcs = do hsc_env <- getSession From git at git.haskell.org Fri Jun 17 08:35:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 08:35:33 +0000 (UTC) Subject: [commit: ghc] master: Remove dead code: countOnce, countMany (a7f65b8) Message-ID: <20160617083533.C66093A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a7f65b8787b0521397ee09061394425aa69bc6e0/ghc >--------------------------------------------------------------- commit a7f65b8787b0521397ee09061394425aa69bc6e0 Author: Joachim Breitner Date: Mon May 2 12:34:25 2016 +0200 Remove dead code: countOnce, countMany and export Count abstractly (the constructors are not used anywhere). >--------------------------------------------------------------- a7f65b8787b0521397ee09061394425aa69bc6e0 compiler/basicTypes/Demand.hs | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs index 1ca65b0..4ae6812 100644 --- a/compiler/basicTypes/Demand.hs +++ b/compiler/basicTypes/Demand.hs @@ -8,8 +8,7 @@ {-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances, RecordWildCards #-} module Demand ( - StrDmd, UseDmd(..), Count(..), - countOnce, countMany, -- cardinality + StrDmd, UseDmd(..), Count, Demand, CleanDemand, getStrDmd, getUseDmd, mkProdDmd, mkOnceUsedDmd, mkManyUsedDmd, mkHeadStrict, oneifyDmd, @@ -378,11 +377,6 @@ instance Outputable Count where ppr One = char '1' ppr Many = text "" --- Well-formedness preserving constructors for the Absence domain -countOnce, countMany :: Count -countOnce = One -countMany = Many - useBot, useTop :: ArgUse useBot = Abs useTop = Use Many Used From git at git.haskell.org Fri Jun 17 08:36:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 08:36:36 +0000 (UTC) Subject: [commit: ghc] wip/T10613: Rough working implementation of #10613 (73a7c23) Message-ID: <20160617083636.50A323A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10613 Link : http://ghc.haskell.org/trac/ghc/changeset/73a7c23d18ded774f5591c23f511699e35c43034/ghc >--------------------------------------------------------------- commit 73a7c23d18ded774f5591c23f511699e35c43034 Author: Joachim Breitner Date: Thu Mar 17 16:33:18 2016 +0100 Rough working implementation of #10613 The COUNTING_IND closure type is based on the (since removed) IND_PERM. Some of the code is rather ad-hoc and likely in need of some refactoring and clean-up before entering master (if it ever should), but it should be good enough to play around with it and obtain some numbers. >--------------------------------------------------------------- 73a7c23d18ded774f5591c23f511699e35c43034 compiler/cmm/CLabel.hs | 5 ++- compiler/cmm/CmmType.hs | 6 +++ compiler/cmm/SMRep.hs | 11 +++++- compiler/codeGen/StgCmmBind.hs | 76 +++++++++++++++++++++++++++--------- compiler/codeGen/StgCmmClosure.hs | 8 ++++ compiler/codeGen/StgCmmHeap.hs | 20 ++++++++-- compiler/codeGen/StgCmmLayout.hs | 23 ++++++++--- compiler/codeGen/StgCmmTicky.hs | 37 ++++++++++++++++-- compiler/codeGen/StgCmmUtils.hs | 12 +++--- compiler/coreSyn/PprCore.hs | 2 +- compiler/ghci/ByteCodeItbls.hs | 4 +- includes/Cmm.h | 1 + includes/rts/Ticky.h | 9 ++++- includes/rts/storage/ClosureMacros.h | 1 + includes/rts/storage/ClosureTypes.h | 73 +++++++++++++++++----------------- includes/rts/storage/Closures.h | 7 ++++ includes/stg/MiscClosures.h | 1 + rts/CheckUnload.c | 1 + rts/ClosureFlags.c | 3 +- rts/Interpreter.c | 1 + rts/LdvProfile.c | 1 + rts/Printer.c | 7 ++++ rts/ProfHeap.c | 1 + rts/RetainerProfile.c | 6 +-- rts/RtsSymbols.c | 1 + rts/Stable.c | 1 + rts/StgMiscClosures.cmm | 43 ++++++++++++++++++++ rts/Ticky.c | 21 +++++++--- rts/sm/Compact.c | 1 + rts/sm/Evac.c | 8 ++++ rts/sm/GCAux.c | 1 + rts/sm/Sanity.c | 1 + rts/sm/Scav.c | 12 ++++++ utils/deriveConstants/Main.hs | 7 ++++ utils/genapply/Main.hs | 4 +- 35 files changed, 328 insertions(+), 88 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 73a7c23d18ded774f5591c23f511699e35c43034 From git at git.haskell.org Fri Jun 17 08:36:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 08:36:38 +0000 (UTC) Subject: [commit: ghc] wip/T10613: Temporarily move regular entry counting to the COUNTING_IND (cec0f10) Message-ID: <20160617083638.EEAB93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10613 Link : http://ghc.haskell.org/trac/ghc/changeset/cec0f10917a21536699c98e7c0faab7702fbfb99/ghc >--------------------------------------------------------------- commit cec0f10917a21536699c98e7c0faab7702fbfb99 Author: Joachim Breitner Date: Wed Mar 23 14:28:34 2016 +0100 Temporarily move regular entry counting to the COUNTING_IND >--------------------------------------------------------------- cec0f10917a21536699c98e7c0faab7702fbfb99 compiler/codeGen/StgCmmBind.hs | 8 ++++++-- rts/StgMiscClosures.cmm | 1 + 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 5951175..8672273 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -609,9 +609,13 @@ thunkCode cl_info fv_details _cc node arity body -- Heap overflow check ; entryHeapCheck cl_info node' arity [] $ do - { -- Overwrite with black hole if necessary + { + -- Disabled for now, as we (temporarily unconditionally) move the + -- counting to the counting indirection + -- tickyEnterThunk cl_info + + -- Overwrite with black hole if necessary -- but *after* the heap-overflow check - ; tickyEnterThunk cl_info ; when (blackHoleOnEntry cl_info && node_points) (blackHoleIt node) diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm index 96b95aa..0f27fdb 100644 --- a/rts/StgMiscClosures.cmm +++ b/rts/StgMiscClosures.cmm @@ -283,6 +283,7 @@ INFO_TABLE(stg_COUNTING_IND,1,2,COUNTING_IND,"COUNTING_IND","COUNTING_IND") StgEntCounter_multi_entry_count(ent_ctr) = StgEntCounter_multi_entry_count(ent_ctr) + 1; } StgCountingInd_entries(clos) = entries + 1; + StgEntCounter_entry_count(ent_ctr) = StgEntCounter_entry_count(ent_ctr) + 1; #if defined(TICKY_TICKY) && !defined(PROFILING) /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than From git at git.haskell.org Fri Jun 17 08:36:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 08:36:41 +0000 (UTC) Subject: [commit: ghc] wip/T10613: DmdAnal, temporary hack: Remember which “Many” are boring (ca80c12) Message-ID: <20160617083641.A417E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10613 Link : http://ghc.haskell.org/trac/ghc/changeset/ca80c1201f66b1c028793fd239b098089d915685/ghc >--------------------------------------------------------------- commit ca80c1201f66b1c028793fd239b098089d915685 Author: Joachim Breitner Date: Mon May 2 14:12:51 2016 +0200 DmdAnal, temporary hack: Remember which “Many” are boring in the sense that we do not have to look at the core if this thunk turns out to be a missed opportunity. Not used in any rigoros way, but just to be able to focus on the interesting bits. >--------------------------------------------------------------- ca80c1201f66b1c028793fd239b098089d915685 compiler/basicTypes/Demand.hs | 87 ++++++++++++++++++++++----------------- compiler/basicTypes/MkId.hs | 6 +-- compiler/codeGen/StgCmmBind.hs | 8 +++- compiler/codeGen/StgCmmClosure.hs | 39 +++++++++++------- compiler/codeGen/StgCmmTicky.hs | 21 ++++++---- compiler/prelude/primops.txt.pp | 30 +++++++------- compiler/simplStg/StgStats.hs | 2 +- compiler/stgSyn/CoreToStg.hs | 4 +- compiler/stgSyn/StgSyn.hs | 14 +++++-- 9 files changed, 124 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 ca80c1201f66b1c028793fd239b098089d915685 From git at git.haskell.org Fri Jun 17 08:36:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 08:36:45 +0000 (UTC) Subject: [commit: ghc] wip/T10613's head updated: DmdAnal, temporary hack: Remember which “Many” are boring (ca80c12) Message-ID: <20160617083645.5C9943A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T10613' now includes: 5adf8f3 Document -fmax-pmcheck-iterations a bit better a0e1051 Recommend more reliable recourse for broken nm 57c636f Update nofib submodule to nofib master fa3ba06 Expand the comment on pprVarSet 82538f6 Kill varSetElems in injImproveEqns af6dced Comments only a2abcf6 Minor improvement to error message 1e86cab Comments only 9ed57d6 Remove unused unifyType_ 4c746cb Add missing solveEqualities 3dce4f2 Refactor RecordPatSynField, FieldLabel c4dd4ae Better documentation of -XConstrainedClassMethods c5b1014 Fix debug-only check in CoreLint 546f24e Revert "Use __builtin_clz() to implement log_2()" 3a53380 Kill unused foldOccSet 196ce62 Testsuite: delete accidentally committed .stderr.normalised file 89c6d07 Testsuite: add -ignore-dot-ghci to some ghci tests [skip ci] 9dc34d3 Testsuite: fix T11223_simple_(unused_)duplicate_lib b0569e8 Testsuite: benign test fixes 3c426b0 Add uniqSetAny and uniqSetAll and use them 7312923 Kill mapUniqSet 32c0aba Testsuite: delete -fesc tests e20b3ed Testsuite: delete T5054 and T5054_2 (#5054) bcfee21 rts/LdvProfile.c: Fix NULL dereference on shutdown f255f80 Linker: Fix implicit function declaration warning on OS X 6e195f4 Remove unused foldFsEnv 031de8b Remove unused foldNameEnv f99db38 Fix path to the new build system, now called Hadrian. 0fa1d07 testsuite: fix up T11223's Makefile a2970f8 RTS: delete BlockedOnGA* + dead code c5919f7 Remove the incredibly hairy splitTelescopeTvs. 7242582 Test #11484 in th/T11484 00053ee Fix typo: Superclases -> Superclasses b725fe0 PPC NCG: Improve pointer de-tagging code c4259ff Testsuite: make CLEANUP=1 the default (#9758) 2ae39ac Testsuite: accept new output for 2 partial-sigs tests 2fe7a0a Fix reference to Note in TcCanonical cb05860 Comment typos: Mkae -> Make, Hsakell -> Haskell 49bae46 Comment typo: unambigious -> unambiguous f69e707 Typos in DmdAnal e6627d1 Fix aggressive cleanup of T1407 868d2c4 rts: Remove deprecated C type `lnat` eac6967 users-guide: Add index entry for "environment file" 18676a4 Bump haddock submodule 533037c Greater customization of GHCi prompt 16a51a6 rts: Close livelock window due to rapid ticker enable/disable 65e13f6 rts: Split up Itimer.c df9b772 Catch errors from timerfd_settime 55f4009 Kill Itimer.h 999c464 rts/itimer/pthread: Stop timer when ticker is stopped 116d3fe Remove unused getScopedTyVarBinds 1161932 Add T11747 as a test ecc0603 deriveConstants: Fix nm advice one last time a28611b Export constructors for IntPtr and WordPtr ea34f56 Remove unused equivClassesByUniq cd85dc8 Make sure record pattern synonym selectors are in scope in GHCi. db2bfe0 added docstring for '-fhistory-size' flag 81d8a23 glasgow_exts.rst: fix quoting c5be5e2 docs/users_guide/glasgow_exts.rst: fix merge conflict fa86ac7 Make validDerivPred ignore non-visible arguments to a class type constructor 36d29f7 StaticPointers: Allow closed vars in the static form. 5f8c0b8 Revert "Revert "Use __builtin_clz() to implement log_1()"" ef44606 Cleanups related to MAX_FREE_LIST 0051ac1 Update libraries/hpc submodule to v0.6.0.3 release tag 4466ae6 Update bytestring submodule to 0.10.8.0 release tag 50e7055 Export oneShot from GHC.Exts f9d9375 Adjust testsuite output to bytestring-0.10.8.0 76ee260 Allow limiting the number of GC threads (+RTS -qn) f703fd6 Add +RTS -AL 1fa92ca schedulePushWork: avoid unnecessary wakeups dbcaa8c Don't STATIC_INLINE giveCapabilityToTask aa5e2dd Make 'make fast' work for the User Guide b75d194 Be more aggressive when checking constraints for custom type errors. 4f2afe1 testsuite: Add test for #11959 763610e base: Export runRW# from GHC.Exts ad4392c Kill non-deterministic foldUFM in TrieMap and TcAppMap db9de7e rts: Replace `nat` with `uint32_t` e340520 Comments only explaining export list parsing. 94f2ee1 Explain linter optimization for StaticPtr checks. 990ce8c Use tcExtendGlobalValEnv for default methods ecc1d58 Update Win32 submodule to v2.3.1.1 release tag 018487e Fix pretty printing of IEThingWith fe190ae Remove trailing whitespace from 'testsuite/tests/module/all.T' 633b099 Update time submodule to 1.6.0.1 release tag 8e5776b rts/ProfHeap.c: Use `ssize_t` instead of `long`. dd3e847 Documentation for simplifyDeriv. 260a564 Use stdint types for Stg{Word,Int}{8,16,32,64} 2593e20 White space only 76d9156 Emit wild-card constraints in the right place cc75a5d Comments only e1ff2b4 Fix partial sigs and pattern bindings interaction 9dbf5f5 Tidy up partial-sig quantification bb296bf Error message wibbles, re partial type sigs 0597493 Re-do the invariant for TcDepVars 3ca7806 stg/Types.h: Fix comment and #include 53f26f5 Forbid variables to be parents in import lists. e996e85 RdrHsSyn: Only suggest `type` qualification when appropriate ea3d1ef Fix a crash in requestSync() bff6e1b Comments only 4ac0e81 Kill unnecessary cmpType in lhs_cmp_type b58b0e1 Make simplifyInstanceContexts deterministic a4717f5 Comments about static forms b21e8cc Comments only e7e5939 Add Outputable ShowHowMuch e24b50c Use partial-sig constraints as givens 1a43783 Record that EqualityConstraint now works f6e58be Test Trac #11640 7e28e47 Get rid of Traversable UniqFM and Foldable UniqFM 402f201 Fix typos ab91b85 make accept for Make simplifyInstanceContexts deterministic e207198 Kill foldUFM in classifyTyCon 8669c48 Document why closeOverKind is OK for determinism 584ade6 RtsFlags: Make `mallocFailHook` const correct 0efbf18 rts: Fix C compiler warnings on Windows 9363f04 Handle promotion failures when scavenging a WEAK (#11108) 0e71988 Remove some varSetElems in dsCmdStmt 3edbd09 Document SCC determinism cfc5df4 Fix ASSERT failure and re-enable setnumcapabilities001 2a0d00d Make random an "extra" package 86a1f20 Remove a copy of System.Random and use reqlib('random') b5f85ce Remove stale comment. da105ca Don't prematurely force TyThing thunks with -ddump-if-trace. 925b0ae Make absentError not depend on uniques eae3362 docs: add skeleton 8.2.1 release notes e217287 Bump haddock submodule c079de3 Add TH support for pattern synonyms (fixes #8761) e53f218 Fix deriveTyData's kind unification when two kind variables are unified b8e2565 Make Generic1 poly-kinded 6971430 Allow putting Haddocks on derived instances 01bc109 Document zonkTyCoVarsAndFV determinism 6bf0eef Kill varEnvElts in specImports 69c974f Use StgHalfWord instead of a CPP #if 995cf0f rts: Make function pointer parameters `const` where possible 0c0129b RtsUtils: Use `size_t` instead of `int` where appropriate 7c0b595 Fix comments about scavenging WEAK objects 5416fad Refactor some ppr functions to use pprUFM bd01bbb Test Trac #12039 8e48d24 Bump haddock submodule e4834ed Fix a performance issue with -fprint-expanded-synonyms c974927 Update bytestring submodule to 0.10.8.1 release tag bf669a0 Bump haddock submodule 2dbdc79 PPC NCG: Fix pretty printing of st[wd]ux instr. 563a485 PPC: Implement SMP primitives using gcc built-ins d78faa1 testsuite/ImpSafe03: Normalize version of bytestring eed820b Move Extension type to ghc-boot-th 21fe4ff Kill varSetElems in tcInferPatSynDecl d20d843 Another bump of haddock submodule 7814420 Remove html_theme requirement of haddock docs 4a037a9 Set `USE_MMAP` at configure time 770d708 Add ghc-boot-th to rules/foreachLibrary dc94914 Document determinism in shortOutIndirections 3f3dc23 Testsuite: run tests in /tmp after copying required files 1a9ae4b Testsuite: delete old cleanup code (#11980) a9dd9b7 Testsuite: delete unused file [skip ci] c92cfbc Testsuite: don't skip concio001 and concio001_thr 931b3c7 Delete libraries/ghci/GNUmakefile [skip ci] a54d87a rules: Fix name of ghc-boot-th library 5d80d14 rules/build-prog: Ensure programs depend upon their transitive deps 33c029d rts: More const correct-ness fixes b088c02 Testsuite: T10052 requires interpreter (#11730) 3251743 Testsuite: don't warn when mk/ghcconfig_* hasn't been created yet 77ee3a9 Update .mailmap [skip ci] fffe3a2 Make inert_model and inert_eqs deterministic sets f0f0ac8 Fix histograms for ticky code ba3e1fd Add a test for #11108 39a2faa Rework parser to allow use with DynFlags 310371f rts: Add isPinnedByteArray# primop f091218 CLabel: Catch #11155 during C-- pretty-printing 9dd0481 Add (broken) test for #12063. 5f1557e Failing test case for #12076. f18e8d8 rts: Add missing `const` from HashTable API 6282bc3 Kill varSetElems in tidyFreeTyCoVars 13e40f9 Kill varEnvElts in tcPragExpr 72b677d Fix Trac #12051 ad7f122 Improve pretty-printing of equalities f9e90bc Improve documentation for type wildcards 0bfcfd0 Comments only d1efe86 Comments only 358567a testsuite: Add expected output for T11108 470def9 Testsuite: fix T11827 (#11827) 296b8f1 Add libraries/ghci/GNUmakefile to .gitignore [skip ci] f0f3517 Remove use of caddr_t 8abc193 Get types in osFreeMBlocks in sync with osGetMBlocks 464b6f8 {,M}BLOCK_SIZE_W * sizeof(W_) -> {,M}BLOCK_SIZE 2e6433a testsuite: Add a TypeRep test a88bb1b Give lifted primitive types a representation 1ee47c1 Use the correct return type for Windows' send()/recv() (Fix #12010) 3910306 Add -XStaticPointers to the flag reference. 08e47ca FunDep printer: Fix unicode arrow 43589f5 testsuite: add CmmSwitchTest for 32-bit platforms ae7e9cb Fix Windows build after Ticky changes 8e92974 Testsuite: mark T8761 expect_broken #12077 a1f3bb8 Fix failing T12010 d9cb7a8 compiler/iface: compress .hi files e44a6f9 users-guide: Vector version of Thomson-Wheeler logo 6d6d6e4 rules/sphinx: Add missing dependency on conf.py for pdf rule cf1efc7 users-guide: Fix index in PDF output da3c1eb Enable checkProddableBlock on x86_64 527ed72 Fix deriving Ord when RebindableSyntax is enabled c81e7b2 Build system: temp solution for parallelisation bug (#11960) f669764 Use `setSession` instead of `modifySession` when setting `HscEnv` a70a6da rts/Linker.c: Fix compile error on Arm fa58710 Update format specifiers for Tickey.c 2230c88 Testsuite: fix T12010 for real 8c9b8a3 Allow unlifted types in pattern synonym result type d835ee6 Fix build by removing unused import. 785b38f testsuite: Update max_bytes_used for T4029 9bb2772 Revert "compiler/iface: compress .hi files" 4f5b335 Suppress the warning about __sync_fetch_and_nand (#9678) 03d8960 Don't split the arg types in a PatSyn signature eb8eb02 Spelling in comment 839b424 Remove unused Type.splitFunTysN 9c3e55b Comments only 35053eb Testsuite: delete check_files_written 1bf5c12 Spelling 8f7d016 Add support for unicode TH quotes (#11743) 4c6e69d Document some benign nondeterminism 9d06ef1 Make Arrow desugaring deterministic 95dfdce Remove 'deriving Typeable' statements fe8a4e5 Runtime linker: Break m32 allocator out into its own file 1956cbf Fix: #12084 deprecate old profiling flags 31f1804 Testsuite: delete drvfail015.stderr-7.0 [skip ci] 1319363 Always use native-Haskell de/encoders for ASCII and latin1 ac38c02 Update submodule vector [skip ci] 961ed26 Fix broken links to mdo papers eec88ee RTS: simplify read_heap_profiling_flag bdc5558 Testsuite: introduce TEST_HC_OPTS_INTERACTIVE (#11468) 8408d84 Spelling in comments 6a5bce1 Testsuite: also normalise platform-dependent .stdout/stderr f07bf19 Testsuite: fix enum01/02/03 on Windows (#9399) 5020bc8 Testsuite: add a test for #5522 (-fliberate-case -fspec-constr) 0f1e315 Fix bytecode gen to deal with rep-polymorphism e9e61f1 Reduce special-casing for nullary unboxed tuple 5b8bec2 StgCmmExpr: Fix a duplication 5b145c9 Coverage.hs: Fix a duplication cd50d23 StgCmmCon: Do not generate moves from unused fields to local variables b43a793 More fixes for unboxed tuples 72fd407 Comments and white space only 59250dc StgCmmExpr: Remove a redundant list 3a00ff9 Do not init record accessors as exported 3f20da1 Typos in comments d0dd572 Clarify users' guide section on GeneralizedNewtypeDeriving d40682e Testsuite: don't use --interactive in Makefiles 1e67010 RtsFlags.c: Const correct fixes 7e4f3dc StgCmmUtils.emitMultiAssign: Make assertion msg more helpful 0ffa23d Remove unused FAST_STRING_NOT_NEEDED macro defs 930e74f Update a Cmm note 0676e68 Fix detection and use of `USE_LIBDW` cb2c042 Use nameSetAny in findUses f2b3be0 Improve failed knot-tying error message. 99ace83 Kill nameSetElems in getInfo 36d254a Testsuite: run tests in /tmp/ghctest-xxx instead of /tmp/ghctest/xxx 940229c Travis: llvm's apt repository is offline cb9f635 Localize orphan-related nondeterminism d348acd Serialize vParallelTyCons in a stable order 3eac3a0 Add nameSetElemsStable and fix the build dad39ff Remove dead generics-related code from OccName d753ea2 Use UniqDSet for finding free names in the Linker e2446c0 Kill nameSetElems in findImportUsage be47085 Kill nameSetElems in rnCmdTop 060c176 Whitespace only 1d1987e HscMain: Minor simplification 9cc6fac Make FieldLabelEnv a deterministic set 2046297 Document putSymbolTable determinism 4842a80 Derive instances in Data.Data 1dadd9a testsuite: Mark broken tests on powerpc64le 3747372 Refactored SymbolInfo to lower memory usage in RTS 079c1b8 Use useful names for Symbol Addr and Names in Linker.c 02f893e integer-gmp: Make minusInteger more efficient 4aa299d PrelInfo: Ensure that tuple promoted datacon names are in knownKeyNames eda73a3 RTS SMP: Use compiler built-ins on all platforms. 4dbacbc Rename isPinnedByteArray# to isByteArrayPinned# b948a1d Refactor the SymbolName and SymbolAddr types to be pointers 5965117 Replace hand-written Bounded instances with derived ones 0d963ca Add relocation type R_X86_64_REX_GOTPCRELX 4848ab9 Testsuite: fixup comments for T9872d [skip ci] 886f4c1 Better comment for orIfNotFound. f91d87d Failing test-case for #12135. 3042a9d Use UniqDFM for HomePackageTable 48e9a1f Implement deterministic CallInfoSet a90085b Add @since annotations to base instances e684f54 Desugar ApplicativeDo and RecDo deterministically 31ba8d6 Kill nameSetElems 46d2da0 Document putDictionary determinism 3e7a876 Kill foldUniqSet 1937ef1 Make UnitIdMap a deterministic map a13cb27 Merge MatchFixity and HsMatchContext 77ccdf3 Kill occSetElts 7fea712 Use a deterministic map for imp_dep_mods d05dee3 CoreToStg: Remove hand-written Eq instances of HowBound and LetInfo 4426c5f Kill two instances of uniqSetToList 0d6f428 Fix build by removing unused import c148212 Kill varSetElems in checkValidInferredKinds ad8e203 Use DVarSet in Vectorise.Exp 3b698e8 Document determinism in pprintClosureCommand 5db93d2 Make vectInfoParallelVars a DVarSet 7008515 Kill varSetElems 7d58a97 Use pprUFM in pprStgLVs 00e3a5d Typofix. 4d5b2f6 Testsuite driver: always quote opts.testdir f5f5a8a Testsuite Windows: mark T8308 expect_broken (#8308) d4b548e Add some determinism tests dd33245 Desugar: Display resulting program stats with -v2 44a3c18 Revert "Desugar: Display resulting program stats with -v2" c2bbc8b Report term sizes with -v3 even when -ddump is enabled 80cf4cf Literal: Remove unused hashLiteral function d7933cb Show sources of cost centers in .prof 8f6d292 Fix #12064 by making IfaceClass typechecking more lazy. acb9e85 Minor performance note about IdInfo. 11ff1df Fix #12076 by inlining trivial expressions in CorePrep. 48385cb Remove special casing of Windows in generic files ceaf7f1 Implement Eq TyCon directly 68c1c29 Remove Ord (CoAxiom br) 9dbf354 Testsuite: delete dead code [skip ci] e703a23 Docs: fix links to ghc-flags 70e0a56 Remove Ord Class b2624ee Remove Ord PatSyn 77b8c29 Remove Ord AltCon c22ab1a Docs: delete PatternGuards documentation b020db2 Fix Ticky histogram on Windows e9dfb6e Improve the error messages for static forms. b0a7664 prettyPrintClosure(): Untag the closure before accessing fields 47d8173 Remove Printer.c:prettyPrintClosure() bcb419a Fix #12099: Remove bogus flags 6adff01 Comments only 6905ce2 Refine imports slightly 0f0b002 Comments only 3ae18df Minor refactoring b9fa72a Small refactor to mkRuntimErrorId 9e5ea67 NUMA support c88f31a Rts flags cleanup 5990016 ModuleSet: Use an actual set instead of map to units 6ace660 rts: Fix build when USE_LARGE_ADDRESS_SPACE is undefined 9130867 Skip retc001 on OSX b40e1b4 Fix incorrect calculated relocations on Windows x86_64 29e1464 Disable T12031 on linux 2bb6ba6 rts: Fix NUMA when cross compiling d25cb61 Kill off redundant SigTv check in occurCheckExpand 15b9bf4 Improve typechecking of let-bindings c28dde3 Tidy up zonkQuantifiedTyVar 7afb7ad Get in-scope set right in top_instantiate 35c9de7 Move the constraint-kind validity check 1f66128 Beef up mkNakedCastTy 15fc528 Fix the in-scope set for extendTvSubstWithClone 599d912 Beef up isPredTy 8104f7c Remove some traceTc calls e064f50 Add to .gitignore 921ebc9 Test Trac #12055 1dcb32d A second test for Trac #12055 5cee88d Add thin library support to Windows too 7de776c Kill unused foldModuleEnv 586d558 Use UniqFM for SigOf 0497ee5 Make the Ord Module independent of Unique order d55a9b4 Update Haddock to follow change in LHsSigWcType 4f35646 Adjust error message slightly 8dfd4ae Build system: mention ghc version in bindist's `configure --help` docdir a2deee0 Testsuite: enable ghci.prog010 (#2542) 23b73c9 Don't GC sparks for CAFs 9d22fbe Rename cmpType to nonDetCmpType 753c5b2 Simplify readProcessEnvWithExitCode + set LANGUAGE=C 70a4589 Revert "Make the Ord Module independent of Unique order" e33ca0e Fix testsuite wibble 77bb092 Re-add FunTy (big patch) e368f32 Major patch to introduce TyConBinder c56f8bd CoreMonad: Update error msg function docs 930a525 Abort the build when a Core plugin pass is specified in stage1 compiler a7f65b8 Remove dead code: countOnce, countMany 73a7c23 Rough working implementation of #10613 cec0f10 Temporarily move regular entry counting to the COUNTING_IND ca80c12 DmdAnal, temporary hack: Remember which “Many” are boring From git at git.haskell.org Fri Jun 17 13:49:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 13:49:13 +0000 (UTC) Subject: [commit: ghc] master: NUMA cleanups (498ed26) Message-ID: <20160617134913.8D66D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/498ed2664219f7e8f1077f46ad2061aba2f57de4/ghc >--------------------------------------------------------------- commit 498ed2664219f7e8f1077f46ad2061aba2f57de4 Author: Simon Marlow Date: Sat Jun 11 11:07:14 2016 +0100 NUMA cleanups - Move the numaMap and nNumaNodes out of RtsFlags to Capability.c - Add a test to tests/rts >--------------------------------------------------------------- 498ed2664219f7e8f1077f46ad2061aba2f57de4 includes/rts/Flags.h | 4 +--- libraries/base/GHC/RTS/Flags.hsc | 4 ++-- rts/Capability.c | 38 +++++++++++++++++++++++++++++++++++--- rts/Capability.h | 17 +++++++++++++---- rts/RtsFlags.c | 36 ++++-------------------------------- rts/Task.c | 4 ++-- rts/posix/OSThreads.c | 1 - rts/sm/BlockAlloc.c | 10 +++++----- rts/sm/MBlock.c | 2 +- rts/sm/Storage.c | 18 ++++++++---------- testsuite/tests/rts/all.T | 3 +++ testsuite/tests/rts/numa001.hs | 20 ++++++++++++++++++++ 12 files changed, 94 insertions(+), 63 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 498ed2664219f7e8f1077f46ad2061aba2f57de4 From git at git.haskell.org Fri Jun 17 14:24:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 14:24:13 +0000 (UTC) Subject: [commit: ghc] wip/T10613: [Temporary hack, not for master] DmdAnal: Remember by “Many” things are many (e974fe2) Message-ID: <20160617142413.9EF9D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10613 Link : http://ghc.haskell.org/trac/ghc/changeset/e974fe2bf973459715215b1a674fe467ae42af1b/ghc >--------------------------------------------------------------- commit e974fe2bf973459715215b1a674fe467ae42af1b Author: Joachim Breitner Date: Mon May 2 14:12:51 2016 +0200 [Temporary hack, not for master] DmdAnal: Remember by “Many” things are many I change the type data Count = One | Many into data Count = One | Many [String] and use these list of strings (always sorted and nub'ed) to track the various reasons why something is called many times. >--------------------------------------------------------------- e974fe2bf973459715215b1a674fe467ae42af1b compiler/basicTypes/Demand.hs | 164 +++++++++++++++++++++++--------------- compiler/basicTypes/MkId.hs | 6 +- compiler/codeGen/StgCmmBind.hs | 8 +- compiler/codeGen/StgCmmClosure.hs | 39 +++++---- compiler/codeGen/StgCmmTicky.hs | 21 +++-- compiler/prelude/primops.txt.pp | 30 +++---- compiler/simplStg/StgStats.hs | 2 +- compiler/specialise/SpecConstr.hs | 2 +- compiler/stgSyn/CoreToStg.hs | 4 +- compiler/stgSyn/StgSyn.hs | 14 +++- compiler/stranal/DmdAnal.hs | 8 +- 11 files changed, 178 insertions(+), 120 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e974fe2bf973459715215b1a674fe467ae42af1b From git at git.haskell.org Fri Jun 17 15:56:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 15:56:14 +0000 (UTC) Subject: [commit: ghc] wip/T10613: [Temporary hack, not for master] DmdAnal: Remember by “Many” things are many (095dee8) Message-ID: <20160617155614.643483A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10613 Link : http://ghc.haskell.org/trac/ghc/changeset/095dee89a6316c7ae5d16b005e3a28eba07df792/ghc >--------------------------------------------------------------- commit 095dee89a6316c7ae5d16b005e3a28eba07df792 Author: Joachim Breitner Date: Mon May 2 14:12:51 2016 +0200 [Temporary hack, not for master] DmdAnal: Remember by “Many” things are many I change the type data Count = One | Many into data Count = One | Many [String] and use these list of strings (always sorted and nub'ed) to track the various reasons why something is called many times. >--------------------------------------------------------------- 095dee89a6316c7ae5d16b005e3a28eba07df792 compiler/basicTypes/Demand.hs | 176 ++++++++++++++++++++++---------------- compiler/basicTypes/IdInfo.hs | 6 +- compiler/basicTypes/MkId.hs | 6 +- compiler/codeGen/StgCmmBind.hs | 8 +- compiler/codeGen/StgCmmClosure.hs | 39 +++++---- compiler/codeGen/StgCmmTicky.hs | 21 +++-- compiler/coreSyn/CoreArity.hs | 2 +- compiler/coreSyn/CorePrep.hs | 8 +- compiler/prelude/primops.txt.pp | 30 +++---- compiler/simplStg/StgStats.hs | 2 +- compiler/specialise/SpecConstr.hs | 2 +- compiler/stgSyn/CoreToStg.hs | 4 +- compiler/stgSyn/StgSyn.hs | 14 ++- compiler/stranal/DmdAnal.hs | 12 +-- compiler/stranal/WorkWrap.hs | 2 +- 15 files changed, 195 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 095dee89a6316c7ae5d16b005e3a28eba07df792 From git at git.haskell.org Fri Jun 17 20:10:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:10:43 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T11970' created Message-ID: <20160617201043.D33FB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T11970 Referencing: 98f54a75c217dbfcfc10c7e44b438e9313ac4626 From git at git.haskell.org Fri Jun 17 20:10:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:10:46 +0000 (UTC) Subject: [commit: ghc] wip/T11970: Basic rip out (76db8ec) Message-ID: <20160617201046.919903A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T11970 Link : http://ghc.haskell.org/trac/ghc/changeset/76db8ec37ebe9db432f00fb88a22ae46a0b5c9ea/ghc >--------------------------------------------------------------- commit 76db8ec37ebe9db432f00fb88a22ae46a0b5c9ea Author: Matthew Pickering Date: Thu May 12 21:58:58 2016 +0100 Basic rip out >--------------------------------------------------------------- 76db8ec37ebe9db432f00fb88a22ae46a0b5c9ea compiler/basicTypes/Avail.hs | 38 ++++++++++--------------------------- compiler/basicTypes/RdrName.hs | 26 ++++++++++++------------- compiler/iface/LoadIface.hs | 2 +- compiler/iface/MkIface.hs | 2 +- compiler/main/HscTypes.hs | 2 +- compiler/rename/RnEnv.hs | 2 -- compiler/rename/RnExpr.hs | 2 +- compiler/rename/RnNames.hs | 25 +++++++++--------------- compiler/rename/RnPat.hs | 8 ++++---- compiler/rename/RnSource.hs | 2 +- compiler/typecheck/TcRnDriver.hs | 38 +++++++++++++++++++++++++++++++------ testsuite/tests/module/all.T | 1 + testsuite/tests/module/mod17.stderr | 7 ++++--- testsuite/tests/module/mod3.stderr | 7 ++++--- testsuite/tests/module/mod4.stderr | 6 +++--- 15 files changed, 84 insertions(+), 84 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 76db8ec37ebe9db432f00fb88a22ae46a0b5c9ea From git at git.haskell.org Fri Jun 17 20:10:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:10:49 +0000 (UTC) Subject: [commit: ghc] wip/T11970: working (a10c4af) Message-ID: <20160617201049.F1F0E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T11970 Link : http://ghc.haskell.org/trac/ghc/changeset/a10c4af5a3a1b8997f9f09ea37fe534bc29042d8/ghc >--------------------------------------------------------------- commit a10c4af5a3a1b8997f9f09ea37fe534bc29042d8 Author: Matthew Pickering Date: Sat May 21 23:23:57 2016 +0100 working >--------------------------------------------------------------- a10c4af5a3a1b8997f9f09ea37fe534bc29042d8 compiler/rename/RnEnv.hs | 81 +++++++++++++++++++++- compiler/rename/RnNames.hs | 75 +++++++++++++++----- compiler/typecheck/TcRnDriver.hs | 64 +++++++++++++---- testsuite/tests/module/MultiExport.stderr | 3 + testsuite/tests/module/all.T | 1 + testsuite/tests/module/mod17.stderr | 1 + testsuite/tests/module/mod3.stderr | 1 + .../tests/overloadedrecflds/should_fail/all.T | 1 + 8 files changed, 193 insertions(+), 34 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a10c4af5a3a1b8997f9f09ea37fe534bc29042d8 From git at git.haskell.org Fri Jun 17 20:10:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:10:53 +0000 (UTC) Subject: [commit: ghc] wip/T11970: Add test files (4adb744) Message-ID: <20160617201053.131A73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T11970 Link : http://ghc.haskell.org/trac/ghc/changeset/4adb744a4ce389becde38ab03400475580c78971/ghc >--------------------------------------------------------------- commit 4adb744a4ce389becde38ab03400475580c78971 Author: Matthew Pickering Date: Sat May 21 23:25:14 2016 +0100 Add test files >--------------------------------------------------------------- 4adb744a4ce389becde38ab03400475580c78971 testsuite/tests/module/MultiExport.hs | 6 ++++++ testsuite/tests/overloadedrecflds/should_fail/NoParent.hs | 9 +++++++++ 2 files changed, 15 insertions(+) diff --git a/testsuite/tests/module/MultiExport.hs b/testsuite/tests/module/MultiExport.hs new file mode 100644 index 0000000..4f8079e --- /dev/null +++ b/testsuite/tests/module/MultiExport.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE PatternSynonyms #-} +module Foo ( A(x, x) ) where + +data A = A Int + +pattern Pattern{x} = A x diff --git a/testsuite/tests/overloadedrecflds/should_fail/NoParent.hs b/testsuite/tests/overloadedrecflds/should_fail/NoParent.hs new file mode 100644 index 0000000..f6d984d --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NoParent.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DuplicateRecordFields #-} +module NoParent (A(x)) where + +data A = A +data B = B { x :: Int } +data C = C { x :: String } + + + From git at git.haskell.org Fri Jun 17 20:10:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:10:56 +0000 (UTC) Subject: [commit: ghc] wip/T11970: tabs (ceea42f) Message-ID: <20160617201056.2FA303A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T11970 Link : http://ghc.haskell.org/trac/ghc/changeset/ceea42f684a1382ba116948e672607f4ab2433da/ghc >--------------------------------------------------------------- commit ceea42f684a1382ba116948e672607f4ab2433da Author: Matthew Pickering Date: Sat May 21 23:47:41 2016 +0100 tabs >--------------------------------------------------------------- ceea42f684a1382ba116948e672607f4ab2433da compiler/typecheck/TcRnDriver.hs | 62 ++++++++++------------ .../overloadedrecflds/should_fail/NoParent.hs | 3 -- .../overloadedrecflds/should_fail/NoParent.stderr | 6 +++ 3 files changed, 33 insertions(+), 38 deletions(-) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 9852eb2..d55b5d6 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -2347,9 +2347,9 @@ tc_export_with :: Name -- ^ Type constructor tc_export_with n ns fls = do ty_con <- tcLookupTyCon n things <- mapM tcLookupGlobal ns - let data_cons = [("data constructor", c, dataConTyCon c) + let data_cons = [(c, dataConTyCon c) | AConLike (RealDataCon c) <- things ] - ps = [(psErr p,p) | AConLike (PatSynCon p) <- things] + ps = [(psErr p,p) | AConLike (PatSynCon p) <- things] ps_sels = [(selErr i,p) | AnId i <- things , isId i , RecSelId {sel_tycon = RecSelPatSyn p} <- [idDetails i]] @@ -2358,7 +2358,7 @@ tc_export_with n ns fls = do mkTyConApp ty_con (mkTyVarTys (tyConTyVars ty_con)) mapM_ (tc_one_dc_export_with ty_con) data_cons - mapM_ (tc_flds actual_res_ty ty_con) (partitionFieldLabels fls) + mapM_ (tc_flds ty_con) (partitionFieldLabels fls) let pat_syns = ps ++ ps_sels @@ -2379,28 +2379,29 @@ tc_export_with n ns fls = do assemble [] = panic "partitionFieldLabels" assemble fls@(fl:_) = (flLabel fl, map flSelector fls) - -- This is only used for normal record field labels - tc_flds :: Type -> TyCon -> (FastString, [Name]) -> TcM () - tc_flds actual_res_ty ty_con (fs, flds) = do + dcErrMsg :: Outputable a => TyCon -> String -> a -> [SDoc] -> SDoc + dcErrMsg ty_con what_is thing parents = + let capitalise [] = [] + capitalise (c:cs) = toUpper c : cs + in + text "The type constructor" <+> quotes (ppr ty_con) + <+> text "is not the parent of the" <+> text what_is + <+> quotes (ppr thing) <> char '.' + $$ text (capitalise what_is) <> text "s can only be exported with their parent type constructor." + $$ (case parents of + [] -> empty + [_] -> text "Parent:" + _ -> text "Parents:") <+> fsep (punctuate comma parents) + + -- This is only used for normal record field labels + tc_flds :: TyCon -> (FastString, [Name]) -> TcM () + tc_flds ty_con (fs, flds) = do fldIds <- mapM tcLookupId flds traceTc "tc_flds" (ppr fldIds) - - case fldIds of - [] -> return () - -- If there is just one, fall back to the original checks - [fldId] -> case idDetails fldId of - RecSelId { sel_tycon = RecSelData p } -> - tc_one_dc_export_with ty_con ("record selector", fldId, p) - _ -> panic "tc_flds" - fldIds -> - let parents = [tc | i <- fldIds, RecSelId { sel_tycon = RecSelData tc } - <- [idDetails i]] in - unless (any (ty_con ==) parents) $ - let - errMsg = quotes (ppr fs) <+> text "is not a label" - <+> text "the type constructor" <+> quotes (ppr ty_con) <> char '.' - $$ text "Parents:" <+> fsep (punctuate comma (map ppr parents)) - in addErrTc errMsg + let parents = [tc | i <- fldIds, RecSelId { sel_tycon = RecSelData tc } + <- [idDetails i]] + unless (any (ty_con ==) parents) $ + addErrTc (dcErrMsg ty_con "record selector" fs (map ppr parents)) @@ -2410,19 +2411,10 @@ tc_export_with n ns fls = do -- Check whether a data constructor is exported with its parent. tc_one_dc_export_with :: Outputable a => - TyCon -> (String, a, TyCon) -> TcM () - tc_one_dc_export_with ty_con (what_is, thing, tc) = - let capitalise [] = [] - capitalise (c:cs) = toUpper c : cs - errMsg = text "The type constructor" <+> quotes (ppr ty_con) - <+> text "is not the parent of the" <+> text what_is - <+> quotes (ppr thing) <> char '.' - $$ text (capitalise what_is) <> text "s can only be exported with their parent type constructor." - $$ text "Parent:" <+> ppr tc - in - + TyCon -> (a, TyCon) -> TcM () + tc_one_dc_export_with ty_con (thing, tc) = unless (ty_con == tc) - (addErrTc errMsg) + (addErrTc (dcErrMsg ty_con "data constructor" thing [ppr tc])) diff --git a/testsuite/tests/overloadedrecflds/should_fail/NoParent.hs b/testsuite/tests/overloadedrecflds/should_fail/NoParent.hs index f6d984d..2d05c47 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/NoParent.hs +++ b/testsuite/tests/overloadedrecflds/should_fail/NoParent.hs @@ -4,6 +4,3 @@ module NoParent (A(x)) where data A = A data B = B { x :: Int } data C = C { x :: String } - - - diff --git a/testsuite/tests/overloadedrecflds/should_fail/NoParent.stderr b/testsuite/tests/overloadedrecflds/should_fail/NoParent.stderr new file mode 100644 index 0000000..cea2b76 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NoParent.stderr @@ -0,0 +1,6 @@ + +NoParent.hs:2:18: error: + • The type constructor ‘A’ is not the parent of the record selector ‘x’. + Record selectors can only be exported with their parent type constructor. + Parents: C, B + • In the export: A(x, x) From git at git.haskell.org Fri Jun 17 20:10:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:10:59 +0000 (UTC) Subject: [commit: ghc] wip/T11970: test (47647d8) Message-ID: <20160617201059.53AF13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T11970 Link : http://ghc.haskell.org/trac/ghc/changeset/47647d889678bf5fe66e5d8ca7f8e225d40c5212/ghc >--------------------------------------------------------------- commit 47647d889678bf5fe66e5d8ca7f8e225d40c5212 Author: Matthew Pickering Date: Sat May 21 23:50:59 2016 +0100 test >--------------------------------------------------------------- 47647d889678bf5fe66e5d8ca7f8e225d40c5212 testsuite/tests/module/T11970.hs | 19 +++++++++++++++++++ testsuite/tests/module/T11970.stderr | 12 ++++++++++++ 2 files changed, 31 insertions(+) diff --git a/testsuite/tests/module/T11970.hs b/testsuite/tests/module/T11970.hs new file mode 100644 index 0000000..3c90c69 --- /dev/null +++ b/testsuite/tests/module/T11970.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PatternSynonyms #-} + +module T11970(B(recSel), Foo((--.->)), C(C,P,x,Q, B, recSel)) where + +pattern D = Nothing + +newtype B = B { recSel :: Int } + +class Foo a where + type (--.->) a + +newtype C = C Int + +pattern P x = C x + +pattern Q{x} = C x diff --git a/testsuite/tests/module/T11970.stderr b/testsuite/tests/module/T11970.stderr new file mode 100644 index 0000000..c6799a1 --- /dev/null +++ b/testsuite/tests/module/T11970.stderr @@ -0,0 +1,12 @@ + +T11970.hs:6:40: error: + • The type constructor ‘C’ is not the parent of the data constructor ‘B’. + Data constructors can only be exported with their parent type constructor. + Parent: B + • In the export: C(C, P, x, Q, B, recSel) + +T11970.hs:6:40: error: + • The type constructor ‘C’ is not the parent of the record selector ‘recSel’. + Record selectors can only be exported with their parent type constructor. + Parent: B + • In the export: C(C, P, x, Q, B, recSel) From git at git.haskell.org Fri Jun 17 20:11:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:11:01 +0000 (UTC) Subject: [commit: ghc] wip/T11970: Formatting and comments (143cde8) Message-ID: <20160617201101.F17133A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T11970 Link : http://ghc.haskell.org/trac/ghc/changeset/143cde8fc568da73171127f7bb67eda9c80383a5/ghc >--------------------------------------------------------------- commit 143cde8fc568da73171127f7bb67eda9c80383a5 Author: Matthew Pickering Date: Tue May 24 11:35:10 2016 +0100 Formatting and comments >--------------------------------------------------------------- 143cde8fc568da73171127f7bb67eda9c80383a5 compiler/rename/RnEnv.hs | 20 +++++++++++++------- compiler/typecheck/TcRnDriver.hs | 5 ++--- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 4965005..f34161b 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -571,7 +571,7 @@ lookupExportChild parent rdr_name overload_ok <- xoptM LangExt.DuplicateRecordFields - case (lookupGRE_RdrName rdr_name gre_env) of + case lookupGRE_RdrName rdr_name gre_env of [] -> return Nothing [x] -> return (Just ((:[]) <$> checkFld x)) xs -> Just <$> checkAmbig overload_ok rdr_name parent xs @@ -590,15 +590,21 @@ lookupExportChild parent rdr_name case mfs of Nothing -> let fs = occNameFS (nameOccName name) - in (FieldLabel fs False name) + in FieldLabel fs False name Just fs -> FieldLabel fs True name - checkAmbig :: Bool -> RdrName -> Name -> [GlobalRdrElt] -> RnM (Either Name [FieldLabel]) + checkAmbig :: Bool + -> RdrName + -> Name -- parent + -> [GlobalRdrElt] + -> RnM (Either Name [FieldLabel]) checkAmbig overload_ok rdr_name parent gres - | (all isRecFldGRE gres && overload_ok) - = return $ Right ([fldParentToFieldLabel (gre_name gre) mfs - | gre <- gres - , let FldParent _ mfs = gre_par gre ]) + | all isRecFldGRE + gres && overload_ok + = return $ + Right [fldParentToFieldLabel (gre_name gre) mfs + | gre <- gres + , let FldParent _ mfs = gre_par gre ] | Just gre <- disambigChildren rdr_name parent gres = return ((:[]) <$> checkFld gre) | otherwise = do diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index ff0f70b..70b24c5 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -2260,9 +2260,6 @@ loadUnqualIfaces hsc_env ictxt {- ****************************************************************************** ** Typechecking module exports -The renamer makes sure that only the correct pieces of a type or class can be -bundled with the type or class in the export list. - When it comes to pattern synonyms, in the renamer we have no way to check that whether a pattern synonym should be allowed to be bundled or not so we allow them to be bundled with any type or class. Here we then check that @@ -2272,6 +2269,8 @@ them to be bundled with any type or class. Here we then check that 2) Are the correct type, for example if P is a synonym then if we export Foo(P) then P should be an instance of Foo. +We also check for normal parent, children relationships here as well. + ****************************************************************************** -} From git at git.haskell.org Fri Jun 17 20:11:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:11:04 +0000 (UTC) Subject: [commit: ghc] wip/T11970: Formatting (5cfe5f4) Message-ID: <20160617201104.9EC433A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T11970 Link : http://ghc.haskell.org/trac/ghc/changeset/5cfe5f405b06459bd5d630e59aa3e4fa8351f7ba/ghc >--------------------------------------------------------------- commit 5cfe5f405b06459bd5d630e59aa3e4fa8351f7ba Author: Matthew Pickering Date: Tue May 24 11:22:22 2016 +0100 Formatting >--------------------------------------------------------------- 5cfe5f405b06459bd5d630e59aa3e4fa8351f7ba compiler/rename/RnNames.hs | 3 ++- compiler/typecheck/TcRnDriver.hs | 7 ++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index c8eb5eb..2434bd9 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -1104,7 +1104,8 @@ lookupChildrenExport parent rdr_items = do let - doOne :: Located RdrName -> RnM (Either (Located Name) [Located FieldLabel]) + doOne :: Located RdrName + -> RnM (Either (Located Name) [Located FieldLabel]) doOne n = do let bareName = unLoc n diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index d55b5d6..ff0f70b 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -2350,9 +2350,10 @@ tc_export_with n ns fls = do let data_cons = [(c, dataConTyCon c) | AConLike (RealDataCon c) <- things ] ps = [(psErr p,p) | AConLike (PatSynCon p) <- things] - ps_sels = [(selErr i,p) | AnId i <- things - , isId i - , RecSelId {sel_tycon = RecSelPatSyn p} <- [idDetails i]] + ps_sels = [(selErr i,p) + | AnId i <- things + , isId i + , RecSelId {sel_tycon = RecSelPatSyn p} <- [idDetails i]] let actual_res_ty = mkTyConApp ty_con (mkTyVarTys (tyConTyVars ty_con)) From git at git.haskell.org Fri Jun 17 20:11:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:11:07 +0000 (UTC) Subject: [commit: ghc] wip/T11970: comment (436385a) Message-ID: <20160617201107.4B9833A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T11970 Link : http://ghc.haskell.org/trac/ghc/changeset/436385a34f89456912a47a1008ec6e8d05fbb01e/ghc >--------------------------------------------------------------- commit 436385a34f89456912a47a1008ec6e8d05fbb01e Author: Matthew Pickering Date: Tue May 24 11:35:42 2016 +0100 comment >--------------------------------------------------------------- 436385a34f89456912a47a1008ec6e8d05fbb01e compiler/typecheck/TcRnDriver.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 70b24c5..728acd6 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -2269,7 +2269,7 @@ them to be bundled with any type or class. Here we then check that 2) Are the correct type, for example if P is a synonym then if we export Foo(P) then P should be an instance of Foo. -We also check for normal parent, children relationships here as well. +We also check for normal parent-child relationships here as well. ****************************************************************************** -} From git at git.haskell.org Fri Jun 17 20:11:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:11:10 +0000 (UTC) Subject: [commit: ghc] wip/T11970: Add test (5b21c23) Message-ID: <20160617201110.95D593A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T11970 Link : http://ghc.haskell.org/trac/ghc/changeset/5b21c23bd768b06e3ff6e1e58a865d9d34eea3f2/ghc >--------------------------------------------------------------- commit 5b21c23bd768b06e3ff6e1e58a865d9d34eea3f2 Author: Matthew Pickering Date: Sat Jun 11 22:11:44 2016 +0100 Add test >--------------------------------------------------------------- 5b21c23bd768b06e3ff6e1e58a865d9d34eea3f2 testsuite/tests/module/T11970A.hs | 5 +++++ testsuite/tests/module/T11970A.stderr | 5 +++++ testsuite/tests/module/T11970A1.hs | 3 +++ testsuite/tests/module/all.T | 1 + 4 files changed, 14 insertions(+) diff --git a/testsuite/tests/module/T11970A.hs b/testsuite/tests/module/T11970A.hs new file mode 100644 index 0000000..b20aa80 --- /dev/null +++ b/testsuite/tests/module/T11970A.hs @@ -0,0 +1,5 @@ +module T11970A ( Fail(a) ) where + +import T11970A1 ( Fail(a, b) ) + + diff --git a/testsuite/tests/module/T11970A.stderr b/testsuite/tests/module/T11970A.stderr new file mode 100644 index 0000000..6b478a7 --- /dev/null +++ b/testsuite/tests/module/T11970A.stderr @@ -0,0 +1,5 @@ +[1 of 2] Compiling T11970A1 ( T11970A1.hs, T11970A1.o ) +[2 of 2] Compiling T11970A ( T11970A.hs, T11970A.o ) + +T11970A.hs:3:1: warning: [-Wunused-imports (in -Wextra)] + The import of ‘Fail(b)’ from module ‘T11970A1’ is redundant diff --git a/testsuite/tests/module/T11970A1.hs b/testsuite/tests/module/T11970A1.hs new file mode 100644 index 0000000..6c9c6d2 --- /dev/null +++ b/testsuite/tests/module/T11970A1.hs @@ -0,0 +1,3 @@ +module T11970A1 where + +data Fail = Fail { a :: Int, b :: Int } diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T index 1158b29..10fc4d8 100644 --- a/testsuite/tests/module/all.T +++ b/testsuite/tests/module/all.T @@ -351,4 +351,5 @@ test('T11432', normal, compile_fail, ['']) test('T11432a', normal, compile_fail, ['']) test('T12026', normal, compile_fail, ['']) test('T11970', normal, compile_fail, ['']) +test('T11970A', [], multimod_compile, ['T11970A','-Wunused-imports']) test('MultiExport', normal, compile, ['']) From git at git.haskell.org Fri Jun 17 20:11:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:11:13 +0000 (UTC) Subject: [commit: ghc] wip/T11970: Record usages (98f54a7) Message-ID: <20160617201113.40FE53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T11970 Link : http://ghc.haskell.org/trac/ghc/changeset/98f54a75c217dbfcfc10c7e44b438e9313ac4626/ghc >--------------------------------------------------------------- commit 98f54a75c217dbfcfc10c7e44b438e9313ac4626 Author: Matthew Pickering Date: Sat Jun 11 22:11:56 2016 +0100 Record usages >--------------------------------------------------------------- 98f54a75c217dbfcfc10c7e44b438e9313ac4626 compiler/rename/RnEnv.hs | 9 +++++++-- testsuite/tests/module/T11970A.hs | 2 -- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index f34161b..c5b19d3 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -573,7 +573,9 @@ lookupExportChild parent rdr_name case lookupGRE_RdrName rdr_name gre_env of [] -> return Nothing - [x] -> return (Just ((:[]) <$> checkFld x)) + [x] -> do + addUsedGRE True x + return (Just ((:[]) <$> checkFld x)) xs -> Just <$> checkAmbig overload_ok rdr_name parent xs where @@ -599,6 +601,7 @@ lookupExportChild parent rdr_name -> [GlobalRdrElt] -> RnM (Either Name [FieldLabel]) checkAmbig overload_ok rdr_name parent gres + -- Don't record ambiguous selector usage | all isRecFldGRE gres && overload_ok = return $ @@ -606,7 +609,9 @@ lookupExportChild parent rdr_name | gre <- gres , let FldParent _ mfs = gre_par gre ] | Just gre <- disambigChildren rdr_name parent gres - = return ((:[]) <$> checkFld gre) + = do + addUsedGRE True gre + return ((:[]) <$> checkFld gre) | otherwise = do addNameClashErrRn rdr_name gres return (Left (gre_name (head gres))) diff --git a/testsuite/tests/module/T11970A.hs b/testsuite/tests/module/T11970A.hs index b20aa80..e9d6e95 100644 --- a/testsuite/tests/module/T11970A.hs +++ b/testsuite/tests/module/T11970A.hs @@ -1,5 +1,3 @@ module T11970A ( Fail(a) ) where import T11970A1 ( Fail(a, b) ) - - From git at git.haskell.org Fri Jun 17 20:20:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:20:12 +0000 (UTC) Subject: [commit: ghc] wip/T11970: Basic rip out (a836ca0) Message-ID: <20160617202012.2E9E63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T11970 Link : http://ghc.haskell.org/trac/ghc/changeset/a836ca040a65fdc147bcd05ea877856ab696a29a/ghc >--------------------------------------------------------------- commit a836ca040a65fdc147bcd05ea877856ab696a29a Author: Matthew Pickering Date: Thu May 12 21:58:58 2016 +0100 Basic rip out working Add test files tabs test Formatting Formatting and comments comment Add test Record usages >--------------------------------------------------------------- a836ca040a65fdc147bcd05ea877856ab696a29a compiler/basicTypes/Avail.hs | 38 ++------ compiler/basicTypes/RdrName.hs | 26 +++--- compiler/iface/LoadIface.hs | 2 +- compiler/iface/MkIface.hs | 2 +- compiler/main/HscTypes.hs | 2 +- compiler/rename/RnEnv.hs | 94 ++++++++++++++++++- compiler/rename/RnExpr.hs | 2 +- compiler/rename/RnNames.hs | 101 ++++++++++++++------- compiler/rename/RnPat.hs | 8 +- compiler/rename/RnSource.hs | 2 +- compiler/typecheck/TcRnDriver.hs | 90 ++++++++++++++---- testsuite/tests/module/MultiExport.hs | 6 ++ testsuite/tests/module/MultiExport.stderr | 3 + testsuite/tests/module/T11970.hs | 19 ++++ testsuite/tests/module/T11970.stderr | 12 +++ testsuite/tests/module/T11970A.hs | 3 + testsuite/tests/module/T11970A.stderr | 5 + testsuite/tests/module/T11970A1.hs | 3 + testsuite/tests/module/all.T | 3 + testsuite/tests/module/mod17.stderr | 8 +- testsuite/tests/module/mod3.stderr | 8 +- testsuite/tests/module/mod4.stderr | 6 +- .../overloadedrecflds/should_fail/NoParent.hs | 6 ++ .../overloadedrecflds/should_fail/NoParent.stderr | 6 ++ .../tests/overloadedrecflds/should_fail/all.T | 1 + 25 files changed, 340 insertions(+), 116 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 a836ca040a65fdc147bcd05ea877856ab696a29a From git at git.haskell.org Fri Jun 17 20:20:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:20:14 +0000 (UTC) Subject: [commit: ghc] wip/T11970's head updated: Basic rip out (a836ca0) Message-ID: <20160617202014.48AE13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T11970' now includes: 6ace660 rts: Fix build when USE_LARGE_ADDRESS_SPACE is undefined 9130867 Skip retc001 on OSX a836ca0 Basic rip out From git at git.haskell.org Fri Jun 17 20:23:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:23:50 +0000 (UTC) Subject: [commit: ghc] wip/T11970: Basic rip out (4b3d52b) Message-ID: <20160617202350.A16313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T11970 Link : http://ghc.haskell.org/trac/ghc/changeset/4b3d52b745d5789fb9543ba11b971595ca16020d/ghc >--------------------------------------------------------------- commit 4b3d52b745d5789fb9543ba11b971595ca16020d Author: Matthew Pickering Date: Thu May 12 21:58:58 2016 +0100 Basic rip out working Add test files tabs test Formatting Formatting and comments comment Add test Record usages >--------------------------------------------------------------- 4b3d52b745d5789fb9543ba11b971595ca16020d compiler/basicTypes/Avail.hs | 38 ++------ compiler/basicTypes/RdrName.hs | 26 +++--- compiler/iface/LoadIface.hs | 2 +- compiler/iface/MkIface.hs | 2 +- compiler/main/HscTypes.hs | 2 +- compiler/rename/RnEnv.hs | 94 ++++++++++++++++++- compiler/rename/RnExpr.hs | 2 +- compiler/rename/RnNames.hs | 101 ++++++++++++++------- compiler/rename/RnPat.hs | 8 +- compiler/rename/RnSource.hs | 2 +- compiler/typecheck/TcRnDriver.hs | 90 ++++++++++++++---- testsuite/tests/module/MultiExport.hs | 6 ++ testsuite/tests/module/MultiExport.stderr | 3 + testsuite/tests/module/T11970.hs | 19 ++++ testsuite/tests/module/T11970.stderr | 12 +++ testsuite/tests/module/T11970A.hs | 3 + testsuite/tests/module/T11970A.stderr | 5 + testsuite/tests/module/T11970A1.hs | 3 + testsuite/tests/module/all.T | 3 + testsuite/tests/module/mod17.stderr | 8 +- testsuite/tests/module/mod3.stderr | 8 +- testsuite/tests/module/mod4.stderr | 6 +- .../overloadedrecflds/should_fail/NoParent.hs | 6 ++ .../overloadedrecflds/should_fail/NoParent.stderr | 6 ++ .../tests/overloadedrecflds/should_fail/all.T | 1 + 25 files changed, 340 insertions(+), 116 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 4b3d52b745d5789fb9543ba11b971595ca16020d From git at git.haskell.org Fri Jun 17 20:23:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 20:23:52 +0000 (UTC) Subject: [commit: ghc] wip/T11970's head updated: Basic rip out (4b3d52b) Message-ID: <20160617202352.D98FC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T11970' now includes: b40e1b4 Fix incorrect calculated relocations on Windows x86_64 29e1464 Disable T12031 on linux 2bb6ba6 rts: Fix NUMA when cross compiling d25cb61 Kill off redundant SigTv check in occurCheckExpand 15b9bf4 Improve typechecking of let-bindings c28dde3 Tidy up zonkQuantifiedTyVar 7afb7ad Get in-scope set right in top_instantiate 35c9de7 Move the constraint-kind validity check 1f66128 Beef up mkNakedCastTy 15fc528 Fix the in-scope set for extendTvSubstWithClone 599d912 Beef up isPredTy 8104f7c Remove some traceTc calls e064f50 Add to .gitignore 921ebc9 Test Trac #12055 1dcb32d A second test for Trac #12055 5cee88d Add thin library support to Windows too 7de776c Kill unused foldModuleEnv 586d558 Use UniqFM for SigOf 0497ee5 Make the Ord Module independent of Unique order d55a9b4 Update Haddock to follow change in LHsSigWcType 4f35646 Adjust error message slightly 8dfd4ae Build system: mention ghc version in bindist's `configure --help` docdir a2deee0 Testsuite: enable ghci.prog010 (#2542) 23b73c9 Don't GC sparks for CAFs 9d22fbe Rename cmpType to nonDetCmpType 753c5b2 Simplify readProcessEnvWithExitCode + set LANGUAGE=C 70a4589 Revert "Make the Ord Module independent of Unique order" e33ca0e Fix testsuite wibble 77bb092 Re-add FunTy (big patch) e368f32 Major patch to introduce TyConBinder c56f8bd CoreMonad: Update error msg function docs 930a525 Abort the build when a Core plugin pass is specified in stage1 compiler a7f65b8 Remove dead code: countOnce, countMany 498ed26 NUMA cleanups 4b3d52b Basic rip out From git at git.haskell.org Fri Jun 17 21:20:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 17 Jun 2016 21:20:09 +0000 (UTC) Subject: [commit: ghc] master: CoreLint: Slightly improve case type annotation error msgs (8d33af9) Message-ID: <20160617212009.617823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8d33af90d20c86bc63f1fa155583daa9a52d42bc/ghc >--------------------------------------------------------------- commit 8d33af90d20c86bc63f1fa155583daa9a52d42bc Author: Ömer Sinan Ağacan Date: Fri Jun 17 21:23:15 2016 +0000 CoreLint: Slightly improve case type annotation error msgs >--------------------------------------------------------------- 8d33af90d20c86bc63f1fa155583daa9a52d42bc compiler/coreSyn/CoreLint.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 36a7e2b..d905b8c 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1909,7 +1909,9 @@ mkDefaultArgsMsg args mkCaseAltMsg :: CoreExpr -> Type -> Type -> MsgDoc mkCaseAltMsg e ty1 ty2 = hang (text "Type of case alternatives not the same as the annotation on case:") - 4 (vcat [ppr ty1, ppr ty2, ppr e]) + 4 (vcat [ text "Actual type:" <+> ppr ty1, + text "Annotation on case:" <+> ppr ty2, + text "Alt Rhs:" <+> ppr e ]) mkScrutMsg :: Id -> Type -> Type -> TCvSubst -> MsgDoc mkScrutMsg var var_ty scrut_ty subst From git at git.haskell.org Sat Jun 18 10:39:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 10:39:21 +0000 (UTC) Subject: [commit: ghc] master: CmmNode: Make CmmTickScope's Unique strict (3e8c495) Message-ID: <20160618103921.BB1A03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3e8c495f2e6557c85c65c7fc91113f45b010d333/ghc >--------------------------------------------------------------- commit 3e8c495f2e6557c85c65c7fc91113f45b010d333 Author: Ben Gamari Date: Fri Jun 17 21:29:56 2016 +0200 CmmNode: Make CmmTickScope's Unique strict There is no reason why we need laziness here and making it strict enables unpacking. >--------------------------------------------------------------- 3e8c495f2e6557c85c65c7fc91113f45b010d333 compiler/cmm/CmmNode.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs index c93639c..b2e5cfb 100644 --- a/compiler/cmm/CmmNode.hs +++ b/compiler/cmm/CmmNode.hs @@ -581,7 +581,7 @@ data CmmTickScope -- to add ticks to this scope. On the other hand, this means that -- setting this scope on a block means no ticks apply to it. - | SubScope U.Unique CmmTickScope + | SubScope !U.Unique CmmTickScope -- ^ Constructs a new sub-scope to an existing scope. This allows -- us to translate Core-style scoping rules (see @tickishScoped@) -- into the Cmm world. Suppose the following code: From git at git.haskell.org Sat Jun 18 10:39:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 10:39:24 +0000 (UTC) Subject: [commit: ghc] master: llvmGen: Make metadata ids a newtype (2396d9b) Message-ID: <20160618103924.5EF783A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2396d9bb76c11775589fc91b362a61c4a92d27fa/ghc >--------------------------------------------------------------- commit 2396d9bb76c11775589fc91b362a61c4a92d27fa Author: Ben Gamari Date: Fri Jun 17 22:57:38 2016 +0200 llvmGen: Make metadata ids a newtype These were previously just represented as Ints which was needlessly vague. >--------------------------------------------------------------- 2396d9bb76c11775589fc91b362a61c4a92d27fa compiler/llvmGen/Llvm.hs | 2 +- compiler/llvmGen/Llvm/MetaData.hs | 17 +++++++++++++---- compiler/llvmGen/Llvm/PpLlvm.hs | 11 +++++------ compiler/llvmGen/LlvmCodeGen.hs | 2 +- compiler/llvmGen/LlvmCodeGen/Base.hs | 18 ++++++++++-------- 5 files changed, 30 insertions(+), 20 deletions(-) diff --git a/compiler/llvmGen/Llvm.hs b/compiler/llvmGen/Llvm.hs index b245422..8104a3a 100644 --- a/compiler/llvmGen/Llvm.hs +++ b/compiler/llvmGen/Llvm.hs @@ -42,7 +42,7 @@ module Llvm ( i64, i32, i16, i8, i1, i8Ptr, llvmWord, llvmWordPtr, -- ** Metadata types - MetaExpr(..), MetaAnnot(..), MetaDecl(..), + MetaExpr(..), MetaAnnot(..), MetaDecl(..), MetaId(..), -- ** Operations on the type system. isGlobal, getLitType, getVarType, diff --git a/compiler/llvmGen/Llvm/MetaData.hs b/compiler/llvmGen/Llvm/MetaData.hs index e1e63c9..a50553c 100644 --- a/compiler/llvmGen/Llvm/MetaData.hs +++ b/compiler/llvmGen/Llvm/MetaData.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + module Llvm.MetaData where import Llvm.Types @@ -55,16 +57,23 @@ import Outputable -- !llvm.module.linkage = !{ !0, !1 } -- +-- | A reference to an un-named metadata node. +newtype MetaId = MetaId Int + deriving (Eq, Ord, Enum) + +instance Outputable MetaId where + ppr (MetaId n) = char '!' <> int n + -- | LLVM metadata expressions data MetaExpr = MetaStr LMString - | MetaNode Int + | MetaNode MetaId | MetaVar LlvmVar | MetaStruct [MetaExpr] deriving (Eq) instance Outputable MetaExpr where ppr (MetaStr s ) = text "!\"" <> ftext s <> char '"' - ppr (MetaNode n ) = text "!" <> int n + ppr (MetaNode n ) = ppr n ppr (MetaVar v ) = ppr v ppr (MetaStruct es) = text "!{ " <> ppCommaJoin es <> char '}' @@ -77,7 +86,7 @@ data MetaAnnot = MetaAnnot LMString MetaExpr data MetaDecl -- | Named metadata. Only used for communicating module information to -- LLVM. ('!name = !{ [!] }' form). - = MetaNamed LMString [Int] + = MetaNamed LMString [MetaId] -- | Metadata node declaration. -- ('!0 = metadata !{ }' form). - | MetaUnamed Int MetaExpr + | MetaUnnamed MetaId MetaExpr diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs index cdaf962..d92e3c0 100644 --- a/compiler/llvmGen/Llvm/PpLlvm.hs +++ b/compiler/llvmGen/Llvm/PpLlvm.hs @@ -106,20 +106,19 @@ ppLlvmMetas metas = vcat $ map ppLlvmMeta metas -- | Print out an LLVM metadata definition. ppLlvmMeta :: MetaDecl -> SDoc -ppLlvmMeta (MetaUnamed n m) - = exclamation <> int n <> text " = " <> ppLlvmMetaExpr m +ppLlvmMeta (MetaUnnamed n m) + = ppr n <> text " = " <> ppLlvmMetaExpr m ppLlvmMeta (MetaNamed n m) = exclamation <> ftext n <> text " = !" <> braces nodes where - nodes = hcat $ intersperse comma $ map pprNode m - pprNode n = exclamation <> int n + nodes = hcat $ intersperse comma $ map ppr m -- | Print out an LLVM metadata value. ppLlvmMetaExpr :: MetaExpr -> SDoc ppLlvmMetaExpr (MetaVar (LMLitVar (LMNullLit _))) = text "null" ppLlvmMetaExpr (MetaStr s ) = text "!" <> doubleQuotes (ftext s) -ppLlvmMetaExpr (MetaNode n ) = text "!" <> int n +ppLlvmMetaExpr (MetaNode n ) = ppr n ppLlvmMetaExpr (MetaVar v ) = ppr v ppLlvmMetaExpr (MetaStruct es) = text "!{" <> hsep (punctuate comma (map ppLlvmMetaExpr es)) <> char '}' @@ -489,7 +488,7 @@ ppMetaAnnots meta = hcat $ map ppMeta meta ppMeta (MetaAnnot name e) = comma <+> exclamation <> ftext name <+> case e of - MetaNode n -> exclamation <> int n + MetaNode n -> ppr n MetaStruct ms -> exclamation <> braces (ppCommaJoin ms) other -> exclamation <> braces (ppr other) -- possible? diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index fd13de6..c240d09 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -188,7 +188,7 @@ cmmMetaLlvmPrelude = do setUniqMeta uniq tbaaId parentId <- maybe (return Nothing) getUniqMeta parent -- Build definition - return $ MetaUnamed tbaaId $ MetaStruct + return $ MetaUnnamed tbaaId $ MetaStruct [ MetaStr name , case parentId of Just p -> MetaNode p diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs index 3e2b795..392c069 100644 --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -44,7 +44,7 @@ import CLabel import CodeGen.Platform ( activeStgRegs ) import DynFlags import FastString -import Cmm +import Cmm hiding ( succ ) import Outputable as Outp import qualified Pretty as Prt import Platform @@ -193,8 +193,8 @@ data LlvmEnv = LlvmEnv , envDynFlags :: DynFlags -- ^ Dynamic flags , envOutput :: BufHandle -- ^ Output buffer , envUniq :: UniqSupply -- ^ Supply of unique values - , envFreshMeta :: Int -- ^ Supply of fresh metadata IDs - , envUniqMeta :: UniqFM Int -- ^ Global metadata nodes + , envFreshMeta :: MetaId -- ^ Supply of fresh metadata IDs + , envUniqMeta :: UniqFM MetaId -- ^ Global metadata nodes , envFunMap :: LlvmEnvMap -- ^ Global functions so far, with type , envAliases :: UniqSet LMString -- ^ Globals that we had to alias, see [Llvm Forward References] , envUsedVars :: [LlvmVar] -- ^ Pointers to be added to llvm.used (see @cmmUsedLlvmGens@) @@ -256,7 +256,7 @@ runLlvm dflags ver out us m = do , envDynFlags = dflags , envOutput = out , envUniq = us - , envFreshMeta = 0 + , envFreshMeta = MetaId 0 , envUniqMeta = emptyUFM } @@ -301,8 +301,9 @@ checkStackReg :: GlobalReg -> LlvmM Bool checkStackReg r = getEnv ((elem r) . envStackRegs) -- | Allocate a new global unnamed metadata identifier -getMetaUniqueId :: LlvmM Int -getMetaUniqueId = LlvmM $ \env -> return (envFreshMeta env, env { envFreshMeta = envFreshMeta env + 1}) +getMetaUniqueId :: LlvmM MetaId +getMetaUniqueId = LlvmM $ \env -> + return (envFreshMeta env, env { envFreshMeta = succ $ envFreshMeta env }) -- | Get the LLVM version we are generating code for getLlvmVer :: LlvmM LlvmVersion @@ -350,10 +351,11 @@ saveAlias :: LMString -> LlvmM () saveAlias lbl = modifyEnv $ \env -> env { envAliases = addOneToUniqSet (envAliases env) lbl } -- | Sets metadata node for a given unique -setUniqMeta :: Unique -> Int -> LlvmM () +setUniqMeta :: Unique -> MetaId -> LlvmM () setUniqMeta f m = modifyEnv $ \env -> env { envUniqMeta = addToUFM (envUniqMeta env) f m } + -- | Gets metadata node for given unique -getUniqMeta :: Unique -> LlvmM (Maybe Int) +getUniqMeta :: Unique -> LlvmM (Maybe MetaId) getUniqMeta s = getEnv (flip lookupUFM s . envUniqMeta) -- ---------------------------------------------------------------------------- From git at git.haskell.org Sat Jun 18 10:39:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 10:39:27 +0000 (UTC) Subject: [commit: ghc] master: llvmGen: Consolidate MetaExpr pretty-printing (85e09b1) Message-ID: <20160618103927.0F8643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/85e09b1b621840fd923971d48df62b99580be618/ghc >--------------------------------------------------------------- commit 85e09b1b621840fd923971d48df62b99580be618 Author: Ben Gamari Date: Fri Jun 17 23:52:39 2016 +0200 llvmGen: Consolidate MetaExpr pretty-printing Previously this logic was duplicated needlessly. >--------------------------------------------------------------- 85e09b1b621840fd923971d48df62b99580be618 compiler/llvmGen/Llvm/MetaData.hs | 5 +++-- compiler/llvmGen/Llvm/PpLlvm.hs | 13 ++----------- 2 files changed, 5 insertions(+), 13 deletions(-) diff --git a/compiler/llvmGen/Llvm/MetaData.hs b/compiler/llvmGen/Llvm/MetaData.hs index a50553c..3bdcd60 100644 --- a/compiler/llvmGen/Llvm/MetaData.hs +++ b/compiler/llvmGen/Llvm/MetaData.hs @@ -72,10 +72,11 @@ data MetaExpr = MetaStr LMString deriving (Eq) instance Outputable MetaExpr where - ppr (MetaStr s ) = text "!\"" <> ftext s <> char '"' + ppr (MetaVar (LMLitVar (LMNullLit _))) = text "null" + ppr (MetaStr s ) = char '!' <> doubleQuotes (ftext s) ppr (MetaNode n ) = ppr n ppr (MetaVar v ) = ppr v - ppr (MetaStruct es) = text "!{ " <> ppCommaJoin es <> char '}' + ppr (MetaStruct es) = char '!' <> braces (ppCommaJoin es) -- | Associates some metadata with a specific label for attaching to an -- instruction. diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs index d92e3c0..47e26ab 100644 --- a/compiler/llvmGen/Llvm/PpLlvm.hs +++ b/compiler/llvmGen/Llvm/PpLlvm.hs @@ -107,22 +107,13 @@ ppLlvmMetas metas = vcat $ map ppLlvmMeta metas -- | Print out an LLVM metadata definition. ppLlvmMeta :: MetaDecl -> SDoc ppLlvmMeta (MetaUnnamed n m) - = ppr n <> text " = " <> ppLlvmMetaExpr m + = ppr n <+> equals <+> ppr m ppLlvmMeta (MetaNamed n m) - = exclamation <> ftext n <> text " = !" <> braces nodes + = exclamation <> ftext n <+> equals <+> exclamation <> braces nodes where nodes = hcat $ intersperse comma $ map ppr m --- | Print out an LLVM metadata value. -ppLlvmMetaExpr :: MetaExpr -> SDoc -ppLlvmMetaExpr (MetaVar (LMLitVar (LMNullLit _))) = text "null" -ppLlvmMetaExpr (MetaStr s ) = text "!" <> doubleQuotes (ftext s) -ppLlvmMetaExpr (MetaNode n ) = ppr n -ppLlvmMetaExpr (MetaVar v ) = ppr v -ppLlvmMetaExpr (MetaStruct es) = - text "!{" <> hsep (punctuate comma (map ppLlvmMetaExpr es)) <> char '}' - -- | Print out a list of function definitions. ppLlvmFunctions :: LlvmFunctions -> SDoc From git at git.haskell.org Sat Jun 18 10:40:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 10:40:25 +0000 (UTC) Subject: [commit: packages/hpc] master: Testsuite: run tests in -run instead of /tmp (b52ab0c) Message-ID: <20160618104025.01E713A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/b52ab0cc013beb1440607a7e4521a45fd6e96ce8 >--------------------------------------------------------------- commit b52ab0cc013beb1440607a7e4521a45fd6e96ce8 Author: Thomas Miedema Date: Mon Jun 13 17:47:16 2016 +0200 Testsuite: run tests in -run instead of /tmp >--------------------------------------------------------------- b52ab0cc013beb1440607a7e4521a45fd6e96ce8 tests/fork/test.T | 2 +- tests/function/test.T | 2 +- tests/function2/test.T | 2 +- tests/raytrace/test.T | 2 +- tests/raytrace/tixs/test.T | 6 +++--- tests/simple/test.T | 2 +- 6 files changed, 8 insertions(+), 8 deletions(-) diff --git a/tests/fork/test.T b/tests/fork/test.T index cd8b963..936557d 100644 --- a/tests/fork/test.T +++ b/tests/fork/test.T @@ -1,6 +1,6 @@ setTestOpts([omit_ways(['ghci','threaded2']), when(fast(), skip)]) -hpc_prefix = "perl ../hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" +hpc_prefix = "perl hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" test('hpc_fork', [ when(opsys('mingw32'), skip), # no forkProcess on Windows cmd_prefix(hpc_prefix) ], compile_and_run, ['-fhpc']) diff --git a/tests/function/test.T b/tests/function/test.T index 15bf7b2..a5515d9 100644 --- a/tests/function/test.T +++ b/tests/function/test.T @@ -1,6 +1,6 @@ setTestOpts([omit_ways(['ghci']), when(fast(), skip)]) -hpc_prefix = "perl ../hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" +hpc_prefix = "perl hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" test('tough', [cmd_prefix(hpc_prefix), diff --git a/tests/function2/test.T b/tests/function2/test.T index 52d78fb..b37cc40 100644 --- a/tests/function2/test.T +++ b/tests/function2/test.T @@ -1,6 +1,6 @@ setTestOpts([omit_ways(['ghci']), when(fast(), skip)]) -hpc_prefix = "perl ../hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" +hpc_prefix = "perl hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" # Test that -fhpc still works when (a) the source file is in a # subdirectory and (b) it is a literate file. We had a bug in this diff --git a/tests/raytrace/test.T b/tests/raytrace/test.T index a65423c..2f4e51a 100644 --- a/tests/raytrace/test.T +++ b/tests/raytrace/test.T @@ -1,6 +1,6 @@ setTestOpts([omit_ways(['ghci']), when(fast(), skip)]) -hpc_prefix = "perl ../hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" +hpc_prefix = "perl hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" # TODO. It is unclear what the purpose of this test is. It produces lots of # output, but the expected output file is missing. I (thomie) added diff --git a/tests/raytrace/tixs/test.T b/tests/raytrace/tixs/test.T index 542734d..9df587f 100644 --- a/tests/raytrace/tixs/test.T +++ b/tests/raytrace/tixs/test.T @@ -8,13 +8,13 @@ test('hpc_report_multi_003', normal, run_command, ["{hpc} report hpc_sample --include=Geometry --per-module --decl-list"]) test('hpc_markup_multi_001', extra_clean(['markup_multi_001/*']), run_command, - ["{hpc} markup --srcdir=.. --hpcdir=tixs/.hpc --hpcdir=hpc_markup_multi_001/.hpc --destdir=markup_multi_001" + ["{hpc} markup --hpcdir=tixs/.hpc --hpcdir=hpc_markup_multi_001/.hpc --destdir=markup_multi_001" " hpc_sample --include=Geometry"]) test('hpc_markup_multi_002', extra_clean(['markup_multi_002/*']), run_command, - ["{hpc} markup --srcdir=.. --hpcdir=tixs/.hpc --hpcdir=hpc_markup_multi_002/.hpc --destdir=markup_multi_002" + ["{hpc} markup --hpcdir=tixs/.hpc --hpcdir=hpc_markup_multi_002/.hpc --destdir=markup_multi_002" " hpc_sample --exclude=Geometry"]) test('hpc_markup_multi_003', extra_clean(['markup_multi_003/*']), run_command, - ["{hpc} markup --srcdir=.. --hpcdir=tixs/.hpc --hpcdir=hpc_markup_multi_003/.hpc --destdir=markup_multi_003" + ["{hpc} markup --hpcdir=tixs/.hpc --hpcdir=hpc_markup_multi_003/.hpc --destdir=markup_multi_003" " hpc_sample --fun-entry-count"]) test('hpc_show_multi_001', normal, run_command, diff --git a/tests/simple/test.T b/tests/simple/test.T index 521d7bf..375a97a 100644 --- a/tests/simple/test.T +++ b/tests/simple/test.T @@ -1,6 +1,6 @@ setTestOpts([omit_ways(['ghci']), when(fast(), skip)]) -hpc_prefix = "perl ../hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" +hpc_prefix = "perl hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" test('hpc001', cmd_prefix(hpc_prefix), compile_and_run, ['-fhpc']) From git at git.haskell.org Sat Jun 18 10:48:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 10:48:40 +0000 (UTC) Subject: [commit: ghc] master: Revert accidental submodule updates (9bb0578) Message-ID: <20160618104840.5AF053A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9bb05785a7ac3ea8d2589173505891e75163d66b/ghc >--------------------------------------------------------------- commit 9bb05785a7ac3ea8d2589173505891e75163d66b Author: Thomas Miedema Date: Fri Jun 17 17:37:37 2016 +0200 Revert accidental submodule updates Commit 77bb09270c70455bbd547470c4e995707d19f37d seems to have accidentally set some submodules to earlier versions. Undo this. >--------------------------------------------------------------- 9bb05785a7ac3ea8d2589173505891e75163d66b libraries/Win32 | 2 +- libraries/bytestring | 2 +- libraries/hpc | 2 +- libraries/time | 2 +- libraries/vector | 2 +- nofib | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/libraries/Win32 b/libraries/Win32 index fec966e6..bb9469e 160000 --- a/libraries/Win32 +++ b/libraries/Win32 @@ -1 +1 @@ -Subproject commit fec966e6d77a5e7f4a586de6096954137a1fe914 +Subproject commit bb9469ece0b882017fa7f3b51e8db1d2985d6720 diff --git a/libraries/bytestring b/libraries/bytestring index 3d6d0f6..84253da 160000 --- a/libraries/bytestring +++ b/libraries/bytestring @@ -1 +1 @@ -Subproject commit 3d6d0f60ac25736cc87a6f598886fe77e7b6ad90 +Subproject commit 84253da85952765dd7631e467cc2b1d1bba03f24 diff --git a/libraries/hpc b/libraries/hpc index fbe2b7b..d8b5381 160000 --- a/libraries/hpc +++ b/libraries/hpc @@ -1 +1 @@ -Subproject commit fbe2b7b9e163daa8fbe3c8f2dddc1132aa4e735f +Subproject commit d8b5381bd5d03a3a75f4a1b91f1ede6fe0fd0ce9 diff --git a/libraries/time b/libraries/time index a73564c..52e0f5e 160000 --- a/libraries/time +++ b/libraries/time @@ -1 +1 @@ -Subproject commit a73564c366b15f7057b614188662d7b7a8eaab19 +Subproject commit 52e0f5e85ffbaab77b155d48720fb216021c8a73 diff --git a/libraries/vector b/libraries/vector index 6c17dd6..224eccb 160000 --- a/libraries/vector +++ b/libraries/vector @@ -1 +1 @@ -Subproject commit 6c17dd6fadc5e7e3e09f7892380ce1339f296efd +Subproject commit 224eccbac0125b7bd302f24063bbb473b2c2e1dc diff --git a/nofib b/nofib index dfa9f91..35fc121 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit dfa9f9158943d2c441add8ccd4309c1b93fb347a +Subproject commit 35fc121fc8cc501ea2713c579a053be7ea65b16e From git at git.haskell.org Sat Jun 18 10:48:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 10:48:43 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: write "\n" instead of "\r\n" when using mingw Python (6f6f515) Message-ID: <20160618104843.056813A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f6f515401a29d26eaa5daae308b8e700abd4c04/ghc >--------------------------------------------------------------- commit 6f6f515401a29d26eaa5daae308b8e700abd4c04 Author: Thomas Miedema Date: Fri Jun 17 15:23:34 2016 +0200 Testsuite: write "\n" instead of "\r\n" when using mingw Python Mingw style Python uses '\r\n' by default for newlines. This is annoying, because it means that when a GHC developer on Windows uses mingw Python to `make accept` a test, every single line of the .stderr file is touched. This makes it difficult to spot the real changes, and it leads to unnecessary git history bloat. Prevent this from happening by using io.open instead of open. See `Note [Universal newlines]` Reviewed by: Phyx Differential Revision: https://phabricator.haskell.org/D2342 >--------------------------------------------------------------- 6f6f515401a29d26eaa5daae308b8e700abd4c04 libraries/base/tests/IO/readwrite003.hs | 1 + testsuite/driver/runtests.py | 2 +- testsuite/driver/testlib.py | 43 ++++++++++++++++++++++++--------- 3 files changed, 34 insertions(+), 12 deletions(-) diff --git a/libraries/base/tests/IO/readwrite003.hs b/libraries/base/tests/IO/readwrite003.hs index d7ee78d..c8995e3 100644 --- a/libraries/base/tests/IO/readwrite003.hs +++ b/libraries/base/tests/IO/readwrite003.hs @@ -9,4 +9,5 @@ main = do hPutStrLn h "yz" hClose h h <- openBinaryFile file ReadMode + hSetNewlineMode stdout noNewlineTranslation hGetContents h >>= putStr diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 33b432f..917003b 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -162,7 +162,7 @@ if windows: # Try to use UTF8 if windows: import ctypes - # Windows Python provides windll, mingw python provides cdll. + # Windows and mingw* Python provide windll, msys2 python provides cdll. if hasattr(ctypes, 'windll'): mydll = ctypes.windll else: diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 32b6951..ced16d1 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -5,6 +5,7 @@ from __future__ import print_function +import io import shutil import sys import os @@ -1466,16 +1467,15 @@ def interpreter_run( name, way, extra_hc_opts, compile_only, top_mod ): def split_file(in_fn, delimiter, out1_fn, out2_fn): - infile = open(in_fn) - out1 = open(out1_fn, 'w') - out2 = open(out2_fn, 'w') + # See Note [Universal newlines]. + infile = io.open(in_fn, 'r', encoding='utf8', newline=None) + out1 = io.open(out1_fn, 'w', encoding='utf8', newline='') + out2 = io.open(out2_fn, 'w', encoding='utf8', newline='') line = infile.readline() - line = re.sub('\r', '', line) # ignore Windows EOL while (re.sub('^\s*','',line) != delimiter and line != ''): out1.write(line) line = infile.readline() - line = re.sub('\r', '', line) out1.close() line = infile.readline() @@ -1538,20 +1538,41 @@ def dump_stderr( name ): def read_no_crs(file): str = '' try: - h = open(file) + # See Note [Universal newlines]. + h = io.open(file, 'r', encoding='utf8', newline=None) str = h.read() h.close except: # On Windows, if the program fails very early, it seems the # files stdout/stderr are redirected to may not get created pass - return re.sub('\r', '', str) + return str def write_file(file, str): - h = open(file, 'w') + # See Note [Universal newlines]. + h = io.open(file, 'w', encoding='utf8', newline='') h.write(str) h.close +# Note [Universal newlines] +# +# We don't want to write any Windows style line endings ever, because +# it would mean that `make accept` would touch every line of the file +# when switching between Linux and Windows. +# +# Furthermore, when reading a file, it is convenient to translate all +# Windows style endings to '\n', as it simplifies searching or massaging +# the content. +# +# Solution: use `io.open` instead of `open` +# * when reading: use newline=None to translate '\r\n' to '\n' +# * when writing: use newline='' to not translate '\n' to '\r\n' +# +# See https://docs.python.org/2/library/io.html#io.open. +# +# This should work with both python2 and python3, and with both mingw* +# as msys2 style Python. + def check_hp_ok(name): opts = getTestOpts() @@ -1681,7 +1702,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 u' '.join(w for w in str.split()) callSite_re = re.compile(r', called at (.+):[\d]+:[\d]+ in [\w\-\.]+:') @@ -1825,7 +1846,7 @@ def normalise_asm( str ): out.append(instr[0] + ' ' + instr[1]) else: out.append(instr[0]) - out = '\n'.join(out) + out = u'\n'.join(out) return out def if_verbose( n, s ): @@ -2115,7 +2136,7 @@ def printFrameworkFailureSummary(file, testInfos): file.write('\n') def modify_lines(s, f): - s = '\n'.join([f(l) for l in s.splitlines()]) + s = u'\n'.join([f(l) for l in s.splitlines()]) if s and s[-1] != '\n': # Prevent '\ No newline at end of file' warnings when diffing. s += '\n' From git at git.haskell.org Sat Jun 18 10:48:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 10:48:45 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: run tests in .run instead of /tmp (f72f23f) Message-ID: <20160618104845.AB2253A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f72f23f9f6ff2914ec99fc86f67c89927f18ba47/ghc >--------------------------------------------------------------- commit f72f23f9f6ff2914ec99fc86f67c89927f18ba47 Author: Thomas Miedema Date: Wed Jun 15 16:57:05 2016 +0200 Testsuite: run tests in .run instead of /tmp As discussed in Phab:D1187, this approach makes it a bit easier to inspect the test directory while working on a new test. The only tests that needed changes are the ones that refer to files in ancestor directories. Those files are now copied directly into the test directory. validate still runs the tests in a temporary directory in /tmp, see `Note [Running tests in /tmp]` in testsuite/driver/runtests.py. Update submodule hpc. Reviewed by: simonmar Differential Revision: https://phabricator.haskell.org/D2333 GHC Trac Issues: #11980 >--------------------------------------------------------------- f72f23f9f6ff2914ec99fc86f67c89927f18ba47 .gitignore | 3 + libraries/hpc | 2 +- testsuite/config/ghc | 1 - testsuite/driver/runtests.py | 50 ++++++++++++++- testsuite/driver/testglobals.py | 6 ++ testsuite/driver/testlib.py | 48 ++++++--------- testsuite/mk/test.mk | 15 ++++- testsuite/tests/ghci.debugger/scripts/all.T | 4 +- .../tests/ghci.debugger/scripts/break001.script | 2 +- .../tests/ghci.debugger/scripts/break001.stdout | 8 +-- .../tests/ghci.debugger/scripts/break002.script | 2 +- .../tests/ghci.debugger/scripts/break003.script | 2 +- .../tests/ghci.debugger/scripts/break003.stdout | 4 +- .../tests/ghci.debugger/scripts/break004.script | 2 +- .../tests/ghci.debugger/scripts/break005.script | 2 +- .../tests/ghci.debugger/scripts/break005.stdout | 4 +- .../tests/ghci.debugger/scripts/break006.script | 2 +- .../tests/ghci.debugger/scripts/break006.stdout | 2 +- .../tests/ghci.debugger/scripts/break008.script | 4 +- .../tests/ghci.debugger/scripts/break008.stdout | 4 +- .../tests/ghci.debugger/scripts/break009.script | 4 +- .../tests/ghci.debugger/scripts/break009.stdout | 4 +- .../tests/ghci.debugger/scripts/break010.script | 2 +- .../tests/ghci.debugger/scripts/break010.stdout | 6 +- .../tests/ghci.debugger/scripts/break011.script | 2 +- .../tests/ghci.debugger/scripts/break011.stdout | 22 +++---- .../tests/ghci.debugger/scripts/break017.script | 2 +- .../tests/ghci.debugger/scripts/break017.stdout | 2 +- .../tests/ghci.debugger/scripts/break018.script | 2 +- .../tests/ghci.debugger/scripts/break018.stdout | 6 +- .../tests/ghci.debugger/scripts/break019.script | 2 +- .../tests/ghci.debugger/scripts/break027.script | 2 +- .../tests/ghci.debugger/scripts/break027.stdout | 6 +- .../tests/ghci.debugger/scripts/dynbrk001.script | 2 +- .../tests/ghci.debugger/scripts/dynbrk002.script | 2 +- .../tests/ghci.debugger/scripts/dynbrk002.stdout | 4 +- .../tests/ghci.debugger/scripts/dynbrk004.script | 2 +- .../tests/ghci.debugger/scripts/dynbrk004.stdout | 8 +-- .../tests/ghci.debugger/scripts/getargs.script | 2 +- .../tests/ghci.debugger/scripts/getargs.stdout | 2 +- .../tests/ghci.debugger/scripts/hist001.script | 2 +- .../tests/ghci.debugger/scripts/hist001.stdout | 24 ++++---- .../ghci.debugger/scripts/listCommand001.script | 2 +- .../tests/ghci.debugger/scripts/print002.script | 2 +- .../tests/ghci.debugger/scripts/print003.script | 2 +- .../tests/ghci.debugger/scripts/print005.script | 2 +- .../tests/ghci.debugger/scripts/print005.stdout | 6 +- .../tests/ghci.debugger/scripts/print006.script | 2 +- .../tests/ghci.debugger/scripts/print007.script | 6 +- .../tests/ghci.debugger/scripts/print008.script | 2 +- .../tests/ghci.debugger/scripts/print010.script | 2 +- .../tests/ghci.debugger/scripts/print011.script | 2 +- .../tests/ghci.debugger/scripts/print012.script | 4 +- .../tests/ghci.debugger/scripts/print013.script | 2 +- .../tests/ghci.debugger/scripts/print014.script | 2 +- .../tests/ghci.debugger/scripts/print016.script | 2 +- .../tests/ghci.debugger/scripts/print017.script | 2 +- .../tests/ghci.debugger/scripts/print018.script | 2 +- .../tests/ghci.debugger/scripts/print018.stdout | 4 +- .../tests/ghci.debugger/scripts/print019.script | 2 +- .../tests/ghci.debugger/scripts/print020.script | 2 +- .../tests/ghci.debugger/scripts/print020.stdout | 30 ++++----- .../tests/ghci.debugger/scripts/print023.script | 2 +- .../tests/ghci.debugger/scripts/print024.script | 2 +- .../tests/ghci.debugger/scripts/print034.script | 4 +- .../tests/ghci.debugger/scripts/print035.script | 2 +- testsuite/tests/ghci/prog001/prog001.script | 2 +- testsuite/tests/ghci/prog002/prog002.script | 2 +- testsuite/tests/ghci/prog003/prog003.script | 2 +- testsuite/tests/ghci/prog010/ghci.prog010.script | 2 +- testsuite/tests/ghci/prog012/prog012.script | 2 +- testsuite/tests/ghci/scripts/Defer02.script | 2 +- testsuite/tests/ghci/scripts/Defer02.stderr | 72 +++++++++++----------- testsuite/tests/ghci/scripts/T6106.script | 2 +- testsuite/tests/ghci/scripts/ghci026.script | 4 +- testsuite/tests/ghci/scripts/ghci038.script | 2 +- testsuite/tests/ghci/scripts/ghci058.script | 2 +- testsuite/tests/perf/haddock/all.T | 6 +- testsuite/tests/perf/should_run/all.T | 2 +- testsuite/tests/rts/all.T | 2 +- validate | 3 +- 81 files changed, 263 insertions(+), 211 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 f72f23f9f6ff2914ec99fc86f67c89927f18ba47 From git at git.haskell.org Sat Jun 18 10:48:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 10:48:48 +0000 (UTC) Subject: [commit: ghc] master: Driver: `ghc ../Test` (without file extension) should work (e02beb1) Message-ID: <20160618104848.837733A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e02beb1849416f5af8ec56acd17f37b5dc7c24a4/ghc >--------------------------------------------------------------- commit e02beb1849416f5af8ec56acd17f37b5dc7c24a4 Author: Thomas Miedema Date: Tue Jun 14 00:10:19 2016 +0200 Driver: `ghc ../Test` (without file extension) should work Reviewed by: bgamari Differential Revision: https://phabricator.haskell.org/D2331 GHC Trac Issues: #12192 >--------------------------------------------------------------- e02beb1849416f5af8ec56acd17f37b5dc7c24a4 compiler/main/DriverPhases.hs | 2 +- ghc/Main.hs | 4 ++-- testsuite/tests/driver/T12192.hs | 1 + testsuite/tests/driver/all.T | 3 +++ 4 files changed, 7 insertions(+), 3 deletions(-) diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs index 84eee1b..650bb15 100644 --- a/compiler/main/DriverPhases.hs +++ b/compiler/main/DriverPhases.hs @@ -348,7 +348,7 @@ isSourceSuffix suff = isHaskellishSuffix suff || isCishSuffix suff -- specified suffix is a Haskell one. isHaskellishTarget :: (String, Maybe Phase) -> Bool isHaskellishTarget (f,Nothing) = - looksLikeModuleName f || isHaskellSrcFilename f || '.' `notElem` f + looksLikeModuleName f || isHaskellSrcFilename f || not (hasExtension f) isHaskellishTarget (_,Just phase) = phase `notElem` [ As True, As False, Cc, Cobjc, Cobjcxx, CmmCpp, Cmm , StopLn] diff --git a/ghc/Main.hs b/ghc/Main.hs index 1a6cbeb..4870ce4 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -306,7 +306,7 @@ partition_args (arg:args) srcs objs the flag parser, and we want them to generate errors later in checkOptions, so we class them as source files (#5921) - - and finally we consider everything not containing a '.' to be + - and finally we consider everything without an extension to be a comp manager input, as shorthand for a .hs or .lhs filename. Everything else is considered to be a linker object, and passed @@ -316,7 +316,7 @@ looks_like_an_input :: String -> Bool looks_like_an_input m = isSourceFilename m || looksLikeModuleName m || "-" `isPrefixOf` m - || '.' `notElem` m + || not (hasExtension m) -- ----------------------------------------------------------------------------- -- Option sanity checks diff --git a/testsuite/tests/driver/T12192.hs b/testsuite/tests/driver/T12192.hs new file mode 100644 index 0000000..ce6da02 --- /dev/null +++ b/testsuite/tests/driver/T12192.hs @@ -0,0 +1 @@ +module T12192 where diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 54c84bc..36ba99b 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -488,3 +488,6 @@ test('T12135', extra_clean(['T12135.o', 'T12135.hi', 'T12135', 'T12135a/T12135.h', 'T12135b/T12135.h'])], run_command, ['$MAKE -s --no-print-directory T12135']) + +test('T12192', normal, run_command, + ['mkdir foo && (cd foo && {compiler} -v0 ../T12192)']) From git at git.haskell.org Sat Jun 18 10:48:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 10:48:51 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: validate the tests/stage1 directory with the stage1 compiler (d94c405) Message-ID: <20160618104852.004F23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d94c40561dde695e658169a3098642294f55c7e3/ghc >--------------------------------------------------------------- commit d94c40561dde695e658169a3098642294f55c7e3 Author: Thomas Miedema Date: Thu Jun 16 19:45:57 2016 +0200 Testsuite: validate the tests/stage1 directory with the stage1 compiler * See `Note [Why is there no stage1 setup function?]`. * Move T2632 to the tests/stage1 directory (#10382). Reviewed by: ezyang, nomeata, bgamari Differential Revision: https://phabricator.haskell.org/D2341 GHC Trac Issues: #12197 >--------------------------------------------------------------- d94c40561dde695e658169a3098642294f55c7e3 .gitignore | 4 +-- testsuite/Makefile | 4 +-- testsuite/driver/testglobals.py | 5 +++- testsuite/driver/testlib.py | 32 +++++++++++++++++++++++- testsuite/mk/test.mk | 6 +++-- testsuite/tests/quotes/all.T | 1 - testsuite/tests/{annotations => stage1}/Makefile | 3 +++ testsuite/tests/{quotes => stage1}/T2632.hs | 0 testsuite/tests/stage1/all.T | 6 +++++ validate | 31 ++++++++++++++++++++--- 10 files changed, 80 insertions(+), 12 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 d94c40561dde695e658169a3098642294f55c7e3 From git at git.haskell.org Sat Jun 18 11:33:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 11:33:19 +0000 (UTC) Subject: [commit: ghc] master: Validate: use `rm -f` instead of `rm` (a4c8532) Message-ID: <20160618113319.AA9793A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a4c8532941a3aa613443a9a371f0353dceb66451/ghc >--------------------------------------------------------------- commit a4c8532941a3aa613443a9a371f0353dceb66451 Author: Thomas Miedema Date: Sat Jun 18 13:36:41 2016 +0200 Validate: use `rm -f` instead of `rm` >--------------------------------------------------------------- a4c8532941a3aa613443a9a371f0353dceb66451 validate | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/validate b/validate index fc289e5..9d58bde 100755 --- a/validate +++ b/validate @@ -269,7 +269,7 @@ if [ $be_quiet -eq 1 ] && [ -z $VERBOSE ]; then TEST_VERBOSITY="VERBOSE=1" fi -rm testsuite_summary.txt testsuite_summary_stage1.txt +rm -f testsuite_summary.txt testsuite_summary_stage1.txt # Use LOCAL=0, see Note [Running tests in /tmp]. $make -C testsuite/tests $BINDIST \ From git at git.haskell.org Sat Jun 18 16:06:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 16:06:51 +0000 (UTC) Subject: [commit: ghc] master: VarEnv: Comment only (6354991) Message-ID: <20160618160652.004C93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6354991fe61b065d2c993eefdd5fd694bc6136b8/ghc >--------------------------------------------------------------- commit 6354991fe61b065d2c993eefdd5fd694bc6136b8 Author: Ömer Sinan Ağacan Date: Sat Jun 18 16:10:19 2016 +0000 VarEnv: Comment only >--------------------------------------------------------------- 6354991fe61b065d2c993eefdd5fd694bc6136b8 compiler/basicTypes/VarEnv.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/basicTypes/VarEnv.hs b/compiler/basicTypes/VarEnv.hs index 5a852a3..ee63e2c 100644 --- a/compiler/basicTypes/VarEnv.hs +++ b/compiler/basicTypes/VarEnv.hs @@ -90,7 +90,7 @@ import StaticFlags -} -- | A set of variables that are in scope at some point --- "Secrets of the Glasgow Haskell Compiler inliner" Section 3. provides +-- "Secrets of the Glasgow Haskell Compiler inliner" Section 3.2 provides -- the motivation for this abstraction. data InScopeSet = InScope (VarEnv Var) {-# UNPACK #-} !Int -- The (VarEnv Var) is just a VarSet. But we write it like From git at git.haskell.org Sat Jun 18 22:23:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 22:23:25 +0000 (UTC) Subject: [commit: ghc] master: PPC NCG: Fix and refactor TOC handling. (f4b0488) Message-ID: <20160618222325.9C7B73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f4b0488dba4c97630ed1e4417eef546abd5c3df5/ghc >--------------------------------------------------------------- commit f4b0488dba4c97630ed1e4417eef546abd5c3df5 Author: Peter Trommler Date: Sat Jun 18 12:29:12 2016 +0200 PPC NCG: Fix and refactor TOC handling. In a call to a fixed function the TOC does not need to be saved. The linker handles TOC saving. Refactor TOC handling by folding the two functions toc_before and toc_after into the code generating the call sequence. This saves repeating the case distinction in those two functions. Test Plan: validate on PowerPC 32-bit Linux and AIX Reviewers: hvr, simonmar, austin, erikd, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2328 >--------------------------------------------------------------- f4b0488dba4c97630ed1e4417eef546abd5c3df5 compiler/nativeGen/PPC/CodeGen.hs | 56 +++++++++++++++++++-------------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 86903e4..1b719fc 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -1150,7 +1150,13 @@ genCCall' PowerPC 64 Linux uses the System V Release 4 Calling Convention for 64-bit PowerPC. It is specified in - "64-bit PowerPC ELF Application Binary Interface Supplement 1.9". + "64-bit PowerPC ELF Application Binary Interface Supplement 1.9" + (PPC64 ELF v1.9). + PowerPC 64 Linux in little endian mode uses the "Power Architecture 64-Bit + ELF V2 ABI Specification -- OpenPOWER ABI for Linux Supplement" + (PPC64 ELF v2). + AIX follows the "PowerOpen ABI: Application Binary Interface Big-Endian + 32-Bit Hardware Implementation" According to all conventions, the parameter area should be part of the caller's stack frame, allocated in the caller's prologue code (large enough @@ -1191,41 +1197,46 @@ genCCall' dflags gcp target dest_regs args PrimTarget mop -> outOfLineMachOp mop let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode - `appOL` toc_before - codeAfter = toc_after labelOrExpr `appOL` move_sp_up finalStack - `appOL` moveResult reduceToFF32 + codeAfter = move_sp_up finalStack `appOL` moveResult reduceToFF32 case labelOrExpr of Left lbl -> do -- the linker does all the work for us return ( codeBefore `snocOL` BL lbl usedRegs + `appOL` maybeNOP -- some ABI require a NOP after BL `appOL` codeAfter) Right dyn -> do -- implement call through function pointer (dynReg, dynCode) <- getSomeReg dyn case gcp of GCPLinux64ELF 1 -> return ( dynCode `appOL` codeBefore + `snocOL` ST spFormat toc (AddrRegImm sp (ImmInt 40)) `snocOL` LD II64 r11 (AddrRegImm dynReg (ImmInt 0)) `snocOL` LD II64 toc (AddrRegImm dynReg (ImmInt 8)) `snocOL` MTCTR r11 `snocOL` LD II64 r11 (AddrRegImm dynReg (ImmInt 16)) `snocOL` BCTRL usedRegs + `snocOL` LD spFormat toc (AddrRegImm sp (ImmInt 40)) `appOL` codeAfter) GCPLinux64ELF 2 -> return ( dynCode `appOL` codeBefore + `snocOL` ST spFormat toc (AddrRegImm sp (ImmInt 24)) `snocOL` MR r12 dynReg `snocOL` MTCTR r12 `snocOL` BCTRL usedRegs + `snocOL` LD spFormat toc (AddrRegImm sp (ImmInt 24)) `appOL` codeAfter) GCPAIX -> return ( dynCode -- AIX/XCOFF follows the PowerOPEN ABI -- which is quite similiar to LinuxPPC64/ELFv1 `appOL` codeBefore + `snocOL` ST spFormat toc (AddrRegImm sp (ImmInt 20)) `snocOL` LD II32 r11 (AddrRegImm dynReg (ImmInt 0)) `snocOL` LD II32 toc (AddrRegImm dynReg (ImmInt 4)) `snocOL` MTCTR r11 `snocOL` LD II32 r11 (AddrRegImm dynReg (ImmInt 8)) `snocOL` BCTRL usedRegs + `snocOL` LD spFormat toc (AddrRegImm sp (ImmInt 20)) `appOL` codeAfter) _ -> return ( dynCode `snocOL` MTCTR dynReg @@ -1281,30 +1292,6 @@ genCCall' dflags gcp target dest_regs args DELTA (-delta)] | otherwise = nilOL where delta = stackDelta finalStack - toc_before = case gcp of - GCPLinux64ELF 1 -> unitOL $ ST spFormat toc (AddrRegImm sp (ImmInt 40)) - GCPLinux64ELF 2 -> unitOL $ ST spFormat toc (AddrRegImm sp (ImmInt 24)) - GCPAIX -> unitOL $ ST spFormat toc (AddrRegImm sp (ImmInt 20)) - _ -> nilOL - toc_after labelOrExpr = case gcp of - GCPLinux64ELF 1 -> case labelOrExpr of - Left _ -> toOL [ NOP ] - Right _ -> toOL [ LD spFormat toc - (AddrRegImm sp - (ImmInt 40)) - ] - GCPLinux64ELF 2 -> case labelOrExpr of - Left _ -> toOL [ NOP ] - Right _ -> toOL [ LD spFormat toc - (AddrRegImm sp - (ImmInt 24)) - ] - GCPAIX -> case labelOrExpr of - Left _ -> unitOL NOP - Right _ -> unitOL (LD spFormat toc - (AddrRegImm sp - (ImmInt 20))) - _ -> nilOL move_sp_up finalStack | delta > 64 = -- TODO: fix-up stack back-chain toOL [ADD sp sp (RIImm (ImmInt delta)), @@ -1312,6 +1299,19 @@ genCCall' dflags gcp target dest_regs args | otherwise = nilOL where delta = stackDelta finalStack + -- A NOP instruction is required after a call (bl instruction) + -- on AIX and 64-Bit Linux. + -- If the call is to a function with a different TOC (r2) the + -- link editor replaces the NOP instruction with a load of the TOC + -- from the stack to restore the TOC. + maybeNOP = case gcp of + -- See Section 3.9.4 of OpenPower ABI + GCPAIX -> unitOL NOP + -- See Section 3.5.11 of PPC64 ELF v1.9 + GCPLinux64ELF 1 -> unitOL NOP + -- See Section 2.3.6 of PPC64 ELF v2 + GCPLinux64ELF 2 -> unitOL NOP + _ -> nilOL passArguments [] _ _ stackOffset accumCode accumUsed = return (stackOffset, accumCode, accumUsed) passArguments ((arg,arg_ty):args) gprs fprs stackOffset From git at git.haskell.org Sat Jun 18 22:23:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 22:23:28 +0000 (UTC) Subject: [commit: ghc] master: Refactor derived Generic instances to reduce allocations (9649fc0) Message-ID: <20160618222328.555513A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9649fc0ae45e006c2ed54cc5ea2414158949fadb/ghc >--------------------------------------------------------------- commit 9649fc0ae45e006c2ed54cc5ea2414158949fadb Author: Ryan Scott Date: Sat Jun 18 12:23:12 2016 +0200 Refactor derived Generic instances to reduce allocations Previously, derived implementations of `to`/`from` in `Generic` instances were wastefully putting extra `M1`s in every case, which led to an O(n) increase in the number of coercions, resulting in a slowdown during the typechecker phase. This factors out the common `M1` in every case of a `to`/`from` definition so that the typechecker has far fewer coercions to deal with. For a datatype with 300 constructors, this change has been observed to save almost 3 seconds of compilation time. This is one step towards coming up with a solution for #5642. Test Plan: ./validate Reviewers: hvr, austin, simonpj, bgamari Reviewed By: bgamari Subscribers: basvandijk, carter, thomie, osa1 Differential Revision: https://phabricator.haskell.org/D2304 GHC Trac Issues: #5642 >--------------------------------------------------------------- 9649fc0ae45e006c2ed54cc5ea2414158949fadb compiler/typecheck/TcGenGenerics.hs | 83 ++++- testsuite/tests/generics/GenDerivOutput.stderr | 144 ++++---- testsuite/tests/generics/GenDerivOutput1_0.stderr | 35 +- testsuite/tests/generics/GenDerivOutput1_1.stderr | 264 +++++++------- .../tests/generics/T10604/T10604_deriving.stderr | 253 +++++++------ testsuite/tests/perf/compiler/T5642.hs | 402 +++++++++++---------- testsuite/tests/perf/compiler/all.T | 5 +- testsuite/tests/perf/haddock/all.T | 3 +- 8 files changed, 651 insertions(+), 538 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 9649fc0ae45e006c2ed54cc5ea2414158949fadb From git at git.haskell.org Sat Jun 18 22:23:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 22:23:30 +0000 (UTC) Subject: [commit: ghc] master: Fix trac #10647: Notice about lack of SIMD support (f12fb8a) Message-ID: <20160618222330.F13033A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f12fb8ab5d5ad7a26c84f98e446bc70064dcdcec/ghc >--------------------------------------------------------------- commit f12fb8ab5d5ad7a26c84f98e446bc70064dcdcec Author: Seraphime Kirkovski Date: Sat Jun 18 12:28:19 2016 +0200 Fix trac #10647: Notice about lack of SIMD support Fixes #10647. Changes the error message when a SIMD size variable is required in the native code generation backend. Test Plan: Try compiling the test case given in the ticket : {-# LANGUAGE MagicHash #-} module Foo where import GHC.Prim data V = V Int8X16# GHC should give a clearer error message Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2325 GHC Trac Issues: #10647 >--------------------------------------------------------------- f12fb8ab5d5ad7a26c84f98e446bc70064dcdcec compiler/nativeGen/Format.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/nativeGen/Format.hs b/compiler/nativeGen/Format.hs index 92a8ef8..00811f1 100644 --- a/compiler/nativeGen/Format.hs +++ b/compiler/nativeGen/Format.hs @@ -57,7 +57,9 @@ intFormat width W16 -> II16 W32 -> II32 W64 -> II64 - other -> pprPanic "Format.intFormat" (ppr other) + other -> sorry $ "The native code generator cannot " ++ + "produce code for Format.intFormat " ++ show other + ++ "\n\tConsider using the llvm backend with -fllvm" -- | Get the float format of this width. From git at git.haskell.org Sat Jun 18 22:23:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 22:23:34 +0000 (UTC) Subject: [commit: ghc] master: PPC NCG: Fix float parameter passing on 64-bit. (2897be7) Message-ID: <20160618222334.53C633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2897be77123bf31cad1c60dd5560eba7f2f021ce/ghc >--------------------------------------------------------------- commit 2897be77123bf31cad1c60dd5560eba7f2f021ce Author: Peter Trommler Date: Sat Jun 18 12:28:41 2016 +0200 PPC NCG: Fix float parameter passing on 64-bit. On Linux 64-bit PowerPC the first 13 floating point parameters are passed in registers. We only passed the first 8 floating point params. The alignment of a floating point single precision value in ELF v1.9 is the second word of a doubleword. For ELF v2 we support only little endian and the least significant word of a doubleword is the first word, so no special handling is required. Add a regression test. Test Plan: validate on powerpc Linux and AIX Reviewers: erikd, hvr, austin, simonmar, bgamari Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2327 GHC Trac Issues: #12134 >--------------------------------------------------------------- 2897be77123bf31cad1c60dd5560eba7f2f021ce compiler/nativeGen/PPC/CodeGen.hs | 24 ++++++++++++++++++------ compiler/nativeGen/PPC/Regs.hs | 5 ++++- testsuite/tests/ffi/should_run/T12134.hs | 8 ++++++++ testsuite/tests/ffi/should_run/T12134.stdout | 15 +++++++++++++++ testsuite/tests/ffi/should_run/T12134_c.c | 8 ++++++++ testsuite/tests/ffi/should_run/all.T | 6 ++++++ 6 files changed, 59 insertions(+), 7 deletions(-) diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 12d5d88..86903e4 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -1260,10 +1260,12 @@ genCCall' dflags gcp target dest_regs args GCPLinux -> roundTo 16 finalStack GCPLinux64ELF 1 -> roundTo 16 $ (48 +) $ max 64 $ sum $ - map (widthInBytes . typeWidth) argReps + map (roundTo 8 . widthInBytes . typeWidth) + argReps GCPLinux64ELF 2 -> roundTo 16 $ (32 +) $ max 64 $ sum $ - map (widthInBytes . typeWidth) argReps + map (roundTo 8 . widthInBytes . typeWidth) + argReps _ -> panic "genCall': unknown calling conv." argReps = map (cmmExprType dflags) args @@ -1414,11 +1416,21 @@ genCCall' dflags gcp target dest_regs args | otherwise -> stackOffset GCPLinux64ELF _ -> - -- everything on the stack is 8-byte - -- aligned on a 64 bit system - -- (except vector status, not used now) + -- Everything on the stack is mapped to + -- 8-byte aligned doublewords stackOffset - stackSlot = AddrRegImm sp (ImmInt stackOffset') + stackOffset'' + | isFloatType rep && typeWidth rep == W32 = + case gcp of + -- The ELF v1 ABI Section 3.2.3 requires: + -- "Single precision floating point values + -- are mapped to the second word in a single + -- doubleword" + GCPLinux64ELF 1 -> stackOffset' + 4 + _ -> stackOffset' + | otherwise = stackOffset' + + stackSlot = AddrRegImm sp (ImmInt stackOffset'') (nGprs, nFprs, stackBytes, regs) = case gcp of GCPAIX -> diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs index 780aecc..a1befc7 100644 --- a/compiler/nativeGen/PPC/Regs.hs +++ b/compiler/nativeGen/PPC/Regs.hs @@ -263,7 +263,10 @@ allFPArgRegs platform = case platformOS platform of OSAIX -> map (regSingle . fReg) [1..13] OSDarwin -> map (regSingle . fReg) [1..13] - OSLinux -> map (regSingle . fReg) [1..8] + OSLinux -> case platformArch platform of + ArchPPC -> map (regSingle . fReg) [1..8] + ArchPPC_64 _ -> map (regSingle . fReg) [1..13] + _ -> panic "PPC.Regs.allFPArgRegs: unknown PPC Linux" _ -> panic "PPC.Regs.allFPArgRegs: not defined for this architecture" fits16Bits :: Integral a => a -> Bool diff --git a/testsuite/tests/ffi/should_run/T12134.hs b/testsuite/tests/ffi/should_run/T12134.hs new file mode 100644 index 0000000..f07d892 --- /dev/null +++ b/testsuite/tests/ffi/should_run/T12134.hs @@ -0,0 +1,8 @@ +import Foreign.C.Types + +foreign import ccall "many_floats" many :: CFloat -> CFloat -> + CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> + CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> + CDouble -> IO () + +main = many 1.5 2.5 3.5 4.5 5.5 6.5 7.5 8.5 9.5 10.5 11.5 12.5 13.5 14.5 15.5 diff --git a/testsuite/tests/ffi/should_run/T12134.stdout b/testsuite/tests/ffi/should_run/T12134.stdout new file mode 100644 index 0000000..798f1a2 --- /dev/null +++ b/testsuite/tests/ffi/should_run/T12134.stdout @@ -0,0 +1,15 @@ +1.500000 +2.500000 +3.500000 +4.500000 +5.500000 +6.500000 +7.500000 +8.500000 +9.500000 +10.500000 +11.500000 +12.500000 +13.500000 +14.500000 +15.500000 diff --git a/testsuite/tests/ffi/should_run/T12134_c.c b/testsuite/tests/ffi/should_run/T12134_c.c new file mode 100644 index 0000000..0e61670 --- /dev/null +++ b/testsuite/tests/ffi/should_run/T12134_c.c @@ -0,0 +1,8 @@ +#include + +void many_floats(float f1, float f2, float f3, float f4, float f5, + float f6, float f7, float f8, float f9, float f10, + float f11, float f12, float f13, float f14, double f15) { + printf("%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n", + f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15); +} diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T index eb2c152..efb6969 100644 --- a/testsuite/tests/ffi/should_run/all.T +++ b/testsuite/tests/ffi/should_run/all.T @@ -217,3 +217,9 @@ test('ffi023', [ omit_ways(['ghci']), # ffi023_stub.h before compiling ffi023_c.c, which # needs it. compile_and_run, ['ffi023_c.c']) + +test('T12134', + [omit_ways(['ghci']), extra_clean(['T12134_c.o'])], + compile_and_run, + ['T12134_c.c']) + From git at git.haskell.org Sat Jun 18 22:23:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 22:23:37 +0000 (UTC) Subject: [commit: ghc] master: Avoid find_tycon panic if datacon is not in scope (4d71cc8) Message-ID: <20160618222337.A01EF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4d71cc89b4e9648f3fbb29c8fcd25d725616e265/ghc >--------------------------------------------------------------- commit 4d71cc89b4e9648f3fbb29c8fcd25d725616e265 Author: Adam Gundry Date: Sat Jun 18 12:27:47 2016 +0200 Avoid find_tycon panic if datacon is not in scope When using TH to splice expressions involving record field construction, the parent datacon may not be in scope. We shouldn't panic about this, because we will be renaming Exact RdrNames which don't require any disambiguation. Test Plan: new test th/T12130 Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2321 GHC Trac Issues: #12130 >--------------------------------------------------------------- 4d71cc89b4e9648f3fbb29c8fcd25d725616e265 compiler/rename/RnPat.hs | 7 ++++--- testsuite/tests/th/T12130.hs | 8 ++++++++ testsuite/tests/th/T12130a.hs | 17 +++++++++++++++++ testsuite/tests/th/all.T | 2 ++ 4 files changed, 31 insertions(+), 3 deletions(-) diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs index 98ca38b..d252f7f 100644 --- a/compiler/rename/RnPat.hs +++ b/compiler/rename/RnPat.hs @@ -635,7 +635,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) find_tycon :: GlobalRdrEnv -> Name {- DataCon -} -> Maybe Name {- TyCon -} -- Return the parent *type constructor* of the data constructor -- (that is, the parent of the data constructor), - -- or 'Nothing' if it is a pattern synonym. + -- or 'Nothing' if it is a pattern synonym or not in scope. -- That's the parent to use for looking up record fields. find_tycon env con | Just (AConLike (RealDataCon dc)) <- wiredInNameTyThing_maybe con @@ -647,8 +647,9 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) ParentIs p -> Just p _ -> Nothing - | otherwise - = pprPanic "find_tycon" (ppr con $$ ppr (lookupGRE_Name env con)) + | otherwise = Nothing + -- This can happen if the datacon is not in scope + -- and we are in a TH splice (Trac #12130) dup_flds :: [[RdrName]] -- Each list represents a RdrName that occurred more than once diff --git a/testsuite/tests/th/T12130.hs b/testsuite/tests/th/T12130.hs new file mode 100644 index 0000000..7ab7492 --- /dev/null +++ b/testsuite/tests/th/T12130.hs @@ -0,0 +1,8 @@ +{-# Language TemplateHaskell #-} +{-# Language DisambiguateRecordFields #-} + +module T12130 where + +import T12130a hiding (Block) + +b = $(block) diff --git a/testsuite/tests/th/T12130a.hs b/testsuite/tests/th/T12130a.hs new file mode 100644 index 0000000..f393967 --- /dev/null +++ b/testsuite/tests/th/T12130a.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T12130a where + +import Language.Haskell.TH + +data Block = Block + { blockSelector :: () + } + +block :: Q Exp +block = + [| Block { + -- Using record syntax is neccesary to trigger the bug. + blockSelector = () + } + |] diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 75364dc..bd59c4e 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -407,3 +407,5 @@ test('T11941', normal, compile_fail, ['-v0']) test('T11484', normal, compile, ['-v0']) test('T8761', unless(ghc_dynamic(), expect_broken(12077)), compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T12130', extra_clean(['T12130a.hi','T12130a.o']), + multimod_compile, ['T12130', '-v0 ' + config.ghc_th_way_flags]) From git at git.haskell.org Sat Jun 18 22:23:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 22:23:41 +0000 (UTC) Subject: [commit: ghc] master: Add Bifoldable and Bitraversable to base (270d545) Message-ID: <20160618222341.192BB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/270d545d557352d5f264247987ee8388f0812187/ghc >--------------------------------------------------------------- commit 270d545d557352d5f264247987ee8388f0812187 Author: Ryan Scott Date: Sat Jun 18 12:17:24 2016 +0200 Add Bifoldable and Bitraversable to base This adds `Data.Bifoldable` and `Data.Bitraversable` from the `bifunctors` package to `base`, completing the migration started in D336. This is fairly straightforward, although there were a suprising amount of reinternal organization in `base` that was needed for this to happen: * `Data.Foldable`, `Data.Traversable`, `Data.Bifoldable`, and `Data.Bitraversable` share some nonexported datatypes (e.g., `StateL`, `StateR`, `Min`, `Max`, etc.) to implement some instances. To avoid code duplication, I migrated this internal code to a new hidden module, `Data.Functor.Utils` (better naming suggestions welcome). * `Data.Traversable` and `Data.Bitraversable` also make use of an identity newtype, so I modified them to use `Data.Functor.Identity.Identity`. This has a ripple effect on several other modules, since I had to move instances around in order to avoid dependency cycles. Fixes #10448. Reviewers: ekmett, hvr, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2284 GHC Trac Issues: #9682, #10448 >--------------------------------------------------------------- 270d545d557352d5f264247987ee8388f0812187 libraries/base/Control/Monad/Zip.hs | 6 + libraries/base/Data/Bifoldable.hs | 428 +++++++++++++++++++++ libraries/base/Data/Bitraversable.hs | 228 +++++++++++ libraries/base/Data/Data.hs | 28 +- libraries/base/Data/Foldable.hs | 64 +-- libraries/base/Data/Functor/Identity.hs | 34 +- libraries/base/Data/Functor/Utils.hs | 106 +++++ libraries/base/Data/Semigroup.hs | 31 +- libraries/base/Data/String.hs | 10 +- libraries/base/Data/Traversable.hs | 50 +-- libraries/base/base.cabal | 3 + libraries/base/changelog.md | 3 + .../tests/annotations/should_fail/annfail10.stderr | 4 +- testsuite/tests/perf/compiler/all.T | 3 +- .../tests/typecheck/should_fail/T10971b.stderr | 8 +- 15 files changed, 847 insertions(+), 159 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 270d545d557352d5f264247987ee8388f0812187 From git at git.haskell.org Sat Jun 18 22:23:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 18 Jun 2016 22:23:43 +0000 (UTC) Subject: [commit: ghc] master: llvmGen: Add strictness to metadata fields (0be38a2) Message-ID: <20160618222343.B7ABE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0be38a22059ef761ff0f5487e88c18a9fd6df53b/ghc >--------------------------------------------------------------- commit 0be38a22059ef761ff0f5487e88c18a9fd6df53b Author: Ben Gamari Date: Sat Jun 18 12:57:29 2016 +0200 llvmGen: Add strictness to metadata fields >--------------------------------------------------------------- 0be38a22059ef761ff0f5487e88c18a9fd6df53b compiler/llvmGen/Llvm/MetaData.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/llvmGen/Llvm/MetaData.hs b/compiler/llvmGen/Llvm/MetaData.hs index 3bdcd60..6f3ced5 100644 --- a/compiler/llvmGen/Llvm/MetaData.hs +++ b/compiler/llvmGen/Llvm/MetaData.hs @@ -65,9 +65,9 @@ instance Outputable MetaId where ppr (MetaId n) = char '!' <> int n -- | LLVM metadata expressions -data MetaExpr = MetaStr LMString - | MetaNode MetaId - | MetaVar LlvmVar +data MetaExpr = MetaStr !LMString + | MetaNode !MetaId + | MetaVar !LlvmVar | MetaStruct [MetaExpr] deriving (Eq) @@ -87,7 +87,7 @@ data MetaAnnot = MetaAnnot LMString MetaExpr data MetaDecl -- | Named metadata. Only used for communicating module information to -- LLVM. ('!name = !{ [!] }' form). - = MetaNamed LMString [MetaId] + = MetaNamed !LMString [MetaId] -- | Metadata node declaration. -- ('!0 = metadata !{ }' form). - | MetaUnnamed MetaId MetaExpr + | MetaUnnamed !MetaId !MetaExpr From git at git.haskell.org Mon Jun 20 13:22:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 13:22:21 +0000 (UTC) Subject: [commit: ghc] master: Remove use of KProxy in GHC.Generics (0e92af9) Message-ID: <20160620132221.535D53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0e92af91f7246dd8c6f01ccc475f621e8869a423/ghc >--------------------------------------------------------------- commit 0e92af91f7246dd8c6f01ccc475f621e8869a423 Author: Ryan Scott Date: Mon Jun 20 09:25:55 2016 -0400 Remove use of KProxy in GHC.Generics Summary: With `-XTypeInType`, the singletons machinery that `GHC.Generics` uses no longer needs `KProxy` to hack around the use of `k` as both a type and a kind. This is simply changing the code to match what's currently in the upstream `singletons` repo. Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie, goldfire Differential Revision: https://phabricator.haskell.org/D2347 >--------------------------------------------------------------- 0e92af91f7246dd8c6f01ccc475f621e8869a423 libraries/base/GHC/Generics.hs | 45 +++++++++++++++++++++--------------------- 1 file changed, 22 insertions(+), 23 deletions(-) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 907d56b..2ba16ed 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -13,6 +13,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} @@ -736,7 +737,7 @@ import GHC.Read ( Read(..), lex, readParen ) import GHC.Show ( Show(..), showString ) -- Needed for metadata -import Data.Proxy ( Proxy(..), KProxy(..) ) +import Data.Proxy ( Proxy(..) ) import GHC.TypeLits ( Nat, Symbol, KnownSymbol, KnownNat, symbolVal, natVal ) -------------------------------------------------------------------------------- @@ -1236,13 +1237,13 @@ class SingI (a :: k) where -- | The 'SingKind' class is essentially a /kind/ class. It classifies all kinds -- for which singletons are defined. The class supports converting between a singleton -- type and the base (unrefined) type which it is built from. -class (kparam ~ 'KProxy) => SingKind (kparam :: KProxy k) where +class SingKind k where -- | Get a base type from a proxy for the promoted kind. For example, - -- @DemoteRep ('KProxy :: KProxy Bool)@ will be the type @Bool at . - type DemoteRep kparam :: * + -- @DemoteRep Bool@ will be the type @Bool at . + type DemoteRep k :: * -- | Convert a singleton to its unrefined version. - fromSing :: Sing (a :: k) -> DemoteRep kparam + fromSing :: Sing (a :: k) -> DemoteRep k -- Singleton symbols data instance Sing (s :: Symbol) where @@ -1252,8 +1253,8 @@ data instance Sing (s :: Symbol) where instance KnownSymbol a => SingI a where sing = SSym -- | @since 4.9.0.0 -instance SingKind ('KProxy :: KProxy Symbol) where - type DemoteRep ('KProxy :: KProxy Symbol) = String +instance SingKind Symbol where + type DemoteRep Symbol = String fromSing (SSym :: Sing s) = symbolVal (Proxy :: Proxy s) -- Singleton booleans @@ -1268,8 +1269,8 @@ instance SingI 'True where sing = STrue instance SingI 'False where sing = SFalse -- | @since 4.9.0.0 -instance SingKind ('KProxy :: KProxy Bool) where - type DemoteRep ('KProxy :: KProxy Bool) = Bool +instance SingKind Bool where + type DemoteRep Bool = Bool fromSing STrue = True fromSing SFalse = False @@ -1285,10 +1286,8 @@ instance SingI 'Nothing where sing = SNothing instance SingI a => SingI ('Just a) where sing = SJust sing -- | @since 4.9.0.0 -instance SingKind ('KProxy :: KProxy a) => - SingKind ('KProxy :: KProxy (Maybe a)) where - type DemoteRep ('KProxy :: KProxy (Maybe a)) = - Maybe (DemoteRep ('KProxy :: KProxy a)) +instance SingKind a => SingKind (Maybe a) where + type DemoteRep (Maybe a) = Maybe (DemoteRep a) fromSing SNothing = Nothing fromSing (SJust a) = Just (fromSing a) @@ -1305,8 +1304,8 @@ instance (SingI a, KnownNat n) => SingI ('InfixI a n) where sing = SInfix (sing :: Sing a) (natVal (Proxy :: Proxy n)) -- | @since 4.9.0.0 -instance SingKind ('KProxy :: KProxy FixityI) where - type DemoteRep ('KProxy :: KProxy FixityI) = Fixity +instance SingKind FixityI where + type DemoteRep FixityI = Fixity fromSing SPrefix = Prefix fromSing (SInfix a n) = Infix (fromSing a) (I# (integerToInt n)) @@ -1326,8 +1325,8 @@ instance SingI 'RightAssociative where sing = SRightAssociative instance SingI 'NotAssociative where sing = SNotAssociative -- | @since 4.0.0.0 -instance SingKind ('KProxy :: KProxy Associativity) where - type DemoteRep ('KProxy :: KProxy Associativity) = Associativity +instance SingKind Associativity where + type DemoteRep Associativity = Associativity fromSing SLeftAssociative = LeftAssociative fromSing SRightAssociative = RightAssociative fromSing SNotAssociative = NotAssociative @@ -1348,8 +1347,8 @@ instance SingI 'SourceNoUnpack where sing = SSourceNoUnpack instance SingI 'SourceUnpack where sing = SSourceUnpack -- | @since 4.9.0.0 -instance SingKind ('KProxy :: KProxy SourceUnpackedness) where - type DemoteRep ('KProxy :: KProxy SourceUnpackedness) = SourceUnpackedness +instance SingKind SourceUnpackedness where + type DemoteRep SourceUnpackedness = SourceUnpackedness fromSing SNoSourceUnpackedness = NoSourceUnpackedness fromSing SSourceNoUnpack = SourceNoUnpack fromSing SSourceUnpack = SourceUnpack @@ -1370,8 +1369,8 @@ instance SingI 'SourceLazy where sing = SSourceLazy instance SingI 'SourceStrict where sing = SSourceStrict -- | @since 4.9.0.0 -instance SingKind ('KProxy :: KProxy SourceStrictness) where - type DemoteRep ('KProxy :: KProxy SourceStrictness) = SourceStrictness +instance SingKind SourceStrictness where + type DemoteRep SourceStrictness = SourceStrictness fromSing SNoSourceStrictness = NoSourceStrictness fromSing SSourceLazy = SourceLazy fromSing SSourceStrict = SourceStrict @@ -1392,8 +1391,8 @@ instance SingI 'DecidedStrict where sing = SDecidedStrict instance SingI 'DecidedUnpack where sing = SDecidedUnpack -- | @since 4.9.0.0 -instance SingKind ('KProxy :: KProxy DecidedStrictness) where - type DemoteRep ('KProxy :: KProxy DecidedStrictness) = DecidedStrictness +instance SingKind DecidedStrictness where + type DemoteRep DecidedStrictness = DecidedStrictness fromSing SDecidedLazy = DecidedLazy fromSing SDecidedStrict = DecidedStrict fromSing SDecidedUnpack = DecidedUnpack From git at git.haskell.org Mon Jun 20 13:46:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 13:46:38 +0000 (UTC) Subject: [commit: ghc] master: ApplicativeDo: allow "return $ e" (0ba34b6) Message-ID: <20160620134638.C73E03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0ba34b6bac988228948c65ae11d9e08afe82c878/ghc >--------------------------------------------------------------- commit 0ba34b6bac988228948c65ae11d9e08afe82c878 Author: Simon Marlow Date: Sat Jun 18 14:51:04 2016 +0100 ApplicativeDo: allow "return $ e" Summary: There's a precedent for special-casing $, as we already have special typing rules for it. Test Plan: validate; new test cases Reviewers: ezyang, austin, niteria, bgamari, simonpj, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2345 GHC Trac Issues: #11835 >--------------------------------------------------------------- 0ba34b6bac988228948c65ae11d9e08afe82c878 compiler/rename/RnExpr.hs | 22 +++++++++++++--------- docs/users_guide/glasgow_exts.rst | 5 ++--- testsuite/tests/ado/ado004.hs | 12 ++++++++++++ testsuite/tests/ado/ado004.stderr | 6 ++++++ 4 files changed, 33 insertions(+), 12 deletions(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index c92f69e..f8a53e0 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -1765,19 +1765,23 @@ needJoin [L loc (LastStmt e _ t)] | Just arg <- isReturnApp e = (False, [L loc (LastStmt arg True t)]) needJoin stmts = (True, stmts) --- | @Just e@, if the expression is @return e@, otherwise @Nothing@ +-- | @Just e@, if the expression is @return e@ or @return $ e@, +-- otherwise @Nothing@ isReturnApp :: LHsExpr Name -> Maybe (LHsExpr Name) isReturnApp (L _ (HsPar expr)) = isReturnApp expr -isReturnApp (L _ (HsApp f arg)) - | is_return f = Just arg - | otherwise = Nothing +isReturnApp (L _ e) = case e of + OpApp l op _ r | is_return l, is_dollar op -> Just r + HsApp f arg | is_return f -> Just arg + _otherwise -> Nothing where - is_return (L _ (HsPar e)) = is_return e - is_return (L _ (HsAppType e _)) = is_return e - is_return (L _ (HsVar (L _ r))) = r == returnMName || r == pureAName + is_var f (L _ (HsPar e)) = is_var f e + is_var f (L _ (HsAppType e _)) = is_var f e + is_var f (L _ (HsVar (L _ r))) = f r -- TODO: I don't know how to get this right for rebindable syntax - is_return _ = False -isReturnApp _ = Nothing + is_var _ _ = False + + is_return = is_var (\n -> n == returnMName || n == pureAName) + is_dollar = is_var (`hasKey` dollarIdKey) {- ************************************************************************ diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 1b24db2..d5e5f7c 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -859,9 +859,8 @@ will require ``Monad``. The block may return a pure expression ``E`` depending upon the results ``p1...pn`` with either ``return`` or ``pure``. Note: the final statement really must be of the form ``return E`` or -``pure E``, otherwise you get a ``Monad`` constraint. In particular, -``return $ E`` is not of the form ``return E``, and will therefore -incur a ``Monad`` constraint. +``pure E``, otherwise you get a ``Monad`` constraint. Using ``$`` as +in ``return $ E`` or ``pure $ E`` is also acceptable. When the statements of a ``do`` expression have dependencies between them, and ``ApplicativeDo`` cannot infer an ``Applicative`` type, it diff --git a/testsuite/tests/ado/ado004.hs b/testsuite/tests/ado/ado004.hs index 6ddc839..fa3c723 100644 --- a/testsuite/tests/ado/ado004.hs +++ b/testsuite/tests/ado/ado004.hs @@ -9,6 +9,13 @@ test1 f = do y <- f 4 return (x + y) +-- The same using $ +test1a :: Applicative f => (Int -> f Int) -> f Int +test1a f = do + x <- f 3 + y <- f 4 + return $ x + y + -- Test we can also infer the Applicative version of the type test2 f = do x <- f 3 @@ -20,6 +27,11 @@ test2a f = do x <- f 3 return (x + 1) +-- The same using $ +test2c f = do + x <- f 3 + return $ x + 1 + -- Test for just one statement test2b f = do return (f 3) diff --git a/testsuite/tests/ado/ado004.stderr b/testsuite/tests/ado/ado004.stderr index 8f5a816..ec2ebbc 100644 --- a/testsuite/tests/ado/ado004.stderr +++ b/testsuite/tests/ado/ado004.stderr @@ -1,6 +1,8 @@ TYPE SIGNATURES test1 :: forall (f :: * -> *). Applicative f => (Int -> f Int) -> f Int + test1a :: + forall (f :: * -> *). Applicative f => (Int -> f Int) -> f Int test2 :: forall t b (f :: * -> *). (Num b, Num t, Applicative f) => @@ -11,6 +13,10 @@ TYPE SIGNATURES (t -> f b) -> f b test2b :: forall (m :: * -> *) a t. (Num t, Monad m) => (t -> a) -> m a + test2c :: + forall t b (f :: * -> *). + (Num b, Num t, Functor f) => + (t -> f b) -> f b test3 :: forall a t (m :: * -> *) t1. (Num t1, Monad m) => From git at git.haskell.org Mon Jun 20 13:56:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 13:56:34 +0000 (UTC) Subject: [commit: ghc] master: Fix double-free in T5644 (#12208) (e7e42c8) Message-ID: <20160620135634.E547F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e7e42c838e32ef1e05daf04b0b6afb62ffc4ec97/ghc >--------------------------------------------------------------- commit e7e42c838e32ef1e05daf04b0b6afb62ffc4ec97 Author: Simon Marlow Date: Mon Jun 20 13:33:13 2016 +0100 Fix double-free in T5644 (#12208) >--------------------------------------------------------------- e7e42c838e32ef1e05daf04b0b6afb62ffc4ec97 rts/Schedule.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index fca276d..d9ab913 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1867,8 +1867,6 @@ delete_threads_and_gc: } task->cap = cap; } - - stgFree(idle_cap); #endif if (heap_overflow && sched_state < SCHED_INTERRUPTING) { @@ -1897,6 +1895,8 @@ delete_threads_and_gc: #endif #if defined(THREADED_RTS) + stgFree(idle_cap); + if (gc_type == SYNC_GC_SEQ) { // release our stash of capabilities. releaseAllCapabilities(n_capabilities, cap, task); From git at git.haskell.org Mon Jun 20 14:36:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:36:57 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: remove `-Wno-warn-tabs` from default flags (135fc86) Message-ID: <20160620143657.960023A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/135fc86c54626e8fc843eca0a437bee878315949/ghc >--------------------------------------------------------------- commit 135fc86c54626e8fc843eca0a437bee878315949 Author: Thomas Miedema Date: Sat Jun 18 23:28:26 2016 +0200 Testsuite: remove `-Wno-warn-tabs` from default flags This allows the removal of the override_flags stuff in testlib.py. >--------------------------------------------------------------- 135fc86c54626e8fc843eca0a437bee878315949 testsuite/driver/testlib.py | 49 ++++------------------ testsuite/mk/test.mk | 8 ---- testsuite/tests/deSugar/should_compile/all.T | 4 +- .../tests/ghci.debugger/scripts/print020.script | 2 +- testsuite/tests/ghci/scripts/all.T | 5 +-- testsuite/tests/ghci/scripts/ghci024.stdout | 1 - testsuite/tests/module/all.T | 2 +- testsuite/tests/rename/should_compile/timing002.hs | 1 + testsuite/tests/warnings/should_compile/all.T | 5 ++- 9 files changed, 20 insertions(+), 57 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 135fc86c54626e8fc843eca0a437bee878315949 From git at git.haskell.org Mon Jun 20 14:37:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:00 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: tabs -> spaces [skip ci] (a7160fa) Message-ID: <20160620143700.4C48A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a7160faafd44d64c2b20a4cc65e80136a93e1aaa/ghc >--------------------------------------------------------------- commit a7160faafd44d64c2b20a4cc65e80136a93e1aaa Author: Thomas Miedema Date: Sat Jun 18 22:44:19 2016 +0200 Testsuite: tabs -> spaces [skip ci] >--------------------------------------------------------------- a7160faafd44d64c2b20a4cc65e80136a93e1aaa libraries/base/tests/IO/hGetBuf001.hs | 82 ++++----- libraries/base/tests/IO/hGetChar001.hs | 4 +- libraries/base/tests/IO/hGetLine003.hs | 8 +- libraries/base/tests/IO/hGetPosn001.hs | 2 +- libraries/base/tests/IO/hSetBuffering002.hs | 4 +- libraries/base/tests/IO/hSetBuffering002.stdout | 4 +- libraries/base/tests/IO/ioeGetErrorString001.hs | 6 +- libraries/base/tests/IO/ioeGetFileName001.hs | 6 +- libraries/base/tests/IO/ioeGetHandle001.hs | 6 +- libraries/base/tests/IO/misc001.hs | 4 +- libraries/base/tests/IO/openFile001.hs | 4 +- libraries/base/tests/IO/openFile004.hs | 6 +- libraries/base/tests/IO/readwrite002.hs | 6 +- libraries/base/tests/enum01.hs | 30 ++-- libraries/base/tests/enum04.hs | 8 +- libraries/base/tests/hGetBuf002.hs | 14 +- libraries/base/tests/hGetBuf002.stdout | 28 +-- libraries/base/tests/hGetBuf003.hs | 14 +- libraries/base/tests/hGetBuf003.stdout | 28 +-- libraries/base/tests/list001.hs | 6 +- libraries/base/tests/list002.hs | 2 +- libraries/base/tests/memo002.hs | 8 +- libraries/base/tests/reads001.hs | 8 +- libraries/base/tests/stableptr001.hs | 12 +- libraries/base/tests/text001.hs | 2 +- libraries/base/tests/trace001.hs | 8 +- libraries/base/tests/tup001.hs | 12 +- testsuite/tests/array/should_run/arr013.hs | 16 +- testsuite/tests/array/should_run/arr014.hs | 16 +- testsuite/tests/array/should_run/arr015.hs | 10 +- testsuite/tests/array/should_run/arr016.hs | 36 ++-- testsuite/tests/codeGen/should_compile/cg004.hs | 16 +- testsuite/tests/codeGen/should_compile/jmp_tbl.hs | 6 +- testsuite/tests/codeGen/should_run/T2080.hs | 2 +- testsuite/tests/codeGen/should_run/T5900.hs | 10 +- testsuite/tests/codeGen/should_run/cgrun002.hs | 4 +- testsuite/tests/codeGen/should_run/cgrun003.hs | 4 +- testsuite/tests/codeGen/should_run/cgrun006.hs | 6 +- testsuite/tests/codeGen/should_run/cgrun007.hs | 8 +- testsuite/tests/codeGen/should_run/cgrun008.hs | 10 +- testsuite/tests/codeGen/should_run/cgrun011.hs | 10 +- testsuite/tests/codeGen/should_run/cgrun012.hs | 40 ++--- testsuite/tests/codeGen/should_run/cgrun013.hs | 54 +++--- testsuite/tests/codeGen/should_run/cgrun015.hs | 14 +- testsuite/tests/codeGen/should_run/cgrun017.hs | 2 +- testsuite/tests/codeGen/should_run/cgrun018.hs | 4 +- testsuite/tests/codeGen/should_run/cgrun021.hs | 6 +- testsuite/tests/codeGen/should_run/cgrun022.hs | 4 +- testsuite/tests/codeGen/should_run/cgrun026.hs | 190 ++++++++++----------- testsuite/tests/codeGen/should_run/cgrun027.hs | 2 +- testsuite/tests/codeGen/should_run/cgrun031.hs | 4 +- testsuite/tests/codeGen/should_run/cgrun033.hs | 32 ++-- testsuite/tests/codeGen/should_run/cgrun034.hs | 162 +++++++++--------- testsuite/tests/codeGen/should_run/cgrun036.hs | 4 +- testsuite/tests/codeGen/should_run/cgrun040.hs | 2 +- testsuite/tests/codeGen/should_run/cgrun047.hs | 2 +- testsuite/tests/codeGen/should_run/cgrun049.hs | 4 +- testsuite/tests/codeGen/should_run/cgrun050.hs | 4 +- testsuite/tests/codeGen/should_run/cgrun051.hs | 2 +- testsuite/tests/codeGen/should_run/cgrun052.hs | 4 +- testsuite/tests/codeGen/should_run/cgrun054.hs | 6 +- testsuite/tests/codeGen/should_run/cgrun058.hs | 2 +- testsuite/tests/deSugar/should_run/T246.hs | 10 +- testsuite/tests/deSugar/should_run/dsrun001.hs | 6 +- testsuite/tests/deSugar/should_run/dsrun002.hs | 12 +- testsuite/tests/deSugar/should_run/dsrun003.hs | 6 +- testsuite/tests/deSugar/should_run/dsrun004.hs | 2 +- testsuite/tests/deSugar/should_run/dsrun005.hs | 12 +- testsuite/tests/deSugar/should_run/dsrun006.hs | 12 +- testsuite/tests/deSugar/should_run/dsrun010.hs | 4 +- testsuite/tests/deSugar/should_run/dsrun014.hs | 2 +- testsuite/tests/ghci/prog008/A.hs | 4 +- testsuite/tests/ghci/scripts/Defer03.hs | 0 testsuite/tests/ghci/should_run/ghcirun001.hs | 6 +- testsuite/tests/haddock/haddock_examples/Test.hs | 136 +++++++-------- .../haddock/haddock_examples/haddock.Test.stderr | 2 +- .../haddockSimplUtilsBug.hs | 48 +++--- .../tests/indexed-types/should_compile/Col2.hs | 2 +- .../indexed-types/should_compile/ColGivenCheck.hs | 10 +- .../indexed-types/should_compile/ColGivenCheck2.hs | 18 +- .../indexed-types/should_compile/ColInference.hs | 10 +- .../indexed-types/should_compile/ColInference2.hs | 4 +- .../indexed-types/should_compile/ColInference3.hs | 14 +- .../indexed-types/should_compile/ColInference4.hs | 4 +- .../indexed-types/should_compile/ColInference5.hs | 4 +- .../tests/indexed-types/should_compile/Deriving.hs | 2 +- .../should_compile/DerivingNewType.hs | 4 +- .../tests/indexed-types/should_compile/Gentle.hs | 6 +- .../indexed-types/should_compile/GivenCheck.hs | 4 +- .../should_compile/GivenCheckDecomp.hs | 2 +- .../indexed-types/should_compile/GivenCheckSwap.hs | 4 +- testsuite/tests/indexed-types/should_compile/HO.hs | 10 +- .../indexed-types/should_compile/InstEqContext.hs | 2 +- .../indexed-types/should_compile/InstEqContext3.hs | 2 +- .../tests/indexed-types/should_compile/Roman1.hs | 4 +- .../tests/indexed-types/should_compile/Simple2.hs | 4 +- .../tests/indexed-types/should_compile/T3590.hs | 2 +- .../tests/indexed-types/should_compile/T4160.hs | 10 +- .../tests/indexed-types/should_compile/T4178.hs | 10 +- .../tests/indexed-types/should_fail/NoMatchErr.hs | 2 +- .../indexed-types/should_fail/SimpleFail2b.hs | 4 +- .../tests/indexed-types/should_run/GMapAssoc.hs | 18 +- .../tests/indexed-types/should_run/GMapTop.hs | 18 +- testsuite/tests/stranal/should_compile/T1988.hs | 2 +- testsuite/tests/stranal/should_compile/newtype.hs | 4 +- testsuite/tests/stranal/should_compile/str002.hs | 2 +- testsuite/tests/stranal/should_run/strun002.hs | 2 +- testsuite/tests/stranal/should_run/strun003.hs | 4 +- 108 files changed, 735 insertions(+), 735 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 a7160faafd44d64c2b20a4cc65e80136a93e1aaa From git at git.haskell.org Mon Jun 20 14:37:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:02 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: recover from utf8 decoding errors (4a4bdda) Message-ID: <20160620143702.ED1D13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4a4bdda1e5564fa3cd27cb7d94eb36d415d4b574/ghc >--------------------------------------------------------------- commit 4a4bdda1e5564fa3cd27cb7d94eb36d415d4b574 Author: Thomas Miedema Date: Mon Jun 20 10:30:12 2016 +0200 Testsuite: recover from utf8 decoding errors >--------------------------------------------------------------- 4a4bdda1e5564fa3cd27cb7d94eb36d415d4b574 testsuite/driver/testlib.py | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 1c20936..8fc1481 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1498,7 +1498,7 @@ def interpreter_run( name, way, extra_hc_opts, compile_only, top_mod ): def split_file(in_fn, delimiter, out1_fn, out2_fn): # See Note [Universal newlines]. - infile = io.open(in_fn, 'r', encoding='utf8', newline=None) + infile = io.open(in_fn, 'r', encoding='utf8', errors='replace', newline=None) out1 = io.open(out1_fn, 'w', encoding='utf8', newline='') out2 = io.open(out2_fn, 'w', encoding='utf8', newline='') @@ -1569,7 +1569,7 @@ def read_no_crs(file): str = '' try: # See Note [Universal newlines]. - h = io.open(file, 'r', encoding='utf8', newline=None) + h = io.open(file, 'r', encoding='utf8', errors='replace', newline=None) str = h.read() h.close except: @@ -1602,6 +1602,12 @@ def write_file(file, str): # # This should work with both python2 and python3, and with both mingw* # as msys2 style Python. +# +# Do note that io.open returns unicode strings. So we have to specify +# the expected encoding. But there is at least one file which is not +# valid utf8 (decodingerror002.stdout). Solution: use errors='replace'. +# Another solution would be to open files in binary mode always, and +# operate on bytes. def check_hp_ok(name): opts = getTestOpts() From git at git.haskell.org Mon Jun 20 14:37:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:05 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: remove Windows CR [skip ci] (cf6e656) Message-ID: <20160620143705.9DAA03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cf6e65693588cd9d40c895279f2e53d3d25a2c58/ghc >--------------------------------------------------------------- commit cf6e65693588cd9d40c895279f2e53d3d25a2c58 Author: Thomas Miedema Date: Sat Jun 18 22:08:53 2016 +0200 Testsuite: remove Windows CR [skip ci] >--------------------------------------------------------------- cf6e65693588cd9d40c895279f2e53d3d25a2c58 testsuite/tests/arrows/should_fail/T5380.stderr | 0 testsuite/tests/dependent/should_compile/T11241.stderr | 0 testsuite/tests/deriving/should_fail/T7148.stderr | 0 testsuite/tests/deriving/should_fail/T7148a.stderr | 0 testsuite/tests/gadt/T3169.stderr | 0 testsuite/tests/gadt/T7558.stderr | 0 testsuite/tests/gadt/gadt-escape1.stderr | 0 testsuite/tests/gadt/rw.stderr | 0 testsuite/tests/ghc-api/landmines/landmines.stdout | 0 testsuite/tests/ghci/linking/dyn/T11072gcc.stdout | 0 testsuite/tests/ghci/linking/dyn/T11072msvc.stdout | 0 testsuite/tests/ghci/scripts/Defer02.stderr | 0 testsuite/tests/ghci/scripts/T10248.stderr | 0 testsuite/tests/ghci/scripts/ghci050.stderr | 0 testsuite/tests/indexed-types/should_compile/Simple14.stderr | 0 testsuite/tests/indexed-types/should_fail/GADTwrong1.stderr | 0 testsuite/tests/indexed-types/should_fail/Overlap6.stderr | 0 testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr | 0 testsuite/tests/indexed-types/should_fail/T2664.stderr | 0 testsuite/tests/indexed-types/should_fail/T3330a.stderr | 0 testsuite/tests/indexed-types/should_fail/T3440.stderr | 0 testsuite/tests/indexed-types/should_fail/T4093a.stderr | 0 testsuite/tests/indexed-types/should_fail/T4093b.stderr | 0 testsuite/tests/indexed-types/should_fail/T4174.stderr | 0 testsuite/tests/indexed-types/should_fail/T4272.stderr | 0 testsuite/tests/indexed-types/should_fail/T7786.stderr | 0 testsuite/tests/indexed-types/should_fail/T9662.stderr | 0 testsuite/tests/module/mod71.stderr | 0 testsuite/tests/rename/should_fail/rnfail026.stderr | 0 testsuite/tests/rts/T11223/T11223_link_order_a_b_2_fail.stderr-mingw32 | 0 testsuite/tests/rts/T11223/T11223_link_order_a_b_succeed.stdout | 0 testsuite/tests/rts/T11223/T11223_link_order_b_a_2_succeed.stdout | 0 testsuite/tests/rts/T11223/T11223_link_order_b_a_succeed.stdout | 0 testsuite/tests/rts/T11223/T11223_simple_link.stdout | 0 testsuite/tests/rts/T11223/T11223_simple_link_lib.stdout | 0 testsuite/tests/rts/T11223/T11223_simple_unused_duplicate_lib.stdout | 0 testsuite/tests/th/T10267.stderr | 0 37 files changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Mon Jun 20 14:37:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:08 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: assume timeout_prog always exists (e170d19) Message-ID: <20160620143708.4773D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e170d19702504dd80c2d19f63322c6a219d65f8d/ghc >--------------------------------------------------------------- commit e170d19702504dd80c2d19f63322c6a219d65f8d Author: Thomas Miedema Date: Mon Jun 20 13:07:19 2016 +0200 Testsuite: assume timeout_prog always exists Merge the following functions into one: * rawSystem * rawSystemWithTimeout * runCmd * runCmdFor * runCmdExitCode I don't know why this wasn't done before. >--------------------------------------------------------------- e170d19702504dd80c2d19f63322c6a219d65f8d testsuite/driver/testlib.py | 114 +++++++++++--------------------------------- 1 file changed, 28 insertions(+), 86 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 4f18c01..0fc764b 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -855,14 +855,10 @@ def do_test(name, way, func, args, files): if config.use_threads: t.lock.release() - try: - preCmd = getTestOpts().pre_cmd - if preCmd != None: - result = runCmdFor(name, 'cd "{opts.testdir}" && {preCmd}'.format(**locals())) - if result != 0: - framework_fail(name, way, 'pre-command failed: ' + str(result)) - except: - framework_fail(name, way, 'pre-command exception') + if opts.pre_cmd: + exit_code = runCmd('cd "{0}" && {1}'.format(opts.testdir, opts.pre_cmd)) + if exit_code != 0: + framework_fail(name, way, 'pre_cmd failed: {0}'.format(exit_code)) try: result = func(*[name,way] + args) @@ -1230,11 +1226,11 @@ def simple_build(name, way, extra_hc_opts, should_fail, top_mod, link, addsuf): '> {errname} 2>&1' ).format(**locals()) - result = runCmdFor(name, cmd, timeout_multiplier=opts.compile_timeout_multiplier) + exit_code = runCmd(cmd, opts.compile_timeout_multiplier) - if result != 0 and not should_fail: + if exit_code != 0 and not should_fail: if config.verbose >= 1 and _expect_pass(way): - print('Compile failed (status ' + repr(result) + ') errors were:') + 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) @@ -1246,10 +1242,10 @@ def simple_build(name, way, extra_hc_opts, should_fail, top_mod, link, addsuf): return statsResult if should_fail: - if result == 0: + if exit_code == 0: return failBecause('exit code 0') else: - if result != 0: + if exit_code != 0: return failBecause('exit code non-0') return passed() @@ -1310,10 +1306,7 @@ def simple_run(name, way, prog, extra_run_opts): cmd = 'cd "{opts.testdir}" && {cmd}'.format(**locals()) # run the command - result = runCmdFor(name, cmd, timeout_multiplier=opts.run_timeout_multiplier) - - exit_code = result >> 8 - signal = result & 0xff + exit_code = runCmd(cmd, opts.run_timeout_multiplier) # check the exit code if exit_code != opts.exit_code: @@ -1415,10 +1408,7 @@ def interpreter_run( name, way, extra_hc_opts, compile_only, top_mod ): cmd = 'cd "{opts.testdir}" && {cmd}'.format(**locals()) - result = runCmdFor(name, cmd, timeout_multiplier=opts.run_timeout_multiplier) - - exit_code = result >> 8 - signal = result & 0xff + exit_code = runCmd(cmd, opts.run_timeout_multiplier) # split the stdout into compilation/program output split_file(in_testdir(outname), delimiter, @@ -1556,14 +1546,14 @@ def check_hp_ok(name): # do not qualify for hp2ps because we should be in the right directory hp2psCmd = 'cd "{opts.testdir}" && {{hp2ps}} {name}'.format(**locals()) - hp2psResult = runCmdExitCode(hp2psCmd) + hp2psResult = runCmd(hp2psCmd) actual_ps_path = in_testdir(name, 'ps') - if(hp2psResult == 0): - if (os.path.exists(actual_ps_path)): + if hp2psResult == 0: + if os.path.exists(actual_ps_path): if gs_working: - gsResult = runCmdExitCode(genGSCmd(actual_ps_path)) + gsResult = runCmd(genGSCmd(actual_ps_path)) if (gsResult == 0): return (True) else: @@ -1837,75 +1827,27 @@ def if_verbose_dump( n, f ): except: print('') -def rawSystem(cmd_and_args): - # We prefer subprocess.call to os.spawnv as the latter - # seems to send its arguments through a shell or something - # with the Windows (non-cygwin) python. An argument "a b c" - # turns into three arguments ["a", "b", "c"]. +def runCmd(cmd, timeout_multiplier=1.0): + timeout_prog = strip_quotes(config.timeout_prog) + timeout = str(int(ceil(config.timeout * timeout_multiplier))) - cmd = cmd_and_args[0] - return subprocess.call([strip_quotes(cmd)] + cmd_and_args[1:]) + # Format cmd using config. Example: cmd='{hpc} report A.tix' + cmd = cmd.format(**config.__dict__) + if_verbose( 3, cmd ) -# Note that this doesn't handle the timeout itself; it is just used for -# commands that have timeout handling built-in. -def rawSystemWithTimeout(cmd_and_args): - r = rawSystem(cmd_and_args) + # cmd is a complex command in Bourne-shell syntax + # e.g (cd . && 'C:/users/simonpj/HEAD/inplace/bin/ghc-stage2' ...etc) + # Hence it must ultimately be run by a Bourne shell. It's timeout's job + # to invoke the Bourne shell + r = subprocess.call([timeout_prog, timeout, cmd]) if r == 98: # The python timeout program uses 98 to signal that ^C was pressed stopNow() if r == 99 and getTestOpts().exit_code != 99: # Only print a message when timeout killed the process unexpectedly. - cmd = cmd_and_args[-1] if_verbose(1, 'Timeout happened...killed process "{0}"...\n'.format(cmd)) return r -# cmd is a complex command in Bourne-shell syntax -# e.g (cd . && 'c:/users/simonpj/darcs/HEAD/compiler/stage1/ghc-inplace' ...etc) -# Hence it must ultimately be run by a Bourne shell -# -# Mostly it invokes the command wrapped in 'timeout' thus -# timeout 300 'cd . && ...blah blah' -# so it's timeout's job to invoke the Bourne shell -# -# But watch out for the case when there is no timeout program! -# Then, when using the native Python, os.system will invoke the cmd shell - -def runCmd( cmd ): - # Format cmd using config. Example: cmd='{hpc} report A.tix' - cmd = cmd.format(**config.__dict__) - - if_verbose( 3, cmd ) - r = 0 - if config.os == 'mingw32': - # On MinGW, we will always have timeout - assert config.timeout_prog!='' - - if config.timeout_prog != '': - r = rawSystemWithTimeout([config.timeout_prog, str(config.timeout), cmd]) - else: - r = os.system(cmd) - return r << 8 - -def runCmdFor( name, cmd, timeout_multiplier=1.0 ): - # Format cmd using config. Example: cmd='{hpc} report A.tix' - cmd = cmd.format(**config.__dict__) - - if_verbose( 3, cmd ) - r = 0 - if config.os == 'mingw32': - # On MinGW, we will always have timeout - assert config.timeout_prog!='' - timeout = int(ceil(config.timeout * timeout_multiplier)) - - if config.timeout_prog != '': - r = rawSystemWithTimeout([config.timeout_prog, str(timeout), cmd]) - else: - r = os.system(cmd) - return r << 8 - -def runCmdExitCode( cmd ): - return (runCmd(cmd) >> 8); - # ----------------------------------------------------------------------------- # checking if ghostscript is available for checking the output of hp2ps @@ -1920,9 +1862,9 @@ global gs_working gs_working = 0 if config.have_profiling: if config.gs != '': - resultGood = runCmdExitCode(genGSCmd(config.confdir + '/good.ps')); + resultGood = runCmd(genGSCmd(config.confdir + '/good.ps')); if resultGood == 0: - resultBad = runCmdExitCode(genGSCmd(config.confdir + '/bad.ps') + + resultBad = runCmd(genGSCmd(config.confdir + '/bad.ps') + ' >/dev/null 2>&1') if resultBad != 0: print("GhostScript available for hp2ps tests") From git at git.haskell.org Mon Jun 20 14:37:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:10 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: tabs -> spaces [skip ci] (5b03dc6) Message-ID: <20160620143710.F2D193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5b03dc69389dc387b922c589ab9a8b92079e6a96/ghc >--------------------------------------------------------------- commit 5b03dc69389dc387b922c589ab9a8b92079e6a96 Author: Thomas Miedema Date: Sat Jun 18 22:44:19 2016 +0200 Testsuite: tabs -> spaces [skip ci] >--------------------------------------------------------------- 5b03dc69389dc387b922c589ab9a8b92079e6a96 libraries/base/tests/Memo1.lhs | 76 ++-- libraries/base/tests/Memo2.lhs | 76 ++-- testsuite/tests/concurrent/prog001/Arithmetic.hs | 220 +++++------ testsuite/tests/concurrent/prog001/Converter.hs | 88 ++--- testsuite/tests/concurrent/prog001/Mult.hs | 420 ++++++++++----------- testsuite/tests/concurrent/prog001/Stream.hs | 84 ++--- testsuite/tests/concurrent/prog001/Thread.hs | 42 +-- testsuite/tests/concurrent/prog001/Trit.hs | 44 +-- testsuite/tests/concurrent/prog001/Utilities.hs | 6 +- testsuite/tests/concurrent/prog002/Scheduler.hs | 4 +- testsuite/tests/concurrent/prog002/Server.hs | 6 +- testsuite/tests/concurrent/should_run/T5421.hs | 14 +- testsuite/tests/concurrent/should_run/conc001.hs | 2 +- testsuite/tests/concurrent/should_run/conc002.hs | 6 +- testsuite/tests/concurrent/should_run/conc003.hs | 20 +- testsuite/tests/concurrent/should_run/conc004.hs | 6 +- testsuite/tests/concurrent/should_run/conc006.hs | 12 +- testsuite/tests/concurrent/should_run/conc010.hs | 2 +- testsuite/tests/concurrent/should_run/conc012.hs | 6 +- testsuite/tests/concurrent/should_run/conc014.hs | 4 +- testsuite/tests/concurrent/should_run/conc015.hs | 14 +- testsuite/tests/concurrent/should_run/conc015a.hs | 16 +- testsuite/tests/concurrent/should_run/conc016.hs | 6 +- testsuite/tests/concurrent/should_run/conc017.hs | 30 +- testsuite/tests/concurrent/should_run/conc017a.hs | 32 +- testsuite/tests/concurrent/should_run/conc018.hs | 10 +- testsuite/tests/concurrent/should_run/conc019.hs | 2 +- testsuite/tests/concurrent/should_run/conc022.hs | 20 +- testsuite/tests/concurrent/should_run/conc024.hs | 4 +- testsuite/tests/concurrent/should_run/conc025.hs | 12 +- testsuite/tests/concurrent/should_run/conc031.hs | 12 +- testsuite/tests/concurrent/should_run/conc033.hs | 2 +- testsuite/tests/concurrent/should_run/conc034.hs | 18 +- testsuite/tests/concurrent/should_run/conc035.hs | 12 +- testsuite/tests/concurrent/should_run/conc036.hs | 6 +- testsuite/tests/concurrent/should_run/conc038.hs | 4 +- testsuite/tests/concurrent/should_run/conc039.hs | 16 +- testsuite/tests/concurrent/should_run/conc068.hs | 2 +- testsuite/tests/deriving/should_compile/drv005.hs | 2 +- testsuite/tests/deriving/should_compile/drv006.hs | 2 +- testsuite/tests/deriving/should_compile/drv015.hs | 2 +- testsuite/tests/deriving/should_compile/drv020.hs | 12 +- testsuite/tests/deriving/should_fail/T4846.hs | 0 testsuite/tests/deriving/should_fail/drvfail001.hs | 4 +- testsuite/tests/deriving/should_fail/drvfail002.hs | 2 +- testsuite/tests/deriving/should_fail/drvfail006.hs | 4 +- testsuite/tests/deriving/should_fail/drvfail009.hs | 8 +- testsuite/tests/deriving/should_run/drvrun005.hs | 12 +- testsuite/tests/deriving/should_run/drvrun006.hs | 22 +- testsuite/tests/deriving/should_run/drvrun009.hs | 8 +- testsuite/tests/deriving/should_run/drvrun010.hs | 2 +- testsuite/tests/deriving/should_run/drvrun011.hs | 4 +- testsuite/tests/deriving/should_run/drvrun013.hs | 6 +- testsuite/tests/deriving/should_run/drvrun018.hs | 2 +- testsuite/tests/deriving/should_run/drvrun020.hs | 20 +- testsuite/tests/deriving/should_run/drvrun021.hs | 12 +- testsuite/tests/th/T3920.hs | 6 +- testsuite/tests/th/T4135.hs | 4 +- testsuite/tests/th/T5379.hs | 2 +- testsuite/tests/th/TH_exn1.hs | 2 +- testsuite/tests/th/TH_genExLib.hs | 12 +- testsuite/tests/th/TH_repPrim.hs | 8 +- testsuite/tests/th/TH_spliceE4.hs | 2 +- testsuite/tests/th/TH_tuple1.hs | 12 +- 64 files changed, 764 insertions(+), 764 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 5b03dc69389dc387b922c589ab9a8b92079e6a96 From git at git.haskell.org Mon Jun 20 14:37:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:16 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: fix WAY=ghci when LOCAL=0 (6d0a4fc) Message-ID: <20160620143716.47EA23A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6d0a4fc5af4ca2ff9b3db7168273a7ceb01c6c38/ghc >--------------------------------------------------------------- commit 6d0a4fc5af4ca2ff9b3db7168273a7ceb01c6c38 Author: Thomas Miedema Date: Sun Jun 19 14:58:46 2016 +0200 Testsuite: fix WAY=ghci when LOCAL=0 >--------------------------------------------------------------- 6d0a4fc5af4ca2ff9b3db7168273a7ceb01c6c38 testsuite/driver/testlib.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 8fc1481..4dce6e3 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1320,7 +1320,7 @@ def simple_run(name, way, prog, extra_run_opts): use_stdin = opts.stdin else: stdin_file = add_suffix(name, 'stdin') - if os.path.exists(in_srcdir(stdin_file)): + if os.path.exists(in_testdir(stdin_file)): use_stdin = stdin_file else: use_stdin = '/dev/null' @@ -1441,12 +1441,12 @@ def interpreter_run( name, way, extra_hc_opts, compile_only, top_mod ): # figure out what to use for stdin if getTestOpts().stdin != '': - stdin_file = in_srcdir(opts.stdin) + stdin_file = in_testdir(opts.stdin) else: - stdin_file = in_srcdir(name, 'stdin') + stdin_file = in_testdir(name, 'stdin') if os.path.exists(stdin_file): - os.system('cat ' + stdin_file + ' >>' + qscriptname) + os.system('cat "{0}" >> "{1}"'.format(stdin_file, qscriptname)) flags = ' '.join(get_compiler_flags(override_flags=None, noforce=False) + config.way_flags(name)[way]) From git at git.haskell.org Mon Jun 20 14:37:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:13 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: *do* replace backslashes in config.libdir (1ddc10b) Message-ID: <20160620143713.9D5FD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1ddc10bb405e0f88584784bd42f5bdd5ded24dcf/ghc >--------------------------------------------------------------- commit 1ddc10bb405e0f88584784bd42f5bdd5ded24dcf Author: Thomas Miedema Date: Mon Jun 20 00:54:38 2016 +0200 Testsuite: *do* replace backslashes in config.libdir See `Note [Replacing backward slashes in config.libdir]` There is one caveat: in ae4acbd1ba4168b867a1b5fe8de50c0199dfc1f4 I mentioned: > Changing backwards slashes to forward slashes apparently confuses > msys2/mingw magic path handling. I can not reproduce that problem anymore, however. This patch validates for me, and fixes all tests that use config.libdir for WAY=ghci. We'll see how it goes. >--------------------------------------------------------------- 1ddc10bb405e0f88584784bd42f5bdd5ded24dcf testsuite/config/ghc | 35 ++++++++++++++++++++++++++++++++++- 1 file changed, 34 insertions(+), 1 deletion(-) diff --git a/testsuite/config/ghc b/testsuite/config/ghc index 3be803d..cf9a7ba 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -173,7 +173,8 @@ def get_compiler_info(): s = re.sub('[\r\n]', '', s) rtsInfoDict = dict(eval(s)) - config.libdir = compilerInfoDict['LibDir'] + # See Note [Replacing backward slashes in config.libdir]. + config.libdir = compilerInfoDict['LibDir'].replace('\\', '/') v = compilerInfoDict["Project version"] config.compiler_version = v @@ -224,3 +225,35 @@ def get_compiler_info(): config.plugin_way_flags = "-static" config.ghc_th_way = "normal" config.ghc_plugin_way = "normal" + +# Note [Replacing backward slashes in config.libdir] +# +# We *do* need to replace backslashes in config.libdir, for the following +# reason: +# +# * Tests use config.libdir as follows: +# +# extra_run_opts('"' + config.libdir + '"') +# +# The double quotes are there because config.libdir might contain +# spaces. +# +# * This string is then written /as is/ to .genscript in +# testlib.interpreter_run: +# +# script.write(':set args ' + opts.extra_run_opts + '\n') +# +# * But GHCi expects the arguments to ':set args' to be proper Haskell +# strings (when they are quoted), with backslashes escaped. Since +# config.libdir contains single backslash characters, tests such as T5313 +# will fail for WAY=ghci with "Pattern match failure in do expression". +# +# Arguably the above code for writing `:set args` should be smarter. This +# is tricky to get right though, because in GHCI `:set args foo\bar` (no +# double quotes) works perfectly fine, and is interpreted as the Haskell +# string "foo\\bar". Therfore, simply escaping all backward slashes in +# opts.extra_run_opts before concatenating it with ':set args' is not right +# either. +# +# Replacing backslashes to forward slashes in config.libdir works around the +# problem. From git at git.haskell.org Mon Jun 20 14:37:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:18 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: remove Windows CR [skip ci] (9cdde38) Message-ID: <20160620143718.E574B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9cdde38144331510673b5296b00c88fbe566adcf/ghc >--------------------------------------------------------------- commit 9cdde38144331510673b5296b00c88fbe566adcf Author: Thomas Miedema Date: Sat Jun 18 22:07:49 2016 +0200 Testsuite: remove Windows CR [skip ci] >--------------------------------------------------------------- 9cdde38144331510673b5296b00c88fbe566adcf testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr | 0 testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr | 0 testsuite/tests/partial-sigs/should_compile/Either.stderr | 0 testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr | 0 testsuite/tests/partial-sigs/should_compile/ExprSigLocal.stderr | 0 testsuite/tests/partial-sigs/should_compile/ExtraConstraints1.stderr | 0 testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr | 0 testsuite/tests/partial-sigs/should_compile/Meltdown.stderr | 0 testsuite/tests/partial-sigs/should_compile/NamedTyVar.stderr | 0 testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr | 0 testsuite/tests/partial-sigs/should_compile/SkipMany.stderr | 0 testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr | 0 testsuite/tests/partial-sigs/should_compile/SuperCls.stderr | 0 testsuite/tests/partial-sigs/should_compile/T10438.stderr | 0 testsuite/tests/partial-sigs/should_compile/T10519.stderr | 0 testsuite/tests/partial-sigs/should_compile/T11016.stderr | 0 testsuite/tests/partial-sigs/should_compile/T11339a.stderr | 0 testsuite/tests/partial-sigs/should_compile/T11670.stderr | 0 testsuite/tests/partial-sigs/should_compile/Uncurry.stderr | 0 testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr | 0 testsuite/tests/partial-sigs/should_fail/Defaulting1MROff.stderr | 0 .../should_fail/ExtraConstraintsWildcardInExpressionSignature.stderr | 0 .../partial-sigs/should_fail/ExtraConstraintsWildcardNotEnabled.stderr | 0 .../should_fail/InstantiatedNamedWildcardsInConstraints.stderr | 0 .../tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr | 0 .../tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr | 0 testsuite/tests/partial-sigs/should_fail/NamedWildcardsEnabled.stderr | 0 testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotEnabled.stderr | 0 .../tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr | 0 .../tests/partial-sigs/should_fail/PartialTypeSignaturesDisabled.stderr | 0 testsuite/tests/partial-sigs/should_fail/PatBind3.stderr | 0 testsuite/tests/partial-sigs/should_fail/T10615.stderr | 0 testsuite/tests/partial-sigs/should_fail/T10999.stderr | 0 testsuite/tests/partial-sigs/should_fail/T11122.stderr | 0 testsuite/tests/partial-sigs/should_fail/T11976.stderr | 0 testsuite/tests/partial-sigs/should_fail/TidyClash.stderr | 0 testsuite/tests/partial-sigs/should_fail/TidyClash2.stderr | 0 .../tests/partial-sigs/should_fail/WildcardsInPatternAndExprSig.stderr | 0 testsuite/tests/polykinds/T10503.stderr | 0 testsuite/tests/polykinds/T11399.stderr | 0 testsuite/tests/polykinds/T7594.stderr | 0 41 files changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Mon Jun 20 14:37:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:21 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: remove Windows CR again.. [skip ci] (cdc14b4) Message-ID: <20160620143721.9BF673A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cdc14b480adc58c2937d54d0db0fd36e4ed532b0/ghc >--------------------------------------------------------------- commit cdc14b480adc58c2937d54d0db0fd36e4ed532b0 Author: Thomas Miedema Date: Sat Jun 18 22:05:51 2016 +0200 Testsuite: remove Windows CR again.. [skip ci] >--------------------------------------------------------------- cdc14b480adc58c2937d54d0db0fd36e4ed532b0 testsuite/tests/patsyn/should_fail/T11010.stderr | 0 testsuite/tests/patsyn/should_fail/T11039.stderr | 0 testsuite/tests/patsyn/should_fail/T11667.stderr | 0 testsuite/tests/typecheck/should_compile/ExPatFail.stderr | 0 testsuite/tests/typecheck/should_compile/FD1.stderr | 0 testsuite/tests/typecheck/should_compile/FD2.stderr | 0 testsuite/tests/typecheck/should_compile/FD3.stderr | 0 testsuite/tests/typecheck/should_compile/T10072.stderr | 0 testsuite/tests/typecheck/should_compile/T10632.stderr | 0 testsuite/tests/typecheck/should_compile/T11339.stderr | 0 testsuite/tests/typecheck/should_compile/T2494.stderr | 0 testsuite/tests/typecheck/should_compile/T9834.stderr | 0 testsuite/tests/typecheck/should_compile/T9939.stderr | 0 testsuite/tests/typecheck/should_compile/holes.stderr | 0 testsuite/tests/typecheck/should_compile/holes3.stderr | 0 testsuite/tests/typecheck/should_fail/T10285.stderr | 0 testsuite/tests/typecheck/should_fail/T10534.stderr | 0 testsuite/tests/typecheck/should_fail/T10715.stderr | 0 testsuite/tests/typecheck/should_fail/T11347.stderr | 0 testsuite/tests/typecheck/should_fail/T1899.stderr | 0 testsuite/tests/typecheck/should_fail/T2714.stderr | 0 testsuite/tests/typecheck/should_fail/T3102.stderr | 0 testsuite/tests/typecheck/should_fail/T5691.stderr | 0 testsuite/tests/typecheck/should_fail/T7264.stderr | 0 testsuite/tests/typecheck/should_fail/T7748a.stderr | 0 testsuite/tests/typecheck/should_fail/T7869.stderr | 0 testsuite/tests/typecheck/should_fail/T8450.stderr | 0 testsuite/tests/typecheck/should_fail/mc19.stderr | 0 testsuite/tests/typecheck/should_fail/mc21.stderr | 0 testsuite/tests/typecheck/should_fail/mc22.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail032.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail065.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail068.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail076.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail103.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail131.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail153.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail174.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail175.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail179.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail191.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail193.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail198.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail206.stderr | 0 44 files changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Mon Jun 20 14:37:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:24 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: tabs -> spaces [skip ci] (3dc1202) Message-ID: <20160620143724.51A9C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3dc1202546e63b50f828a34474717b1ddcbed5c7/ghc >--------------------------------------------------------------- commit 3dc1202546e63b50f828a34474717b1ddcbed5c7 Author: Thomas Miedema Date: Sat Jun 18 22:44:19 2016 +0200 Testsuite: tabs -> spaces [skip ci] >--------------------------------------------------------------- 3dc1202546e63b50f828a34474717b1ddcbed5c7 testsuite/tests/deSugar/should_compile/ds002.hs | 8 +- testsuite/tests/deSugar/should_compile/ds003.hs | 8 +- testsuite/tests/deSugar/should_compile/ds004.hs | 2 +- testsuite/tests/deSugar/should_compile/ds010.hs | 18 ++-- testsuite/tests/deSugar/should_compile/ds014.hs | 34 ++++---- testsuite/tests/deSugar/should_compile/ds016.hs | 16 ++-- testsuite/tests/deSugar/should_compile/ds017.hs | 10 +-- testsuite/tests/deSugar/should_compile/ds018.hs | 50 +++++------ testsuite/tests/deSugar/should_compile/ds020.hs | 32 +++---- testsuite/tests/deSugar/should_compile/ds021.hs | 6 +- testsuite/tests/deSugar/should_compile/ds022.hs | 12 +-- testsuite/tests/deSugar/should_compile/ds023.hs | 6 +- testsuite/tests/deSugar/should_compile/ds028.hs | 8 +- testsuite/tests/deSugar/should_compile/ds029.hs | 4 +- testsuite/tests/deSugar/should_compile/ds032.hs | 6 +- testsuite/tests/deSugar/should_compile/ds035.hs | 10 +-- testsuite/tests/deSugar/should_compile/ds036.hs | 6 +- testsuite/tests/deSugar/should_compile/ds040.hs | 16 ++-- testsuite/tests/deSugar/should_compile/ds041.hs | 6 +- testsuite/tests/deSugar/should_compile/ds056.hs | 4 +- testsuite/tests/deSugar/should_compile/ds058.hs | 4 +- testsuite/tests/dph/dotp/Main.hs | 26 +++--- testsuite/tests/dph/nbody/Body.hs | 12 +-- testsuite/tests/dph/primespj/Main.hs | 12 +-- testsuite/tests/dph/quickhull/Main.hs | 30 +++---- testsuite/tests/dph/quickhull/SVG.hs | 32 +++---- testsuite/tests/dph/quickhull/TestData.hs | 80 +++++++++--------- testsuite/tests/dph/sumnats/Main.hs | 18 ++-- testsuite/tests/dph/words/Main.hs | 46 +++++----- testsuite/tests/dph/words/WordsVect.hs | 74 ++++++++-------- testsuite/tests/patsyn/should_compile/ex-num.hs | 2 +- testsuite/tests/patsyn/should_compile/ex-prov.hs | 2 +- testsuite/tests/patsyn/should_compile/ex-view.hs | 2 +- testsuite/tests/patsyn/should_run/ex-prov-run.hs | 2 +- testsuite/tests/polykinds/T7238.hs | 8 +- .../typecheck/should_compile/LoopOfTheDay1.hs | 14 ++-- .../typecheck/should_compile/LoopOfTheDay2.hs | 28 +++---- testsuite/tests/typecheck/should_compile/T2497.hs | 2 +- testsuite/tests/typecheck/should_compile/T4355.hs | 4 +- testsuite/tests/typecheck/should_compile/T4361.hs | 2 +- testsuite/tests/typecheck/should_compile/T5514.hs | 4 +- .../tests/typecheck/should_compile/syn-perf.hs | 4 +- .../tests/typecheck/should_compile/syn-perf2.hs | 2 +- testsuite/tests/typecheck/should_compile/tc047.hs | 2 +- testsuite/tests/typecheck/should_compile/tc065.hs | 36 ++++---- testsuite/tests/typecheck/should_compile/tc077.hs | 2 +- testsuite/tests/typecheck/should_compile/tc080.hs | 14 ++-- testsuite/tests/typecheck/should_compile/tc081.hs | 18 ++-- testsuite/tests/typecheck/should_compile/tc082.hs | 6 +- testsuite/tests/typecheck/should_compile/tc084.hs | 4 +- testsuite/tests/typecheck/should_compile/tc086.hs | 2 +- testsuite/tests/typecheck/should_compile/tc087.hs | 38 ++++----- testsuite/tests/typecheck/should_compile/tc088.hs | 6 +- testsuite/tests/typecheck/should_compile/tc090.hs | 16 ++-- testsuite/tests/typecheck/should_compile/tc091.hs | 8 +- testsuite/tests/typecheck/should_compile/tc092.hs | 14 ++-- testsuite/tests/typecheck/should_compile/tc095.hs | 86 +++++++++---------- testsuite/tests/typecheck/should_compile/tc098.hs | 10 +-- testsuite/tests/typecheck/should_compile/tc108.hs | 6 +- testsuite/tests/typecheck/should_compile/tc125.hs | 2 +- testsuite/tests/typecheck/should_compile/tc126.hs | 8 +- testsuite/tests/typecheck/should_compile/tc130.hs | 6 +- testsuite/tests/typecheck/should_compile/tc134.hs | 2 +- testsuite/tests/typecheck/should_compile/tc136.hs | 2 +- testsuite/tests/typecheck/should_compile/tc137.hs | 2 +- testsuite/tests/typecheck/should_compile/tc140.hs | 8 +- testsuite/tests/typecheck/should_compile/tc141.hs | 4 +- testsuite/tests/typecheck/should_compile/tc142.hs | 4 +- testsuite/tests/typecheck/should_compile/tc145.hs | 10 +-- testsuite/tests/typecheck/should_compile/tc151.hs | 4 +- testsuite/tests/typecheck/should_compile/tc153.hs | 6 +- testsuite/tests/typecheck/should_compile/tc155.hs | 2 +- testsuite/tests/typecheck/should_compile/tc157.hs | 2 +- testsuite/tests/typecheck/should_compile/tc161.hs | 4 +- testsuite/tests/typecheck/should_compile/tc162.hs | 2 +- testsuite/tests/typecheck/should_compile/tc164.hs | 6 +- testsuite/tests/typecheck/should_compile/tc167.hs | 6 +- testsuite/tests/typecheck/should_compile/tc168.hs | 4 +- testsuite/tests/typecheck/should_compile/tc169.hs | 12 +-- testsuite/tests/typecheck/should_compile/tc170.hs | 2 +- testsuite/tests/typecheck/should_compile/tc177.hs | 6 +- testsuite/tests/typecheck/should_compile/tc179.hs | 12 +-- testsuite/tests/typecheck/should_compile/tc180.hs | 2 +- testsuite/tests/typecheck/should_compile/tc181.hs | 6 +- testsuite/tests/typecheck/should_compile/tc183.hs | 8 +- testsuite/tests/typecheck/should_compile/tc189.hs | 2 +- testsuite/tests/typecheck/should_compile/tc194.hs | 4 +- testsuite/tests/typecheck/should_compile/tc195.hs | 4 +- testsuite/tests/typecheck/should_compile/tc199.hs | 8 +- testsuite/tests/typecheck/should_compile/tc201.hs | 12 +-- testsuite/tests/typecheck/should_compile/tc205.hs | 2 +- testsuite/tests/typecheck/should_compile/tc207.hs | 18 ++-- testsuite/tests/typecheck/should_compile/tc211.hs | 12 +-- testsuite/tests/typecheck/should_compile/tc213.hs | 6 +- testsuite/tests/typecheck/should_compile/tc222.hs | 12 +-- testsuite/tests/typecheck/should_compile/tc223.hs | 4 +- testsuite/tests/typecheck/should_compile/tc231.hs | 2 +- testsuite/tests/typecheck/should_compile/tc235.hs | 2 +- testsuite/tests/typecheck/should_fail/T2307.hs | 2 +- testsuite/tests/typecheck/should_fail/T5684.hs | 0 testsuite/tests/typecheck/should_fail/T5853.hs | 8 +- testsuite/tests/typecheck/should_fail/tcfail032.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail038.hs | 8 +- testsuite/tests/typecheck/should_fail/tcfail040.hs | 14 ++-- testsuite/tests/typecheck/should_fail/tcfail043.hs | 98 +++++++++++----------- testsuite/tests/typecheck/should_fail/tcfail046.hs | 20 ++--- testsuite/tests/typecheck/should_fail/tcfail068.hs | 46 +++++----- testsuite/tests/typecheck/should_fail/tcfail069.hs | 8 +- testsuite/tests/typecheck/should_fail/tcfail070.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail076.hs | 12 +-- testsuite/tests/typecheck/should_fail/tcfail077.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail080.hs | 4 +- testsuite/tests/typecheck/should_fail/tcfail083.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail093.hs | 6 +- testsuite/tests/typecheck/should_fail/tcfail096.hs | 14 ++-- testsuite/tests/typecheck/should_fail/tcfail101.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail103.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail104.hs | 12 +-- testsuite/tests/typecheck/should_fail/tcfail105.hs | 4 +- testsuite/tests/typecheck/should_fail/tcfail112.hs | 10 +-- testsuite/tests/typecheck/should_fail/tcfail114.hs | 4 +- testsuite/tests/typecheck/should_fail/tcfail118.hs | 6 +- testsuite/tests/typecheck/should_fail/tcfail119.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail122.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail123.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail125.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail126.hs | 4 +- testsuite/tests/typecheck/should_fail/tcfail128.hs | 14 ++-- testsuite/tests/typecheck/should_fail/tcfail131.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail132.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail135.hs | 4 +- testsuite/tests/typecheck/should_fail/tcfail138.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail143.hs | 40 ++++----- testsuite/tests/typecheck/should_fail/tcfail149.hs | 8 +- testsuite/tests/typecheck/should_fail/tcfail157.hs | 4 +- testsuite/tests/typecheck/should_fail/tcfail159.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail169.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail170.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail181.hs | 4 +- testsuite/tests/typecheck/should_fail/tcfail185.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail198.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail201.hs | 4 +- testsuite/tests/typecheck/should_run/Defer01.hs | 0 testsuite/tests/typecheck/should_run/T1624.hs | 2 +- testsuite/tests/typecheck/should_run/TcRun025_B.hs | 58 ++++++------- testsuite/tests/typecheck/should_run/tcrun004.hs | 32 +++---- testsuite/tests/typecheck/should_run/tcrun005.hs | 10 +-- testsuite/tests/typecheck/should_run/tcrun006.hs | 2 +- testsuite/tests/typecheck/should_run/tcrun009.hs | 2 +- testsuite/tests/typecheck/should_run/tcrun011.hs | 6 +- testsuite/tests/typecheck/should_run/tcrun012.hs | 2 +- testsuite/tests/typecheck/should_run/tcrun016.hs | 34 ++++---- testsuite/tests/typecheck/should_run/tcrun017.hs | 6 +- testsuite/tests/typecheck/should_run/tcrun018.hs | 6 +- testsuite/tests/typecheck/should_run/tcrun019.hs | 6 +- testsuite/tests/typecheck/should_run/tcrun021.hs | 2 +- testsuite/tests/typecheck/should_run/tcrun023.hs | 2 +- testsuite/tests/typecheck/should_run/tcrun024.hs | 72 ++++++++-------- testsuite/tests/typecheck/should_run/tcrun025.hs | 12 +-- testsuite/tests/typecheck/should_run/tcrun026.hs | 4 +- testsuite/tests/typecheck/should_run/tcrun029.hs | 24 +++--- testsuite/tests/typecheck/should_run/tcrun031.hs | 2 +- testsuite/tests/typecheck/should_run/tcrun037.hs | 4 +- 163 files changed, 921 insertions(+), 921 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 3dc1202546e63b50f828a34474717b1ddcbed5c7 From git at git.haskell.org Mon Jun 20 14:37:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:27 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: delete TEST_HC_OPTS_NO_RECOMP (82f7f18) Message-ID: <20160620143727.097CC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/82f7f1820a175e7e07cbac0ab6d5a9ecddc8acc0/ghc >--------------------------------------------------------------- commit 82f7f1820a175e7e07cbac0ab6d5a9ecddc8acc0 Author: Thomas Miedema Date: Sat Jun 18 19:45:22 2016 +0200 Testsuite: delete TEST_HC_OPTS_NO_RECOMP The previous commits removed `-fforce-recomp` from TEST_HC_OPTS, so TEST_HC_OPTS_NO_RECOMP = TEST_HC_OPTS. >--------------------------------------------------------------- 82f7f1820a175e7e07cbac0ab6d5a9ecddc8acc0 testsuite/tests/determinism/determ002/Makefile | 6 +- testsuite/tests/determinism/determ003/Makefile | 6 +- testsuite/tests/determinism/determ007/Makefile | 6 +- testsuite/tests/determinism/determ008/Makefile | 6 +- testsuite/tests/determinism/determ009/Makefile | 6 +- testsuite/tests/determinism/determ010/Makefile | 6 +- testsuite/tests/determinism/determ011/Makefile | 6 +- testsuite/tests/determinism/determ012/Makefile | 6 +- testsuite/tests/determinism/determ013/Makefile | 6 +- testsuite/tests/determinism/determ014/Makefile | 6 +- testsuite/tests/determinism/determ015/Makefile | 6 +- testsuite/tests/determinism/determ016/Makefile | 6 +- testsuite/tests/determinism/determ017/Makefile | 6 +- testsuite/tests/determinism/determ018/Makefile | 6 +- testsuite/tests/determinism/determ019/Makefile | 6 +- .../determinism/simplCore/should_compile/Makefile | 6 +- testsuite/tests/determinism/typecheck/Makefile | 6 +- testsuite/tests/driver/Makefile | 157 ++++++++++----------- testsuite/tests/driver/T1372/Makefile | 6 +- testsuite/tests/driver/T1959/Makefile | 14 +- testsuite/tests/driver/T437/Makefile | 10 +- testsuite/tests/driver/T5147/Makefile | 8 +- testsuite/tests/driver/recomp001/Makefile | 8 +- testsuite/tests/driver/recomp002/Makefile | 8 +- testsuite/tests/driver/recomp003/Makefile | 10 +- testsuite/tests/driver/recomp004/Makefile | 12 +- testsuite/tests/driver/recomp005/Makefile | 8 +- testsuite/tests/driver/recomp006/Makefile | 8 +- testsuite/tests/driver/recomp008/Makefile | 8 +- testsuite/tests/driver/recomp009/Makefile | 8 +- testsuite/tests/driver/recomp010/Makefile | 8 +- testsuite/tests/driver/recomp011/Makefile | 12 +- testsuite/tests/driver/recomp012/Makefile | 14 +- testsuite/tests/driver/recomp013/Makefile | 8 +- testsuite/tests/driver/recomp015/Makefile | 12 +- testsuite/tests/driver/retc001/Makefile | 10 +- testsuite/tests/driver/retc002/Makefile | 8 +- testsuite/tests/driver/retc003/Makefile | 12 +- testsuite/tests/driver/sigof01/Makefile | 8 +- testsuite/tests/driver/sigof02/Makefile | 20 ++- testsuite/tests/driver/sigof03/Makefile | 8 +- testsuite/tests/driver/sigof04/Makefile | 6 +- 42 files changed, 180 insertions(+), 313 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 82f7f1820a175e7e07cbac0ab6d5a9ecddc8acc0 From git at git.haskell.org Mon Jun 20 14:37:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:29 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: tabs -> spaces [skip ci] (915e07c) Message-ID: <20160620143729.B40273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/915e07c33b143126e3c8de1d2ec22ccc709a9a24/ghc >--------------------------------------------------------------- commit 915e07c33b143126e3c8de1d2ec22ccc709a9a24 Author: Thomas Miedema Date: Sat Jun 18 22:44:19 2016 +0200 Testsuite: tabs -> spaces [skip ci] >--------------------------------------------------------------- 915e07c33b143126e3c8de1d2ec22ccc709a9a24 testsuite/tests/gadt/Nilsson.hs | 124 +++---- testsuite/tests/gadt/T3169.hs | 2 +- testsuite/tests/gadt/T7205.hs | 6 +- testsuite/tests/gadt/gadt2.hs | 2 +- testsuite/tests/gadt/gadt25.hs | 14 +- testsuite/tests/gadt/gadt5.hs | 10 +- testsuite/tests/gadt/gadt8.hs | 8 +- testsuite/tests/gadt/josef.hs | 6 +- testsuite/tests/gadt/nbe.hs | 74 ++-- testsuite/tests/gadt/records.hs | 9 +- testsuite/tests/gadt/red-black.hs | 2 +- testsuite/tests/gadt/scoped.hs | 2 +- testsuite/tests/gadt/set.hs | 2 +- testsuite/tests/gadt/termination.hs | 14 +- testsuite/tests/gadt/ubx-records.hs | 8 +- testsuite/tests/gadt/while.hs | 18 +- testsuite/tests/ghci.debugger/scripts/break012.hs | 2 +- testsuite/tests/ghci.debugger/scripts/break013.hs | 2 +- testsuite/tests/ghci.debugger/scripts/break014.hs | 2 +- testsuite/tests/ghci.debugger/scripts/print021.hs | 24 +- testsuite/tests/mdo/should_compile/mdo001.hs | 12 +- testsuite/tests/mdo/should_compile/mdo002.hs | 2 +- testsuite/tests/mdo/should_compile/mdo004.hs | 2 +- testsuite/tests/mdo/should_compile/mdo005.hs | 4 +- testsuite/tests/mdo/should_fail/mdofail005.hs | 2 +- testsuite/tests/mdo/should_run/mdorun001.hs | 32 +- testsuite/tests/module/Mod173_Aux.hs | 6 +- testsuite/tests/module/mod168.hs | 4 +- testsuite/tests/module/mod171.hs | 4 +- testsuite/tests/module/mod173.hs | 4 +- testsuite/tests/perf/should_run/MethSharing.hs | 2 +- testsuite/tests/perf/should_run/T3245.hs | 4 +- testsuite/tests/rebindable/DoParamM.hs | 60 ++-- testsuite/tests/rebindable/T4851.hs | 2 +- testsuite/tests/rebindable/rebindable1.hs | 74 ++-- testsuite/tests/rebindable/rebindable2.hs | 230 ++++++------- testsuite/tests/rebindable/rebindable3.hs | 232 ++++++------- testsuite/tests/rebindable/rebindable4.hs | 248 +++++++------- testsuite/tests/rebindable/rebindable5.hs | 380 ++++++++++----------- testsuite/tests/rebindable/rebindable6.hs | 350 +++++++++---------- testsuite/tests/rename/prog001/rn037.hs | 4 +- testsuite/tests/rename/prog002/rnfail037.hs | 4 +- testsuite/tests/rename/prog005/View.hs | 4 +- testsuite/tests/rename/should_compile/RnAux017.hs | 4 +- testsuite/tests/rename/should_compile/T3221.hs | 2 +- testsuite/tests/rename/should_compile/rn029.hs | 8 +- testsuite/tests/rename/should_compile/rn041.hs | 6 +- testsuite/tests/rename/should_compile/rn043.hs | 4 +- testsuite/tests/rename/should_compile/rn049.hs | 3 +- testsuite/tests/rename/should_compile/timing001.hs | 2 +- testsuite/tests/rename/should_fail/rnfail002.hs | 2 +- testsuite/tests/rename/should_fail/rnfail004.hs | 6 +- testsuite/tests/rename/should_fail/rnfail008.hs | 14 +- testsuite/tests/rename/should_fail/rnfail015.hs | 2 +- testsuite/tests/rename/should_fail/rnfail017.hs | 14 +- testsuite/tests/rename/should_fail/rnfail020.hs | 2 +- testsuite/tests/rename/should_fail/rnfail023.hs | 4 +- .../tests/safeHaskell/safeLanguage/SafeLang11_B.hs | 10 +- .../tests/safeHaskell/safeLanguage/SafeLang12_B.hs | 10 +- 59 files changed, 1044 insertions(+), 1046 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 915e07c33b143126e3c8de1d2ec22ccc709a9a24 From git at git.haskell.org Mon Jun 20 14:37:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:32 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: remove `-fforce-recomp` from default flags (#11980) (3b49f8f) Message-ID: <20160620143732.620F03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3b49f8faa1cbd3a04f1d6aa817a315a853e0cd79/ghc >--------------------------------------------------------------- commit 3b49f8faa1cbd3a04f1d6aa817a315a853e0cd79 Author: Thomas Miedema Date: Sat Jun 18 19:00:15 2016 +0200 Testsuite: remove `-fforce-recomp` from default flags (#11980) There is no need for this flag anymore, since each test runs in a newly created directory. Removing it cleans up testlib.py a bit. There is a small risk that this renders some tests useless. It's hard to know. Those tests should have specified -fforce-recomp` explicitly anyway, so I'm not going to worry about it. I've fixed the ones that failed without -fforce-recomp. Reviewed by: bgamari Differential Revision: https://phabricator.haskell.org/D2346 >--------------------------------------------------------------- 3b49f8faa1cbd3a04f1d6aa817a315a853e0cd79 testsuite/driver/testlib.py | 34 +++++++---------------- testsuite/mk/test.mk | 2 +- testsuite/tests/cabal/cabal08/Makefile | 2 +- testsuite/tests/driver/Makefile | 2 +- testsuite/tests/driver/all.T | 5 ++-- testsuite/tests/ghci/scripts/ghci024.stdout | 1 - testsuite/tests/module/base01/Makefile | 4 +-- testsuite/tests/typecheck/should_compile/Makefile | 4 +-- 8 files changed, 19 insertions(+), 35 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3b49f8faa1cbd3a04f1d6aa817a315a853e0cd79 From git at git.haskell.org Mon Jun 20 14:37:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:35 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: delete dead code + cleanup (ebaf26b) Message-ID: <20160620143735.11B803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ebaf26b75c6ab3185b6e098e9caf575c03085f82/ghc >--------------------------------------------------------------- commit ebaf26b75c6ab3185b6e098e9caf575c03085f82 Author: Thomas Miedema Date: Sat Jun 18 18:58:02 2016 +0200 Testsuite: delete dead code + cleanup * Set config settings directly in mk/test.mk, instead of indirectly in config/ghc * passing --hpcdir for WAY=hpc is unnecessary >--------------------------------------------------------------- ebaf26b75c6ab3185b6e098e9caf575c03085f82 libraries/base/tests/IO/T12010/test.T | 2 +- testsuite/config/ghc | 64 ++++++----------------------- testsuite/driver/testglobals.py | 7 ---- testsuite/driver/testlib.py | 29 ++++--------- testsuite/driver/testutil.py | 18 -------- testsuite/mk/test.mk | 38 ++++++++--------- testsuite/tests/ffi/should_run/all.T | 15 +++---- testsuite/tests/ghci/scripts/ghci024.stdout | 1 + testsuite/tests/hpc/all.T | 2 +- testsuite/tests/numeric/should_run/all.T | 16 +++----- testsuite/tests/plugins/all.T | 6 +-- testsuite/tests/th/all.T | 4 +- 12 files changed, 55 insertions(+), 147 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 ebaf26b75c6ab3185b6e098e9caf575c03085f82 From git at git.haskell.org Mon Jun 20 14:37:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:37 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: tabs -> spaces [skip ci] (7e7094f) Message-ID: <20160620143737.BC7853A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7e7094f166b6e475a49e20b98cbca851334aedaf/ghc >--------------------------------------------------------------- commit 7e7094f166b6e475a49e20b98cbca851334aedaf Author: Thomas Miedema Date: Sat Jun 18 22:44:19 2016 +0200 Testsuite: tabs -> spaces [skip ci] >--------------------------------------------------------------- 7e7094f166b6e475a49e20b98cbca851334aedaf testsuite/tests/boxy/PList1.hs | 4 +- testsuite/tests/boxy/PList2.hs | 4 +- testsuite/tests/boxy/boxy.hs | 10 +- testsuite/tests/programs/Queens/queens.hs | 10 +- testsuite/tests/programs/andre_monad/Main.hs | 68 ++--- .../tests/programs/barton-mangler-bug/Basic.hs | 16 +- .../tests/programs/fast2haskell/Fast2haskell.hs | 8 +- testsuite/tests/programs/galois_raytrace/CSG.hs | 8 +- .../tests/programs/galois_raytrace/Construct.hs | 122 ++++---- testsuite/tests/programs/galois_raytrace/Data.hs | 144 ++++----- testsuite/tests/programs/galois_raytrace/Eval.hs | 26 +- .../tests/programs/galois_raytrace/Geometry.hs | 4 +- .../tests/programs/galois_raytrace/Illumination.hs | 16 +- .../programs/galois_raytrace/Intersections.hs | 274 ++++++++--------- .../tests/programs/galois_raytrace/Interval.hs | 34 +-- testsuite/tests/programs/galois_raytrace/Pixmap.hs | 40 +-- .../tests/programs/galois_raytrace/Surface.hs | 44 +-- .../tests/programs/joao-circular/Data_Lazy.hs | 336 ++++++++++----------- testsuite/tests/programs/jtod_circint/Signal.hs | 6 +- testsuite/tests/programs/lennart_range/Main.hs | 4 +- testsuite/tests/programs/lex/Main.hs | 10 +- testsuite/tests/programs/life_space_leak/Main.hs | 6 +- .../tests/programs/maessen-hashtab/Data/HashTab.hs | 60 ++-- testsuite/tests/programs/record_upd/Main.hs | 24 +- testsuite/tests/programs/rittri/Main.hs | 34 +-- testsuite/tests/programs/strict_anns/Main.hs | 4 +- .../tests/programs/thurston-modular-arith/Main.hs | 8 +- .../programs/thurston-modular-arith/TypeVal.hs | 36 +-- 28 files changed, 680 insertions(+), 680 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 7e7094f166b6e475a49e20b98cbca851334aedaf From git at git.haskell.org Mon Jun 20 14:37:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:40 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: tabs -> spaces [skip ci] (46ff80f) Message-ID: <20160620143740.71C5E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/46ff80f26d1892e1b50e3f10c5d3fded33da6e81/ghc >--------------------------------------------------------------- commit 46ff80f26d1892e1b50e3f10c5d3fded33da6e81 Author: Thomas Miedema Date: Sat Jun 18 22:44:19 2016 +0200 Testsuite: tabs -> spaces [skip ci] >--------------------------------------------------------------- 46ff80f26d1892e1b50e3f10c5d3fded33da6e81 .../tests/arrows/should_compile/arrowcase1.hs | 12 +- testsuite/tests/arrows/should_compile/arrowdo1.hs | 6 +- testsuite/tests/arrows/should_compile/arrowdo2.hs | 4 +- testsuite/tests/arrows/should_compile/arrowdo3.hs | 282 ++++++++++----------- testsuite/tests/arrows/should_compile/arrowrec1.hs | 8 +- testsuite/tests/arrows/should_run/arrowrun001.hs | 30 +-- testsuite/tests/arrows/should_run/arrowrun002.hs | 134 +++++----- testsuite/tests/arrows/should_run/arrowrun003.hs | 82 +++--- testsuite/tests/arrows/should_run/arrowrun004.hs | 108 ++++---- testsuite/tests/cpranal/should_compile/Cpr001.hs | 2 +- .../tests/cpranal/should_compile/Cpr001_imp.hs | 40 +-- .../tests/eyeball/dmd-on-polymorphic-floatouts.hs | 2 +- testsuite/tests/eyeball/inline1.hs | 2 +- testsuite/tests/eyeball/inline2.hs | 4 +- testsuite/tests/eyeball/spec-constr1.hs | 6 +- testsuite/tests/ffi/should_compile/cc001.hs | 6 +- testsuite/tests/ffi/should_compile/cc004.hs | 26 +- testsuite/tests/ffi/should_compile/cc005.hs | 56 ++-- testsuite/tests/ffi/should_fail/ccfail002.hs | 2 +- testsuite/tests/ffi/should_run/fed001.hs | 4 +- testsuite/tests/ffi/should_run/ffi001.hs | 6 +- testsuite/tests/ffi/should_run/ffi004.hs | 18 +- testsuite/tests/ffi/should_run/ffi013.hs | 4 +- testsuite/tests/numeric/should_run/arith001.hs | 16 +- testsuite/tests/numeric/should_run/arith002.hs | 44 ++-- testsuite/tests/numeric/should_run/arith003.hs | 10 +- testsuite/tests/numeric/should_run/arith004.hs | 132 +++++----- testsuite/tests/numeric/should_run/arith005.hs | 16 +- testsuite/tests/numeric/should_run/arith007.hs | 16 +- testsuite/tests/numeric/should_run/arith010.hs | 18 +- testsuite/tests/numeric/should_run/arith011.hs | 14 +- testsuite/tests/numeric/should_run/arith012.hs | 4 +- testsuite/tests/numeric/should_run/arith016.hs | 6 +- testsuite/tests/numeric/should_run/arith017.hs | 4 +- testsuite/tests/numeric/should_run/numrun009.hs | 22 +- testsuite/tests/parser/should_compile/read026.hs | 2 +- testsuite/tests/parser/should_compile/read029.hs | 8 +- testsuite/tests/parser/should_compile/read040.hs | 2 +- testsuite/tests/parser/should_compile/read044.hs | 6 +- testsuite/tests/parser/should_fail/readFail001.hs | 52 ++-- testsuite/tests/parser/should_fail/readFail003.hs | 10 +- testsuite/tests/parser/should_fail/readFail009.hs | 2 +- testsuite/tests/parser/should_fail/readFail011.hs | 4 +- testsuite/tests/parser/should_fail/readFail012.hs | 6 +- testsuite/tests/parser/should_fail/readFail023.hs | 4 +- testsuite/tests/parser/unicode/T1103.hs | 6 +- testsuite/tests/parser/unicode/utf8_024.hs | 274 ++++++++++---------- .../tests/profiling/should_run/heapprof001.hs | 14 +- testsuite/tests/simplCore/should_compile/T3118.hs | 18 +- .../tests/simplCore/should_compile/simpl003.hs | 4 +- .../tests/simplCore/should_compile/simpl004.hs | 6 +- .../tests/simplCore/should_compile/simpl005.hs | 8 +- .../tests/simplCore/should_compile/simpl007.hs | 12 +- .../tests/simplCore/should_compile/simpl009.hs | 2 +- .../tests/simplCore/should_compile/simpl010.hs | 0 .../tests/simplCore/should_compile/simpl014.hs | 4 +- .../tests/simplCore/should_compile/simpl017.hs | 6 +- .../tests/simplCore/should_compile/simpl018.hs | 2 +- testsuite/tests/simplCore/should_run/T3959.hs | 2 +- .../tests/simplCore/should_run/simplrun002.hs | 2 +- .../tests/simplCore/should_run/simplrun003.hs | 14 +- .../tests/simplCore/should_run/simplrun005.hs | 6 +- .../tests/simplCore/should_run/simplrun008.hs | 4 +- .../tests/simplCore/should_run/simplrun009.hs | 64 ++--- 64 files changed, 845 insertions(+), 845 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 46ff80f26d1892e1b50e3f10c5d3fded33da6e81 From git at git.haskell.org Mon Jun 20 14:37:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 20 Jun 2016 14:37:43 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: mark tests expect broken (1d938aa) Message-ID: <20160620143743.51A1F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1d938aa3373f464f46dd3806a21aa85dda764ec6/ghc >--------------------------------------------------------------- commit 1d938aa3373f464f46dd3806a21aa85dda764ec6 Author: Thomas Miedema Date: Sun Jun 19 13:03:47 2016 +0200 Testsuite: mark tests expect broken * CgStaticPointers, GcStaticPointers, ListStaticPointers, TcStaticPointers01, TcStaticPointers02: #12207 * T11535: #12210 * ffi017/ffi021: #12209 * T11108: #11108 * T9646: #9646 >--------------------------------------------------------------- 1d938aa3373f464f46dd3806a21aa85dda764ec6 testsuite/tests/codeGen/should_run/all.T | 4 +++- testsuite/tests/deriving/should_run/all.T | 3 ++- testsuite/tests/driver/all.T | 11 +++++++---- testsuite/tests/ffi/should_run/all.T | 6 ++++-- testsuite/tests/rts/all.T | 10 +++++++--- testsuite/tests/simplCore/T9646/test.T | 1 + testsuite/tests/typecheck/should_compile/all.T | 4 ++-- 7 files changed, 26 insertions(+), 13 deletions(-) diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 42ec7d3..b6249ed 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -117,7 +117,9 @@ test('T8103', only_ways(['normal']), compile_and_run, ['']) test('T7953', reqlib('random'), compile_and_run, ['']) test('T8256', normal, compile_and_run, ['-dcore-lint -O1']) test('T6084',normal, compile_and_run, ['-O2']) -test('CgStaticPointers', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], +test('CgStaticPointers', + [when(doing_ghci(), extra_hc_opts('-fobject-code')), + expect_broken_for(12207, opt_ways)], compile_and_run, ['']) test('StaticArraySize', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], compile_and_run, ['-O2']) diff --git a/testsuite/tests/deriving/should_run/all.T b/testsuite/tests/deriving/should_run/all.T index f15843b..29e8bbd 100644 --- a/testsuite/tests/deriving/should_run/all.T +++ b/testsuite/tests/deriving/should_run/all.T @@ -40,4 +40,5 @@ test('T9576', exit_code(1), compile_and_run, ['']) test('T9830', extra_clean(['T9830a.hi', 'T9830a.o']), multimod_compile_and_run, ['T9830','-v0']) test('T10104', normal, compile_and_run, ['']) test('T10447', normal, compile_and_run, ['']) -test('T11535', normal, compile_and_run, ['']) +test('T11535', when(opsys('mingw32'), expect_broken_for(12210, ['ghci'])), + compile_and_run, ['']) diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 36ba99b..f1522b9 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -372,10 +372,13 @@ test('spacesInArgs', compile_and_run, ['']) -test( 'T4114a', normal, compile_and_run, ['-cpp']) -test( 'T4114b', normal, compile_and_run, ['-no-keep-hi-files']) -test( 'T4114c', normal, compile_and_run, ['-no-keep-o-files']) -test( 'T4114d', normal, compile_and_run, ['-hisuf .myhi -osuf .myo -no-keep-o-files']) +fobject_code = when(doing_ghci(), extra_hc_opts('-fobject-code')) + +test( 'T4114a', fobject_code, compile_and_run, ['-cpp']) +test( 'T4114b', fobject_code, compile_and_run, ['-no-keep-hi-files']) +test( 'T4114c', fobject_code, compile_and_run, ['-no-keep-o-files']) +test( 'T4114d', fobject_code, compile_and_run, + ['-hisuf .myhi -osuf .myo -no-keep-o-files']) test('T5584', extra_clean(['T5584_in/A.hi-boot', 'T5584_out/T5584/A.o-boot']), diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T index efb6969..bf9fefd 100644 --- a/testsuite/tests/ffi/should_run/all.T +++ b/testsuite/tests/ffi/should_run/all.T @@ -87,7 +87,8 @@ test('ffi015', [ omit_ways(['ghci']), extra_clean(['ffi015_cbits.o']) ], # GHCi can't handle foreign import "&" test('ffi016', omit_ways(['ghci']), compile_and_run, ['']) -test('ffi017', normal, compile_and_run, ['']) +test('ffi017', when(opsys('mingw32'), expect_broken_for(12209, ['ghci'])), + compile_and_run, ['']) test('ffi018', [ omit_ways(['ghci']), extra_clean(['ffi018_c.o']) ], compile_and_run, ['ffi018_c.c']) @@ -142,7 +143,8 @@ test('ffi020', [ omit_ways(prof_ways), exit_code(1) ], compile_and_run, ['']) -test('ffi021', normal, compile_and_run, ['']) +test('ffi021', when(opsys('mingw32'), expect_broken_for(12209, ['ghci'])), + compile_and_run, ['']) test('ffi022', normal, compile_and_run, ['']) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index f15e8a0..15f9806 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -266,7 +266,7 @@ test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-D test('T10017', [ when(opsys('mingw32'), skip) , only_ways(threaded_ways), extra_run_opts('+RTS -N2 -RTS') ], compile_and_run, ['']) -test('T11108', normal, compile_and_run, ['']) +test('T11108', expect_broken_for(11108, ['ghci', 'hpc']), compile_and_run, ['']) test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) # this needs runtime infrastructure to do in ghci: @@ -275,9 +275,13 @@ test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) ], compile_and_run, ['-rdynamic -package ghc']) -test('GcStaticPointers', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], +test('GcStaticPointers', + [when(doing_ghci(), extra_hc_opts('-fobject-code')), + expect_broken_for(12207, opt_ways)], compile_and_run, ['']) -test('ListStaticPointers', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], +test('ListStaticPointers', + [when(doing_ghci(), extra_hc_opts('-fobject-code')), + expect_broken_for(12207, opt_ways)], compile_and_run, ['']) # 251 = RTS exit code for "out of memory" diff --git a/testsuite/tests/simplCore/T9646/test.T b/testsuite/tests/simplCore/T9646/test.T index d31f8fe..b2292c1 100644 --- a/testsuite/tests/simplCore/T9646/test.T +++ b/testsuite/tests/simplCore/T9646/test.T @@ -1,6 +1,7 @@ test('T9646', [when(fast(), skip), + expect_broken_for(9646, ['ghci']), extra_clean(['Main.hi', 'Main.o', 'Main.dump-simpl', 'Natural.dump-simpl', 'StrictPrim.dump-simpl', 'Type.dump-simpl'])], diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 3b6e186..0f222aa 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -421,8 +421,8 @@ test('T8474', normal, compile, ['']) test('T8563', normal, compile, ['']) test('T8565', normal, compile, ['']) test('T8644', normal, compile, ['']) -test('TcStaticPointers01', [], compile, ['']) -test('TcStaticPointers02', [], compile, ['']) +test('TcStaticPointers01', expect_broken_for(12207, ['hpc']), compile, ['']) +test('TcStaticPointers02', expect_broken_for(12207, ['hpc']), compile, ['']) test('T8762', normal, compile, ['']) test('MutRec', normal, compile, ['']) test('T8856', normal, compile, ['']) From git at git.haskell.org Tue Jun 21 10:15:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Jun 2016 10:15:45 +0000 (UTC) Subject: [commit: ghc] master: Expand and clarify the docs for ApplicativeDo (#11835) (ee3bde7) Message-ID: <20160621101545.5CEFD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ee3bde7999877f108375651869f1dc5b362da9fe/ghc >--------------------------------------------------------------- commit ee3bde7999877f108375651869f1dc5b362da9fe Author: Simon Marlow Date: Mon Jun 20 15:30:34 2016 +0100 Expand and clarify the docs for ApplicativeDo (#11835) >--------------------------------------------------------------- ee3bde7999877f108375651869f1dc5b362da9fe docs/users_guide/glasgow_exts.rst | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index d5e5f7c..82b7d7c 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -858,9 +858,21 @@ then the expression will only require ``Applicative``. Otherwise, the expression will require ``Monad``. The block may return a pure expression ``E`` depending upon the results ``p1...pn`` with either ``return`` or ``pure``. -Note: the final statement really must be of the form ``return E`` or -``pure E``, otherwise you get a ``Monad`` constraint. Using ``$`` as -in ``return $ E`` or ``pure $ E`` is also acceptable. +Note: the final statement must match one of these patterns exactly: + +- ``return E`` +- ``return $ E`` +- ``pure E`` +- ``pure $ E`` + +otherwise GHC cannot recognise it as a ``return`` statement, and the +transformation to use ``<$>`` that we saw above does not apply. In +particular, slight variations such as ``return . Just $ x`` or ``let x += e in return x`` would not be recognised. + +If the final statement is not of one of these forms, GHC falls back to +standard ``do`` desugaring, and the expression will require a +``Monad`` constraint. When the statements of a ``do`` expression have dependencies between them, and ``ApplicativeDo`` cannot infer an ``Applicative`` type, it From git at git.haskell.org Tue Jun 21 10:31:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Jun 2016 10:31:22 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (7301404) Message-ID: <20160621103122.E132E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7301404dfd317684418890799a587c7c684ddb63/ghc >--------------------------------------------------------------- commit 7301404dfd317684418890799a587c7c684ddb63 Author: Gabor Greif Date: Tue Jun 21 12:31:55 2016 +0200 Typos in comments >--------------------------------------------------------------- 7301404dfd317684418890799a587c7c684ddb63 compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcPat.hs | 2 +- compiler/typecheck/TcSigs.hs | 2 +- testsuite/tests/typecheck/should_compile/ExPat.hs | 2 +- testsuite/tests/typecheck/should_compile/ExPatFail.hs | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 20abdc3..d23b952 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -1468,7 +1468,7 @@ and suppose t :: T. Which of these pattern bindings are ok? E3. let { MkT (toInteger -> r) _ = t } in -Well (E1) is clearly wrong becuase the existential 'a' escapes. +Well (E1) is clearly wrong because the existential 'a' escapes. What type could 'p' possibly have? But (E2) is fine, despite the existential pattern, because diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index 7a210f2..a46136e 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -330,7 +330,7 @@ tc_pat penv lpat@(LazyPat pat) pat_ty thing_inside -- see Note [Hopping the LIE in lazy patterns] -- Check there are no unlifted types under the lazy pattern - -- This is a very unsatisfactory test. We have to zonk becuase + -- This is a very unsatisfactory test. We have to zonk because -- the binder-tys are typically just a unification variable, -- which should by now have been unified... but it might be -- deferred for the constraint solver...Ugh! Also diff --git a/compiler/typecheck/TcSigs.hs b/compiler/typecheck/TcSigs.hs index 5cb2366..7d744bf 100644 --- a/compiler/typecheck/TcSigs.hs +++ b/compiler/typecheck/TcSigs.hs @@ -90,7 +90,7 @@ especially on value bindings. Here's an overview. The instantiation does the obvious thing for complete signatures, but for /partial/ signatures it starts from the HsSyn, so it has to kind-check it etc: tcHsPartialSigType. It's convenient - to do this at the same time as instantiation, becuase we can + to do this at the same time as instantiation, because we can make the wildcards into unification variables right away, raather than somehow quantifying over them. And the "TcLevel" of those unification variables is correct because we are in tcMonoBinds. diff --git a/testsuite/tests/typecheck/should_compile/ExPat.hs b/testsuite/tests/typecheck/should_compile/ExPat.hs index a0b4b0b..2ac3cb8 100644 --- a/testsuite/tests/typecheck/should_compile/ExPat.hs +++ b/testsuite/tests/typecheck/should_compile/ExPat.hs @@ -7,7 +7,7 @@ data T where -- c.f. T11700 --- Succeeds becuase y::Int +-- Succeeds because y::Int f x = let MkT _ y = x in y diff --git a/testsuite/tests/typecheck/should_compile/ExPatFail.hs b/testsuite/tests/typecheck/should_compile/ExPatFail.hs index 1a25adf..e6c8930 100644 --- a/testsuite/tests/typecheck/should_compile/ExPatFail.hs +++ b/testsuite/tests/typecheck/should_compile/ExPatFail.hs @@ -5,7 +5,7 @@ module ExPatFail where data T where MkT :: Integral a => a -> Int -> T --- Fails becuase y is bound to an existential type +-- Fails because y is bound to an existential type -- Mind you, the error message is pretty terrible -- c.f. T11700 From git at git.haskell.org Tue Jun 21 13:49:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Jun 2016 13:49:09 +0000 (UTC) Subject: [commit: ghc] master: Don't quantify over Refl in a RULE (d09e982) Message-ID: <20160621134909.5000C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d09e982c534b20908064f36d701a1a3a6a2eb55a/ghc >--------------------------------------------------------------- commit d09e982c534b20908064f36d701a1a3a6a2eb55a Author: Simon Peyton Jones Date: Mon Jun 20 15:48:09 2016 +0100 Don't quantify over Refl in a RULE This fixes Trac #12212. It's quite hard to provoke, but I've added a standalone test case that does so. The issue is explained in Note [Evidence foralls] in Specialise. >--------------------------------------------------------------- d09e982c534b20908064f36d701a1a3a6a2eb55a compiler/specialise/Specialise.hs | 35 ++++++++++++++++++---- testsuite/tests/simplCore/should_compile/T12212.hs | 17 +++++++++++ .../tests/simplCore/should_compile/T7785.stderr | 2 +- testsuite/tests/simplCore/should_compile/all.T | 1 + 4 files changed, 48 insertions(+), 7 deletions(-) diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index d587eeb..abd15c8 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -12,8 +12,8 @@ module Specialise ( specProgram, specUnfolding ) where import Id import TcType hiding( substTy ) import Type hiding( substTy, extendTvSubstList ) -import Coercion( Coercion ) import Module( Module, HasModule(..) ) +import Coercion( Coercion ) import CoreMonad import qualified CoreSubst import CoreUnfold @@ -22,7 +22,7 @@ import VarEnv import CoreSyn import Rules import CoreUtils ( exprIsTrivial, applyTypeToArgs, mkCast ) -import CoreFVs ( exprFreeVars, exprsFreeVars, idFreeVars ) +import CoreFVs ( exprFreeVars, exprsFreeVars, idFreeVars, exprsFreeIdsList ) import UniqSupply import Name import MkId ( voidArgId, voidPrimId ) @@ -1227,6 +1227,9 @@ specCalls mb_mod env rules_for_me calls_for_me fn rhs -- Construct the new binding -- f1 = SUBST[a->t1,c->t3, d1->d1', d2->d2'] (/\ b -> rhs) + -- PLUS the rule + -- RULE "SPEC f" forall b d1' d2'. f b d1' d2' = f1 b + -- In the rule, d1' and d2' are just wildcards, not used in the RHS -- PLUS the usage-details -- { d1' = dx1; d2' = dx2 } -- where d1', d2' are cloned versions of d1,d2, with the type substitution @@ -1249,9 +1252,10 @@ specCalls mb_mod env rules_for_me calls_for_me fn rhs ; let (rhs_env2, dx_binds, spec_dict_args) = bindAuxiliaryDicts rhs_env rhs_dict_ids call_ds inst_dict_ids ty_args = mk_ty_args call_ts poly_tyvars - rule_args = ty_args ++ map varToCoreExpr inst_dict_ids - -- varToCoreExpr does the right thing for CoVars - rule_bndrs = poly_tyvars ++ inst_dict_ids + ev_args = map varToCoreExpr inst_dict_ids -- ev_args, ev_bndrs: + ev_bndrs = exprsFreeIdsList ev_args -- See Note [Evidence foralls] + rule_args = ty_args ++ ev_args + rule_bndrs = poly_tyvars ++ ev_bndrs ; dflags <- getDynFlags ; if already_covered dflags rule_args then @@ -1335,7 +1339,26 @@ specCalls mb_mod env rules_for_me calls_for_me fn rhs ; return (Just ((spec_f_w_arity, spec_rhs), final_uds, spec_env_rule)) } } -{- +{- Note [Evidence foralls] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose (Trac #12212) that we are specialising + f :: forall a b. (Num a, F a ~ F b) => blah +with a=b=Int. Then the RULE will be something like + RULE forall (d:Num Int) (g :: F Int ~ F Int). + f Int Int d g = f_spec +But both varToCoreExpr (when constructing the LHS args), and the +simplifier (when simplifying the LHS args), will transform to + RULE forall (d:Num Int) (g :: F Int ~ F Int). + f Int Int d = f_spec +by replacing g with Refl. So now 'g' is unbound, which results in a later +crash. So we use Refl right off the bat, and do not forall-quantify 'g': + * varToCoreExpr generates a Refl + * exprsFreeIdsList returns the Ids bound by the args, + which won't include g + +You might wonder if this will match as often, but the simplifer replaces +complicated Refl coercions with Refl pretty aggressively. + Note [Orphans and auto-generated rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we specialise an INLINEABLE function, or when we have diff --git a/testsuite/tests/simplCore/should_compile/T12212.hs b/testsuite/tests/simplCore/should_compile/T12212.hs new file mode 100644 index 0000000..ed284c3 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T12212.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE TypeFamilies #-} + +module T12212 where + +type family F a +type instance F Int = Int + +foo :: a -> F a +{-# NOINLINE foo #-} +foo = undefined + +-- Inferred type +-- forall a b. (Num a, F a ~# F b) => a -> b -> [F a] +f x y = [ foo x, foo y ] ++ f (x-1) y + +-- Specialised call to f @ Int @ Int dNumInt +g = f (3::Int) (4::Int) diff --git a/testsuite/tests/simplCore/should_compile/T7785.stderr b/testsuite/tests/simplCore/should_compile/T7785.stderr index db80b99..c71a077 100644 --- a/testsuite/tests/simplCore/should_compile/T7785.stderr +++ b/testsuite/tests/simplCore/should_compile/T7785.stderr @@ -1,7 +1,7 @@ ==================== Tidy Core rules ==================== "SPEC shared @ []" [ALWAYS] - forall ($dMyFunctor :: MyFunctor []) (irred :: Domain [] Int). + forall (irred :: Domain [] Int) ($dMyFunctor :: MyFunctor []). shared @ [] $dMyFunctor irred = bar_$sshared diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index ddac42c..ecf990c 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -240,3 +240,4 @@ test('T3990', test('T12076', extra_clean(['T12076a.hi', 'T12076a.o']), multimod_compile, ['T12076', '-v0']) test('T12076lit', normal, compile, ['-O']) test('T12076sat', normal, compile, ['-O']) +test('T12212', normal, compile, ['-O']) From git at git.haskell.org Tue Jun 21 13:49:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Jun 2016 13:49:12 +0000 (UTC) Subject: [commit: ghc] master: Delete commented-out code (97a50f8) Message-ID: <20160621134912.2E4433A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/97a50f828e05ae285dfd8ffc890563fa0dd80fe4/ghc >--------------------------------------------------------------- commit 97a50f828e05ae285dfd8ffc890563fa0dd80fe4 Author: Simon Peyton Jones Date: Mon Jun 20 15:50:53 2016 +0100 Delete commented-out code Richard: in a previous commit I combined the two case for decideQuantification This commit just deletes the old code. I'm afraid it'll leave you with a merge conflict though, with your stuff on generalisation. >--------------------------------------------------------------- 97a50f828e05ae285dfd8ffc890563fa0dd80fe4 compiler/typecheck/TcSimplify.hs | 30 ------------------------------ 1 file changed, 30 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 5a727a8..4b69749 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -771,36 +771,6 @@ decideQuantification , [PredType] ) -- and this context (fully zonked) -- See Note [Deciding quantification] decideQuantification apply_mr name_taus psig_theta candidates -{- - | apply_mr -- Apply the Monomorphism restriction - = do { gbl_tvs <- tcGetGlobalTyCoVars - ; zonked_taus <- mapM TcM.zonkTcType (psig_theta ++ taus) - -- psig_theta: see Note [Quantification and partial signatures] - ; let zonked_dvs = splitDepVarsOfTypes zonked_taus - zonked_tkvs = tcDepVarSet zonked_dvs - constrained_tvs = tyCoVarsOfTypes constraints `unionVarSet` - filterVarSet isCoVar zonked_tkvs - mono_tvs = gbl_tvs `unionVarSet` constrained_tvs - - ; qtvs <- quantifyZonkedTyVars mono_tvs zonked_dvs - - -- Warn about the monomorphism restriction - ; warn_mono <- woptM Opt_WarnMonomorphism - ; let mr_bites = constrained_tvs `intersectsVarSet` zonked_tkvs - ; warnTc (Reason Opt_WarnMonomorphism) (warn_mono && mr_bites) $ - hang (text "The Monomorphism Restriction applies to the binding" - <> plural bndrs <+> text "for" <+> pp_bndrs) - 2 (text "Consider giving a type signature for" - <+> if isSingleton bndrs then pp_bndrs - else text "these binders") - - -- All done - ; traceTc "decideQuantification 1" (vcat [ppr constraints, ppr gbl_tvs, ppr mono_tvs - , ppr qtvs, ppr mr_bites]) - ; return (qtvs, []) } - - | otherwise --} = do { gbl_tvs <- tcGetGlobalTyCoVars ; zonked_taus <- mapM TcM.zonkTcType (psig_theta ++ taus) -- psig_theta: see Note [Quantification and partial signatures] From git at git.haskell.org Tue Jun 21 22:51:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 21 Jun 2016 22:51:21 +0000 (UTC) Subject: [commit: ghc] master: Make checkFamInstConsistency less expensive (1230629) Message-ID: <20160621225121.A77EE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/123062946dfdbcfc24abd468e24e358118b8e2eb/ghc >--------------------------------------------------------------- commit 123062946dfdbcfc24abd468e24e358118b8e2eb Author: Bartosz Nitka Date: Tue Jun 21 15:54:00 2016 -0700 Make checkFamInstConsistency less expensive Doing canonicalization on every comparison turned out to be very expensive. Caching the canonicalization through the smart `modulePair` constructor gives `8%` reduction in allocations on `haddock.compiler` and `8.5%` reduction in allocations on `haddock.Cabal`. Possibly other things as well, but it's really visible in Haddock. Test Plan: ./validate Reviewers: jstolarek, simonpj, austin, simonmar, bgamari Reviewed By: simonpj, simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2350 GHC Trac Issues: #12191 >--------------------------------------------------------------- 123062946dfdbcfc24abd468e24e358118b8e2eb compiler/typecheck/FamInst.hs | 32 +++++++++++++++----------------- testsuite/tests/perf/haddock/all.T | 6 ++++-- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index a18bd9c..403639a 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -39,8 +39,8 @@ import Pair import Panic import VarSet import Control.Monad -import Data.Map (Map) -import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set #include "HsVersions.h" @@ -120,28 +120,25 @@ certain that the modules in our `HscTypes.dep_finsts' are consistent.) -- whose family instances need to be checked for consistency. -- data ModulePair = ModulePair Module Module + -- Invariant: first Module < second Module + -- use the smart constructor + deriving (Ord, Eq) --- canonical order of the components of a module pair --- -canon :: ModulePair -> (Module, Module) -canon (ModulePair m1 m2) | m1 < m2 = (m1, m2) - | otherwise = (m2, m1) - -instance Eq ModulePair where - mp1 == mp2 = canon mp1 == canon mp2 - -instance Ord ModulePair where - mp1 `compare` mp2 = canon mp1 `compare` canon mp2 +-- | Smart constructor that establishes the invariant +modulePair :: Module -> Module -> ModulePair +modulePair a b + | a < b = ModulePair a b + | otherwise = ModulePair b a instance Outputable ModulePair where ppr (ModulePair m1 m2) = angleBrackets (ppr m1 <> comma <+> ppr m2) -- Sets of module pairs -- -type ModulePairSet = Map ModulePair () +type ModulePairSet = Set ModulePair listToSet :: [ModulePair] -> ModulePairSet -listToSet l = Map.fromList (zip l (repeat ())) +listToSet l = Set.fromList l checkFamInstConsistency :: [Module] -> [Module] -> TcM () -- See Note [Checking family instance consistency] @@ -167,7 +164,8 @@ checkFamInstConsistency famInstMods directlyImpMods -- instances of okPairs are consistent ; criticalPairs = listToSet $ allPairs famInstMods -- all pairs that we need to consider - ; toCheckPairs = Map.keys $ criticalPairs `Map.difference` okPairs + ; toCheckPairs = + Set.elems $ criticalPairs `Set.difference` okPairs -- the difference gives us the pairs we need to check now } @@ -175,7 +173,7 @@ checkFamInstConsistency famInstMods directlyImpMods } where allPairs [] = [] - allPairs (m:ms) = map (ModulePair m) ms ++ allPairs ms + allPairs (m:ms) = map (modulePair m) ms ++ allPairs ms check hpt_fam_insts (ModulePair m1 m2) = do { env1 <- getFamInsts hpt_fam_insts m1 diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 3f4926a..b9a3ab3 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -52,7 +52,7 @@ test('haddock.base', test('haddock.Cabal', [unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 10997887320, 5) + [(wordsize(64), 10070330520, 5) # 2012-08-14: 3255435248 (amd64/Linux) # 2012-08-29: 3324606664 (amd64/Linux, new codegen) # 2012-10-08: 3373401360 (amd64/Linux) @@ -82,6 +82,7 @@ test('haddock.Cabal', # 2016-04-07: 10963514352 (amd64/Linux) - Revert to what phabricator claims # 2016-05-22: 11805238152 (amd64/Linux) - Make Generic1 poly-kinded # 2016-06-05: 10997887320 (amd64/Linux) - Refactor derived Generic instances to reduce allocations + # 2016-06-21: 10070330520 (amd64/Linux) - D2350: Make checkFamInstConsistency less expensive ,(platform('i386-unknown-mingw32'), 3293415576, 5) # 2012-10-30: 1733638168 (x86/Windows) @@ -103,7 +104,7 @@ test('haddock.Cabal', test('haddock.compiler', [unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 58017214568, 10) + [(wordsize(64), 55314944264, 10) # 2012P-08-14: 26070600504 (amd64/Linux) # 2012-08-29: 26353100288 (amd64/Linux, new CG) # 2012-09-18: 26882813032 (amd64/Linux) @@ -117,6 +118,7 @@ test('haddock.compiler', # 2015-12-03: 44721228752 (amd64/Linux) slow creep upwards # 2015-12-15: 49395782136 (amd64/Linux) more creep, following kind-equalities # 2015-12-17: 58017214568 (amd64/Linux) update Haddock to master + # 2016-06-21: 55314944264 (amd64/Linux) D2350: Make checkFamInstConsistency less expensive ,(platform('i386-unknown-mingw32'), 902576468, 10) # 2012-10-30: 13773051312 (x86/Windows) From git at git.haskell.org Wed Jun 22 08:50:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 08:50:35 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T7860' created Message-ID: <20160622085035.74CE73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T7860 Referencing: 81d889729c34dbf37c60290116f2f00af1dacd55 From git at git.haskell.org Wed Jun 22 08:50:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 08:50:38 +0000 (UTC) Subject: [commit: ghc] wip/T7860: Implement {set, clear, complement}BitBigNat primitives (81d8897) Message-ID: <20160622085038.260A93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T7860 Link : http://ghc.haskell.org/trac/ghc/changeset/81d889729c34dbf37c60290116f2f00af1dacd55/ghc >--------------------------------------------------------------- commit 81d889729c34dbf37c60290116f2f00af1dacd55 Author: Herbert Valerio Riedel Date: Tue Jun 21 23:49:32 2016 +0200 Implement {set,clear,complement}BitBigNat primitives and hook up to `Natural`'s `Bits` instance This doesn't yet benefit `Integer`, as we still need "negative" `BigNat` variants for that. >--------------------------------------------------------------- 81d889729c34dbf37c60290116f2f00af1dacd55 libraries/base/GHC/Natural.hs | 17 +++- .../integer-gmp/src/GHC/Integer/GMP/Internals.hs | 3 + libraries/integer-gmp/src/GHC/Integer/Type.hs | 90 ++++++++++++++++++++-- 3 files changed, 101 insertions(+), 9 deletions(-) diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs index 953b2a4..fb405a6 100644 --- a/libraries/base/GHC/Natural.hs +++ b/libraries/base/GHC/Natural.hs @@ -324,7 +324,22 @@ instance Bits Natural where testBit (NatS# w) i = testBit (W# w) i testBit (NatJ# bn) (I# i#) = testBitBigNat bn i# - -- TODO: setBit, clearBit, complementBit (needs more primitives) + clearBit n@(NatS# w#) i + | i < finiteBitSize (0::Word) = let !(W# w2#) = clearBit (W# w#) i in NatS# w2# + | otherwise = n + clearBit (NatJ# bn) (I# i#) = bigNatToNatural (clearBitBigNat bn i#) + + setBit (NatS# w#) i@(I# i#) + | i < finiteBitSize (0::Word) = let !(W# w2#) = setBit (W# w#) i in NatS# w2# + | otherwise = bigNatToNatural (setBitBigNat (wordToBigNat w#) i#) + setBit (NatJ# bn) (I# i#) = bigNatToNatural (setBitBigNat bn i#) + + complementBit (NatS# w#) i@(I# i#) + | i < finiteBitSize (0::Word) = let !(W# w2#) = setBit (W# w#) i in NatS# w2# + | otherwise = bigNatToNatural (setBitBigNat (wordToBigNat w#) i#) + complementBit (NatJ# bn) (I# i#) = bigNatToNatural (complementBitBigNat bn i#) + + -- TODO: complementBit (needs more primitives) shiftL n 0 = n shiftL (NatS# 0##) _ = NatS# 0## diff --git a/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs b/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs index 0ad6848..a613ab1 100644 --- a/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs +++ b/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs @@ -106,6 +106,9 @@ module GHC.Integer.GMP.Internals , shiftRBigNat , shiftLBigNat , testBitBigNat + , clearBitBigNat + , complementBitBigNat + , setBitBigNat , andBigNat , xorBigNat , popCountBigNat diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs index 6506ebf..2bacc13 100644 --- a/libraries/integer-gmp/src/GHC/Integer/Type.hs +++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs @@ -1061,7 +1061,7 @@ bitBigNat i# mbn@(MBN# mba#) <- newBigNat# (li# +# 1#) -- FIXME: do we really need to zero-init MBAs returned by 'newByteArray#'? -- clear all limbs (except for the most-significant limb) - _ <- svoid (setByteArray# mba# 0# (li# `uncheckedIShiftL#` GMP_LIMB_SHIFT#) 0#) + _ <- svoid (clearWordArray# mba# 0# li#) -- set single bit in most-significant limb _ <- svoid (writeBigNat# mbn li# (uncheckedShiftL# 1## bi#)) unsafeFreezeBigNat# mbn @@ -1092,6 +1092,67 @@ testBitNegBigNat bn i# allZ j | isTrue# (indexBigNat# bn (j -# 1#) `eqWord#` 0##) = allZ (j -# 1#) | True = False + +clearBitBigNat :: BigNat -> Int# -> BigNat +clearBitBigNat bn i# + | not (inline testBitBigNat bn i#) = bn + | isTrue# (nx# ==# 1#) = wordToBigNat (bigNatToWord bn `xor#` bitWord# bi#) + | isTrue# (li# +# 1# ==# nx#) = -- special case, operating on most-sig limb + case indexBigNat# bn li# `xor#` bitWord# bi# of + 0## -> do -- most-sig limb became zero -> result has less limbs + case fmssl bn (li# -# 1#) of + 0# -> zeroBigNat + n# -> runS $ do + mbn <- newBigNat# n# + _ <- copyWordArray bn 0# mbn 0# n# + unsafeFreezeBigNat# mbn + newlimb# -> runS $ do -- no shrinking + mbn <- newBigNat# nx# + _ <- copyWordArray bn 0# mbn 0# li# + _ <- svoid (writeBigNat# mbn li# newlimb#) + unsafeFreezeBigNat# mbn + + | True = runS $ do + mbn <- newBigNat# nx# + _ <- copyWordArray bn 0# mbn 0# nx# + let newlimb# = indexBigNat# bn li# `xor#` bitWord# bi# + _ <- svoid (writeBigNat# mbn li# newlimb#) + unsafeFreezeBigNat# mbn + + where + (# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS# + nx# = sizeofBigNat# bn + + + +setBitBigNat :: BigNat -> Int# -> BigNat +setBitBigNat bn i# + | inline testBitBigNat bn i# = bn + | isTrue# (d# ># 0#) = runS $ do -- result BigNat will have more limbs + mbn@(MBN# mba#) <- newBigNat# (li# +# 1#) + _ <- copyWordArray bn 0# mbn 0# nx# + _ <- svoid (clearWordArray# mba# nx# (d# -# 1#)) + _ <- svoid (writeBigNat# mbn li# (bitWord# bi#)) + unsafeFreezeBigNat# mbn + + | True = runS $ do + mbn <- newBigNat# nx# + _ <- copyWordArray bn 0# mbn 0# nx# + _ <- svoid (writeBigNat# mbn li# (indexBigNat# bn li# + `or#` bitWord# bi#)) + unsafeFreezeBigNat# mbn + + where + (# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS# + nx# = sizeofBigNat# bn + d# = li# +# 1# -# nx# + + +complementBitBigNat :: BigNat -> Int# -> BigNat +complementBitBigNat bn i# + | testBitBigNat bn i# = clearBitBigNat bn i# + | True = setBitBigNat bn i# + popCountBigNat :: BigNat -> Int# popCountBigNat bn@(BN# ba#) = word2Int# (c_mpn_popcount ba# (sizeofBigNat# bn)) @@ -1748,6 +1809,15 @@ copyWordArray# src src_ofs dst dst_ofs len dst (dst_ofs `uncheckedIShiftL#` GMP_LIMB_SHIFT#) (len `uncheckedIShiftL#` GMP_LIMB_SHIFT#) +copyWordArray :: BigNat -> Int# -> MutBigNat s -> Int# -> Int# -> S s () +copyWordArray (BN# ba#) ofs_ba# (MBN# mba#) ofs_mba# len# + = svoid (copyWordArray# ba# ofs_ba# mba# ofs_mba# len#) + +clearWordArray# :: MutableByteArray# s -> Int# -> Int# -> State# s -> State# s +clearWordArray# mba ofs len + = setByteArray# mba (ofs `uncheckedIShiftL#` GMP_LIMB_SHIFT#) + (len `uncheckedIShiftL#` GMP_LIMB_SHIFT#) 0# + -- | Version of 'normSizeofMutBigNat'#' which scans all allocated 'MutBigNat#' normSizeofMutBigNat# :: MutBigNat s -> State# s -> (# State# s, Int# #) normSizeofMutBigNat# mbn@(MBN# mba) s = normSizeofMutBigNat'# mbn sz# s' @@ -1791,13 +1861,7 @@ byteArrayToBigNat# ba# n0# where (# baszq#, baszr# #) = quotRemInt# (sizeofByteArray# ba#) GMP_LIMB_BYTES# - n# = fmssl (n0# -# 1#) - - -- find most signifcant set limb, return normalized size - fmssl i# - | isTrue# (i# <# 0#) = 0# - | isTrue# (neWord# (indexWordArray# ba# i#) 0##) = i# +# 1# - | True = fmssl (i# -# 1#) + n# = fmssl (BN# ba#) (n0# -# 1#) -- | Read 'Integer' (without sign) from memory location at @/addr/@ in -- base-256 representation. @@ -2050,3 +2114,13 @@ cmpI# x# y# = (x# ># y#) -# (x# <# y#) minI# :: Int# -> Int# -> Int# minI# x# y# | isTrue# (x# <=# y#) = x# | True = y# + + + +-- find most-sig set limb, starting at given index +fmssl :: BigNat -> Int# -> Int# +fmssl bn i0# = go i0# + where + go i# | isTrue# (i# <# 0#) = 0# + | isTrue# (neWord# (indexBigNat# bn i#) 0##) = i# +# 1# + | True = go (i# -# 1#) From git at git.haskell.org Wed Jun 22 08:56:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 08:56:18 +0000 (UTC) Subject: [commit: ghc] master: Second attempt to fix sizeExpr (a47b62c) Message-ID: <20160622085618.443123A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a47b62cb36853d03c77ef63b3208b3d869fb687e/ghc >--------------------------------------------------------------- commit a47b62cb36853d03c77ef63b3208b3d869fb687e Author: Simon Marlow Date: Fri Jun 17 11:21:52 2016 +0100 Second attempt to fix sizeExpr Summary: Background: * sizeExpr was calculating expressions like ((e `cast` T) x) wrongly * Fixing it caused regressions in compile performance, and one nofib program (k-nucleotide) I managed to fix the source of the compiler regressions. I think it was due to traceTc not being inlined, which I fixed in a more robust way by putting an export list on TcRnMonad. The k-nucleotide regression is more difficult. I don't think anything is actually going wrong, but this program has been highly tuned and is quite sensitive to changing in inlining behaviour. I managed to recover most of the performance by manual lambda-lifting which makes it a bit less fragile, but the end result was a bit slower. I don't think this is disastrous, the program is pretty horrible to begin with and we could probably make a faster one by starting from scratch. Test Plan: validate, nofib Reviewers: simonpj, bgamari, niteria, austin, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2338 GHC Trac Issues: #11564 >--------------------------------------------------------------- a47b62cb36853d03c77ef63b3208b3d869fb687e compiler/coreSyn/CoreUnfold.hs | 66 ++++++++++++++------- compiler/typecheck/TcRnMonad.hs | 127 +++++++++++++++++++++++++++++++++++++--- 2 files changed, 163 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 a47b62cb36853d03c77ef63b3208b3d869fb687e From git at git.haskell.org Wed Jun 22 09:16:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 09:16:25 +0000 (UTC) Subject: [commit: ghc] master: Fix build breakage due to rebase (c0583a9) Message-ID: <20160622091625.831F23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c0583a9ee51d2b8513f3d140e84ae1da92628c1b/ghc >--------------------------------------------------------------- commit c0583a9ee51d2b8513f3d140e84ae1da92628c1b Author: Simon Marlow Date: Wed Jun 22 10:19:42 2016 +0100 Fix build breakage due to rebase >--------------------------------------------------------------- c0583a9ee51d2b8513f3d140e84ae1da92628c1b compiler/typecheck/TcRnMonad.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 5aed70c..1aa3faa 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -31,7 +31,7 @@ module TcRnMonad( newArrowScope, escapeArrowScope, -- * Unique supply - newUnique, newUniqueSupply, newLocalName, newName, + newUnique, newUniqueSupply, newName, newSysName, newSysLocalId, newSysLocalIds, -- * Accessing input/output From git at git.haskell.org Wed Jun 22 09:32:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 09:32:20 +0000 (UTC) Subject: [commit: ghc] master: Hopefully fix all the rebase-induced breakage (9d62d09) Message-ID: <20160622093220.5C9CB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9d62d09a6c399c98491b7a63a7a1366c89fcf5db/ghc >--------------------------------------------------------------- commit 9d62d09a6c399c98491b7a63a7a1366c89fcf5db Author: Simon Marlow Date: Wed Jun 22 10:32:12 2016 +0100 Hopefully fix all the rebase-induced breakage >--------------------------------------------------------------- 9d62d09a6c399c98491b7a63a7a1366c89fcf5db compiler/typecheck/TcRnMonad.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 1aa3faa..a411e18 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -31,7 +31,7 @@ module TcRnMonad( newArrowScope, escapeArrowScope, -- * Unique supply - newUnique, newUniqueSupply, newName, + newUnique, newUniqueSupply, newName, newNameAt, cloneLocalName, newSysName, newSysLocalId, newSysLocalIds, -- * Accessing input/output From git at git.haskell.org Wed Jun 22 10:02:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 10:02:14 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments [skip ci] (4e7d835) Message-ID: <20160622100214.9135E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4e7d8350a10167a7de8dd4d9ffd3a21194177c39/ghc >--------------------------------------------------------------- commit 4e7d8350a10167a7de8dd4d9ffd3a21194177c39 Author: Gabor Greif Date: Tue Jun 21 16:11:10 2016 +0200 Typos in comments [skip ci] >--------------------------------------------------------------- 4e7d8350a10167a7de8dd4d9ffd3a21194177c39 compiler/basicTypes/MkId.hs | 2 +- compiler/coreSyn/CoreLint.hs | 2 +- compiler/simplCore/OccurAnal.hs | 2 +- compiler/simplCore/Simplify.hs | 2 +- compiler/specialise/Specialise.hs | 4 ++-- testsuite/tests/dependent/should_compile/dynamic-paper.hs | 2 +- 6 files changed, 7 insertions(+), 7 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index e146c66..99a4d25 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -393,7 +393,7 @@ mkDataConWorkId wkr_name data_con -- the simplifier thinks that y is "sure to be evaluated" (because -- $wMkT is strict) and drops the case. No, $wMkT is not strict. -- - -- When the simplifer sees a pattern + -- When the simplifier sees a pattern -- case e of MkT x -> ... -- it uses the dataConRepStrictness of MkT to mark x as evaluated; -- but that's fine... dataConRepStrictness comes from the data con diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index d905b8c..06e45830 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -891,7 +891,7 @@ checkCaseAlts :: CoreExpr -> OutType -> [CoreAlt] -> LintM () -- b2) Check that the others are in increasing order -- c) Check that there's a default for infinite types -- NB: Algebraic cases are not necessarily exhaustive, because --- the simplifer correctly eliminates case that can't +-- the simplifier correctly eliminates case that can't -- possibly match. checkCaseAlts e ty alts = diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index 33e0c45..2efd82f 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -958,7 +958,7 @@ reOrderNodes depth bndr_set weak_fvs (node : nodes) binds | otherwise = 0 -- Checking for a constructor application - -- Cheap and cheerful; the simplifer moves casts out of the way + -- Cheap and cheerful; the simplifier moves casts out of the way -- The lambda case is important to spot x = /\a. C (f a) -- which comes up when C is a dictionary constructor and -- f is a default method. diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 6e6a6aa..bd0c8a9 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -2320,7 +2320,7 @@ knownCon env scrut dc dc_ty_args dc_args bndr bs rhs cont ------------------- missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont -> SimplM (SimplEnv, OutExpr) -- This isn't strictly an error, although it is unusual. - -- It's possible that the simplifer might "see" that + -- It's possible that the simplifier might "see" that -- an inner case has no accessible alternatives before -- it "sees" that the entire branch of an outer case is -- inaccessible. So we simply put an error case here instead. diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index abd15c8..644ecc7 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -398,7 +398,7 @@ Seems quite reasonable. Similar things could be done with instance decls: Ho hum. Things are complex enough without this. I pass. -Requirements for the simplifer +Requirements for the simplifier ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The simplifier has to be able to take advantage of the specialisation. @@ -1356,7 +1356,7 @@ crash. So we use Refl right off the bat, and do not forall-quantify 'g': * exprsFreeIdsList returns the Ids bound by the args, which won't include g -You might wonder if this will match as often, but the simplifer replaces +You might wonder if this will match as often, but the simplifier replaces complicated Refl coercions with Refl pretty aggressively. Note [Orphans and auto-generated rules] diff --git a/testsuite/tests/dependent/should_compile/dynamic-paper.hs b/testsuite/tests/dependent/should_compile/dynamic-paper.hs index 8381552..0d55bba 100644 --- a/testsuite/tests/dependent/should_compile/dynamic-paper.hs +++ b/testsuite/tests/dependent/should_compile/dynamic-paper.hs @@ -2,7 +2,7 @@ Stephanie Weirich, Richard Eisenberg, and Dimitrios Vytiniotis, 2016. -} -- NB: it includes a negative-recursive function (see delta1), and --- so will give "simplifer ticks exhausted", at least with -O +-- so will give "simplifier ticks exhausted", at least with -O {-# LANGUAGE RankNTypes, PolyKinds, TypeOperators, ScopedTypeVariables, GADTs, FlexibleInstances, From git at git.haskell.org Wed Jun 22 10:02:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 10:02:17 +0000 (UTC) Subject: [commit: ghc] master: More typos in comments [skip ci] (6199588) Message-ID: <20160622100217.591E43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/619958832cbe11096cae3dac9a0a7a5591163a00/ghc >--------------------------------------------------------------- commit 619958832cbe11096cae3dac9a0a7a5591163a00 Author: Gabor Greif Date: Tue Jun 21 16:16:20 2016 +0200 More typos in comments [skip ci] >--------------------------------------------------------------- 619958832cbe11096cae3dac9a0a7a5591163a00 compiler/basicTypes/DataCon.hs | 2 +- compiler/basicTypes/Demand.hs | 2 +- compiler/basicTypes/MkId.hs | 2 +- compiler/codeGen/StgCmmClosure.hs | 2 +- compiler/coreSyn/CoreUtils.hs | 4 ++-- compiler/main/HscTypes.hs | 2 +- compiler/rename/RnSource.hs | 2 +- compiler/simplCore/OccurAnal.hs | 2 +- compiler/simplCore/Simplify.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 2 +- compiler/types/FamInstEnv.hs | 2 +- compiler/types/TyCon.hs | 2 +- rts/RtsAPI.c | 2 +- 13 files changed, 14 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 619958832cbe11096cae3dac9a0a7a5591163a00 From git at git.haskell.org Wed Jun 22 13:19:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 13:19:14 +0000 (UTC) Subject: [commit: ghc] master: Don't error on GCC inlining warning in rts (93f40cb) Message-ID: <20160622131914.1E3BD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/93f40cb9b93b0308b211eaf4ad8f2fee6cb1b5aa/ghc >--------------------------------------------------------------- commit 93f40cb9b93b0308b211eaf4ad8f2fee6cb1b5aa Author: Bartosz Nitka Date: Wed Jun 22 06:22:45 2016 -0700 Don't error on GCC inlining warning in rts The warning for reference: ``` rts/RaiseAsync.c: In function ‘throwToMsg’: rts/SMPClosureOps.h:65:0: error: error: inlining failed in call to ‘lockClosure’: call is unlikely and code size would grow rts/RaiseAsync.c:305:0: error: error: called from here rts/SMPClosureOps.h:65:0: error: error: inlining failed in call to ‘lockClosure’: call is unlikely and code size would grow ``` This warning triggers on `gcc (GCC) 4.4.7 20120313 (Red Hat 4.4.7-16)` and it doesn't trigger with new GCCs. Test Plan: build ghc/rts Reviewers: bgamari, simonmar, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2353 >--------------------------------------------------------------- 93f40cb9b93b0308b211eaf4ad8f2fee6cb1b5aa mk/warnings.mk | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/mk/warnings.mk b/mk/warnings.mk index 61d60ab..5ca097f 100644 --- a/mk/warnings.mk +++ b/mk/warnings.mk @@ -21,13 +21,14 @@ ifeq "$(GccLT46)" "NO" ifneq "$(HostOS_CPP)" "mingw32" SRC_CC_WARNING_OPTS += -Werror=unused-but-set-variable endif -# gcc 4.6 gives 3 warning for giveCapabilityToTask not being inlined -SRC_CC_WARNING_OPTS += -Wno-error=inline endif ifeq "$(GccLT44)" "NO" # Suppress the warning about __sync_fetch_and_nand (#9678). libraries/ghc-prim/cbits/atomic_CC_OPTS += -Wno-sync-nand +# gcc 4.6 gives 3 warnings for giveCapabilityToTask not being inlined +# gcc 4.4 gives 2 warnings for lockClosure not being inlined +SRC_CC_WARNING_OPTS += -Wno-error=inline endif else From git at git.haskell.org Wed Jun 22 14:25:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 14:25:49 +0000 (UTC) Subject: [commit: ghc] master: Make the Ord Module independent of Unique order (2nd try) (348f2db) Message-ID: <20160622142549.0DD6A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/348f2dbb835b1208f601bb1e8daa1d1d54507eda/ghc >--------------------------------------------------------------- commit 348f2dbb835b1208f601bb1e8daa1d1d54507eda Author: Bartosz Nitka Date: Thu Jun 9 08:50:32 2016 -0700 Make the Ord Module independent of Unique order (2nd try) The `Ord Module` instance currently uses `Unique`s for comparison. We don't want to use the `Unique` order because it can introduce nondeterminism. This switches `Ord ModuleName` and `Ord UnitId` to use lexicographic ordering making `Ord Module` deterministic transitively. I've run `nofib` and it doesn't make a measurable difference. See also Note [ModuleEnv determinism and performance]. This fixes #12191 - the regression, that the previous version of this patch had. Test Plan: ./validate run nofib: P112 Reviewers: simonmar, bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2354 GHC Trac Issues: #4012, #12191 >--------------------------------------------------------------- 348f2dbb835b1208f601bb1e8daa1d1d54507eda compiler/basicTypes/Module.hs | 95 +++++++++++++++------- compiler/typecheck/FamInst.hs | 35 +++++++- testsuite/tests/driver/sigof01/all.T | 2 +- .../should_fail/overloadedrecfldsfail10.stderr | 4 +- testsuite/tests/rename/should_fail/T11071.stderr | 2 +- testsuite/tests/rename/should_fail/T11071a.stderr | 32 ++++---- .../tests/typecheck/should_fail/T6018fail.stderr | 4 +- 7 files changed, 119 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 348f2dbb835b1208f601bb1e8daa1d1d54507eda From git at git.haskell.org Wed Jun 22 15:55:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 15:55:14 +0000 (UTC) Subject: [commit: ghc] wip/rae: Very confusing typo in error message. (4d91dc9) Message-ID: <20160622155514.D94B53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/4d91dc996c96aefb440babbaa029db15f7ff308f/ghc >--------------------------------------------------------------- commit 4d91dc996c96aefb440babbaa029db15f7ff308f Author: Richard Eisenberg Date: Fri Apr 22 15:29:10 2016 -0400 Very confusing typo in error message. >--------------------------------------------------------------- 4d91dc996c96aefb440babbaa029db15f7ff308f compiler/typecheck/TcInteract.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index a9f7bc6..317e7c4 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -165,7 +165,7 @@ solveSimpleWanteds simples | n `intGtLimit` limit = failTcS (hang (text "solveSimpleWanteds: too many iterations" <+> parens (text "limit =" <+> ppr limit)) - 2 (vcat [ text "Set limit with -fsolver-iterations=n; n=0 for no limit" + 2 (vcat [ text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit" , text "Simples =" <+> ppr simples , text "WC =" <+> ppr wc ])) From git at git.haskell.org Wed Jun 22 15:55:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 15:55:18 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #11974 by adding a more smarts to TcDefaults. (f8fa1b5) Message-ID: <20160622155518.9D92F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/f8fa1b5f40106f10aaa08d6dea68f6355513d52f/ghc >--------------------------------------------------------------- commit f8fa1b5f40106f10aaa08d6dea68f6355513d52f Author: Richard Eisenberg Date: Fri Apr 22 22:28:35 2016 -0400 Fix #11974 by adding a more smarts to TcDefaults. Test cases: typecheck/should_compile/T11974 typecheck/should_fail/T11974b >--------------------------------------------------------------- f8fa1b5f40106f10aaa08d6dea68f6355513d52f compiler/prelude/PrelNames.hs | 12 +++++++ compiler/typecheck/TcDefaults.hs | 37 ++++++++++++---------- compiler/typecheck/TcSimplify.hs | 2 +- testsuite/tests/typecheck/should_compile/T11974.hs | 5 +++ testsuite/tests/typecheck/should_compile/all.T | 1 + testsuite/tests/typecheck/should_fail/T11974b.hs | 7 ++++ .../tests/typecheck/should_fail/T11974b.stderr | 15 +++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 8 files changed, 62 insertions(+), 18 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f8fa1b5f40106f10aaa08d6dea68f6355513d52f From git at git.haskell.org Wed Jun 22 15:55:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 15:55:22 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #10963 and #11975 by adding new cmds to GHCi. (1f6990b) Message-ID: <20160622155522.565963A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/1f6990bb2910e16d01deb9813bbd1624f3d5ba0d/ghc >--------------------------------------------------------------- commit 1f6990bb2910e16d01deb9813bbd1624f3d5ba0d Author: Richard Eisenberg Date: Fri Apr 22 22:39:17 2016 -0400 Fix #10963 and #11975 by adding new cmds to GHCi. See the user's guide entry or the Note [TcRnExprMode] in TcRnDriver. Test cases: ghci/scripts/T{10963,11975} >--------------------------------------------------------------- 1f6990bb2910e16d01deb9813bbd1624f3d5ba0d compiler/main/GHC.hs | 2 +- compiler/main/HscMain.hs | 8 +-- compiler/main/InteractiveEval.hs | 8 +-- compiler/typecheck/TcBinds.hs | 9 +-- compiler/typecheck/TcExpr.hs | 11 ++-- compiler/typecheck/TcPatSyn.hs | 3 +- compiler/typecheck/TcRnDriver.hs | 101 ++++++++++++++++++++++------- compiler/typecheck/TcSimplify.hs | 92 +++++++++++++++++--------- docs/users_guide/ghci.rst | 66 +++++++++++++++++-- ghc/GHCi/UI.hs | 12 +++- ghc/GHCi/UI/Info.hs | 2 +- testsuite/tests/ghc-api/T8639_api.hs | 2 +- testsuite/tests/ghci/scripts/T10963.script | 7 ++ testsuite/tests/ghci/scripts/T10963.stderr | 12 ++++ testsuite/tests/ghci/scripts/T10963.stdout | 4 ++ testsuite/tests/ghci/scripts/T11975.script | 9 +++ testsuite/tests/ghci/scripts/T11975.stdout | 15 +++++ testsuite/tests/ghci/scripts/all.T | 2 + 18 files changed, 283 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 1f6990bb2910e16d01deb9813bbd1624f3d5ba0d From git at git.haskell.org Wed Jun 22 15:55:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 15:55:24 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix comments to ghci stuff (821a880) Message-ID: <20160622155524.F2A9F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/821a88006421743ac3d6d92179937976d4dcea43/ghc >--------------------------------------------------------------- commit 821a88006421743ac3d6d92179937976d4dcea43 Author: Richard Eisenberg Date: Sun May 29 23:17:24 2016 -0400 Fix comments to ghci stuff >--------------------------------------------------------------- 821a88006421743ac3d6d92179937976d4dcea43 compiler/typecheck/TcSimplify.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 90222ea..a3fc20a 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -514,11 +514,12 @@ the let binding. -} --- | How should we infer the type? +-- | How should we choose which constraints to quantify over? data InferMode = ApplyMR -- ^ Apply the monomorphism restriction, -- never quantifying over any constraints | EagerDefaulting -- ^ See Note [TcRnExprMode] in TcRnDriver, - -- the :type +d case + -- the :type +d case; this mode refuses + -- to quantify over any defaultable constraint | NoRestrictions -- ^ Quantify over any constraint that -- satisfies TcType.pickQuantifiablePreds From git at git.haskell.org Wed Jun 22 15:55:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 15:55:27 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Fix comments to ghci stuff (821a880) Message-ID: <20160622155527.CC1D53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: 7e4f3dc StgCmmUtils.emitMultiAssign: Make assertion msg more helpful 0ffa23d Remove unused FAST_STRING_NOT_NEEDED macro defs 930e74f Update a Cmm note 0676e68 Fix detection and use of `USE_LIBDW` cb2c042 Use nameSetAny in findUses f2b3be0 Improve failed knot-tying error message. 99ace83 Kill nameSetElems in getInfo 36d254a Testsuite: run tests in /tmp/ghctest-xxx instead of /tmp/ghctest/xxx 940229c Travis: llvm's apt repository is offline cb9f635 Localize orphan-related nondeterminism d348acd Serialize vParallelTyCons in a stable order 3eac3a0 Add nameSetElemsStable and fix the build dad39ff Remove dead generics-related code from OccName d753ea2 Use UniqDSet for finding free names in the Linker e2446c0 Kill nameSetElems in findImportUsage be47085 Kill nameSetElems in rnCmdTop 060c176 Whitespace only 1d1987e HscMain: Minor simplification 9cc6fac Make FieldLabelEnv a deterministic set 2046297 Document putSymbolTable determinism 4842a80 Derive instances in Data.Data 1dadd9a testsuite: Mark broken tests on powerpc64le 3747372 Refactored SymbolInfo to lower memory usage in RTS 079c1b8 Use useful names for Symbol Addr and Names in Linker.c 02f893e integer-gmp: Make minusInteger more efficient 4aa299d PrelInfo: Ensure that tuple promoted datacon names are in knownKeyNames eda73a3 RTS SMP: Use compiler built-ins on all platforms. 4dbacbc Rename isPinnedByteArray# to isByteArrayPinned# b948a1d Refactor the SymbolName and SymbolAddr types to be pointers 5965117 Replace hand-written Bounded instances with derived ones 0d963ca Add relocation type R_X86_64_REX_GOTPCRELX 4848ab9 Testsuite: fixup comments for T9872d [skip ci] 886f4c1 Better comment for orIfNotFound. f91d87d Failing test-case for #12135. 3042a9d Use UniqDFM for HomePackageTable 48e9a1f Implement deterministic CallInfoSet a90085b Add @since annotations to base instances e684f54 Desugar ApplicativeDo and RecDo deterministically 31ba8d6 Kill nameSetElems 46d2da0 Document putDictionary determinism 3e7a876 Kill foldUniqSet 1937ef1 Make UnitIdMap a deterministic map a13cb27 Merge MatchFixity and HsMatchContext 77ccdf3 Kill occSetElts 7fea712 Use a deterministic map for imp_dep_mods d05dee3 CoreToStg: Remove hand-written Eq instances of HowBound and LetInfo 4426c5f Kill two instances of uniqSetToList 0d6f428 Fix build by removing unused import c148212 Kill varSetElems in checkValidInferredKinds ad8e203 Use DVarSet in Vectorise.Exp 3b698e8 Document determinism in pprintClosureCommand 5db93d2 Make vectInfoParallelVars a DVarSet 7008515 Kill varSetElems 7d58a97 Use pprUFM in pprStgLVs 00e3a5d Typofix. 4d5b2f6 Testsuite driver: always quote opts.testdir f5f5a8a Testsuite Windows: mark T8308 expect_broken (#8308) d4b548e Add some determinism tests dd33245 Desugar: Display resulting program stats with -v2 44a3c18 Revert "Desugar: Display resulting program stats with -v2" c2bbc8b Report term sizes with -v3 even when -ddump is enabled 80cf4cf Literal: Remove unused hashLiteral function d7933cb Show sources of cost centers in .prof 8f6d292 Fix #12064 by making IfaceClass typechecking more lazy. acb9e85 Minor performance note about IdInfo. 11ff1df Fix #12076 by inlining trivial expressions in CorePrep. 48385cb Remove special casing of Windows in generic files ceaf7f1 Implement Eq TyCon directly 68c1c29 Remove Ord (CoAxiom br) 9dbf354 Testsuite: delete dead code [skip ci] e703a23 Docs: fix links to ghc-flags 70e0a56 Remove Ord Class b2624ee Remove Ord PatSyn 77b8c29 Remove Ord AltCon c22ab1a Docs: delete PatternGuards documentation b020db2 Fix Ticky histogram on Windows e9dfb6e Improve the error messages for static forms. b0a7664 prettyPrintClosure(): Untag the closure before accessing fields 47d8173 Remove Printer.c:prettyPrintClosure() bcb419a Fix #12099: Remove bogus flags 6adff01 Comments only 6905ce2 Refine imports slightly 0f0b002 Comments only 3ae18df Minor refactoring b9fa72a Small refactor to mkRuntimErrorId 9e5ea67 NUMA support c88f31a Rts flags cleanup 5990016 ModuleSet: Use an actual set instead of map to units 6ace660 rts: Fix build when USE_LARGE_ADDRESS_SPACE is undefined 9130867 Skip retc001 on OSX b40e1b4 Fix incorrect calculated relocations on Windows x86_64 29e1464 Disable T12031 on linux 2bb6ba6 rts: Fix NUMA when cross compiling d25cb61 Kill off redundant SigTv check in occurCheckExpand 15b9bf4 Improve typechecking of let-bindings c28dde3 Tidy up zonkQuantifiedTyVar 7afb7ad Get in-scope set right in top_instantiate 35c9de7 Move the constraint-kind validity check 1f66128 Beef up mkNakedCastTy 15fc528 Fix the in-scope set for extendTvSubstWithClone 599d912 Beef up isPredTy 8104f7c Remove some traceTc calls e064f50 Add to .gitignore 921ebc9 Test Trac #12055 1dcb32d A second test for Trac #12055 5cee88d Add thin library support to Windows too 7de776c Kill unused foldModuleEnv 586d558 Use UniqFM for SigOf 0497ee5 Make the Ord Module independent of Unique order d55a9b4 Update Haddock to follow change in LHsSigWcType 4f35646 Adjust error message slightly 8dfd4ae Build system: mention ghc version in bindist's `configure --help` docdir a2deee0 Testsuite: enable ghci.prog010 (#2542) 23b73c9 Don't GC sparks for CAFs 9d22fbe Rename cmpType to nonDetCmpType 753c5b2 Simplify readProcessEnvWithExitCode + set LANGUAGE=C 70a4589 Revert "Make the Ord Module independent of Unique order" e33ca0e Fix testsuite wibble 77bb092 Re-add FunTy (big patch) e368f32 Major patch to introduce TyConBinder c56f8bd CoreMonad: Update error msg function docs 930a525 Abort the build when a Core plugin pass is specified in stage1 compiler a7f65b8 Remove dead code: countOnce, countMany 498ed26 NUMA cleanups 8d33af9 CoreLint: Slightly improve case type annotation error msgs 3e8c495 CmmNode: Make CmmTickScope's Unique strict 2396d9b llvmGen: Make metadata ids a newtype 85e09b1 llvmGen: Consolidate MetaExpr pretty-printing 9bb0578 Revert accidental submodule updates e02beb1 Driver: `ghc ../Test` (without file extension) should work f72f23f Testsuite: run tests in .run instead of /tmp 6f6f515 Testsuite: write "\n" instead of "\r\n" when using mingw Python d94c405 Testsuite: validate the tests/stage1 directory with the stage1 compiler a4c8532 Validate: use `rm -f` instead of `rm` 6354991 VarEnv: Comment only 270d545 Add Bifoldable and Bitraversable to base 9649fc0 Refactor derived Generic instances to reduce allocations 4d71cc8 Avoid find_tycon panic if datacon is not in scope f12fb8a Fix trac #10647: Notice about lack of SIMD support 2897be7 PPC NCG: Fix float parameter passing on 64-bit. f4b0488 PPC NCG: Fix and refactor TOC handling. 0be38a2 llvmGen: Add strictness to metadata fields 0e92af9 Remove use of KProxy in GHC.Generics 0ba34b6 ApplicativeDo: allow "return $ e" e7e42c8 Fix double-free in T5644 (#12208) cdc14b4 Testsuite: remove Windows CR again.. [skip ci] 9cdde38 Testsuite: remove Windows CR [skip ci] cf6e656 Testsuite: remove Windows CR [skip ci] 3dc1202 Testsuite: tabs -> spaces [skip ci] 7e7094f Testsuite: tabs -> spaces [skip ci] 46ff80f Testsuite: tabs -> spaces [skip ci] 915e07c Testsuite: tabs -> spaces [skip ci] 5b03dc6 Testsuite: tabs -> spaces [skip ci] a7160fa Testsuite: tabs -> spaces [skip ci] 4a4bdda Testsuite: recover from utf8 decoding errors 6d0a4fc Testsuite: fix WAY=ghci when LOCAL=0 1ddc10b Testsuite: *do* replace backslashes in config.libdir 1d938aa Testsuite: mark tests expect broken 3b49f8f Testsuite: remove `-fforce-recomp` from default flags (#11980) 82f7f18 Testsuite: delete TEST_HC_OPTS_NO_RECOMP 135fc86 Testsuite: remove `-Wno-warn-tabs` from default flags ebaf26b Testsuite: delete dead code + cleanup e170d19 Testsuite: assume timeout_prog always exists ee3bde7 Expand and clarify the docs for ApplicativeDo (#11835) 7301404 Typos in comments d09e982 Don't quantify over Refl in a RULE 97a50f8 Delete commented-out code 1230629 Make checkFamInstConsistency less expensive a47b62c Second attempt to fix sizeExpr c0583a9 Fix build breakage due to rebase 9d62d09 Hopefully fix all the rebase-induced breakage 4e7d835 Typos in comments [skip ci] 6199588 More typos in comments [skip ci] 93f40cb Don't error on GCC inlining warning in rts 4d91dc9 Very confusing typo in error message. f8fa1b5 Fix #11974 by adding a more smarts to TcDefaults. 1f6990b Fix #10963 and #11975 by adding new cmds to GHCi. 821a880 Fix comments to ghci stuff From git at git.haskell.org Wed Jun 22 21:08:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 21:08:20 +0000 (UTC) Subject: [commit: ghc] master: Accept new (lower) allocations for T7257 (15641b0) Message-ID: <20160622210820.C04623A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/15641b07f1d3ccb5f35b4f31539ecceb5fb38c17/ghc >--------------------------------------------------------------- commit 15641b07f1d3ccb5f35b4f31539ecceb5fb38c17 Author: Simon Marlow Date: Wed Jun 22 20:54:59 2016 +0100 Accept new (lower) allocations for T7257 >--------------------------------------------------------------- 15641b07f1d3ccb5f35b4f31539ecceb5fb38c17 testsuite/tests/perf/should_run/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index caf4eff..3cb6f8e 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -276,9 +276,10 @@ test('T7257', [(wordsize(32), 989850664, 10), # expected value: 1246287228 (i386/Linux) # 2016-04-06: 989850664 (i386/Linux) no idea what happened - (wordsize(64), 1654893248, 5)]), + (wordsize(64), 1414893248, 5)]), # 2012-09-21: 1774893760 (amd64/Linux) # 2015-11-03: 1654893248 (amd64/Linux) + # 2016-06-22: 1414893248 (amd64/Linux, sizeExpr fix) stats_num_field('peak_megabytes_allocated', [(wordsize(32), 217, 5), # 2012-10-08: 217 (x86/Linux) From git at git.haskell.org Wed Jun 22 21:18:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 21:18:14 +0000 (UTC) Subject: [commit: ghc] master: Comments only (7e7aeab) Message-ID: <20160622211814.159C53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7e7aeab21c1afa7251e0879c78bbc42040a1936a/ghc >--------------------------------------------------------------- commit 7e7aeab21c1afa7251e0879c78bbc42040a1936a Author: Simon Peyton Jones Date: Wed Jun 22 14:09:11 2016 +0100 Comments only >--------------------------------------------------------------- 7e7aeab21c1afa7251e0879c78bbc42040a1936a compiler/typecheck/TcValidity.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 8b62187..fb1a567 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -888,7 +888,6 @@ check_class_pred env dflags ctxt pred cls tys A type signature like f :: Eq [(a,b)] => a -> b is very fragile, for reasons described at length in TcInteract - Note [Instance and Given overlap]. So this warning discourages uses from writing simplifiable class constraints, at least unless the top-level instance is explicitly declared as OVERLAPPABLE. From git at git.haskell.org Wed Jun 22 21:18:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 21:18:16 +0000 (UTC) Subject: [commit: ghc] master: Improve error message in deriving( Functor ) (cc92a44) Message-ID: <20160622211816.C7C153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cc92a446d6932cf06364529e71c866289088c59a/ghc >--------------------------------------------------------------- commit cc92a446d6932cf06364529e71c866289088c59a Author: Simon Peyton Jones Date: Wed Jun 22 14:10:53 2016 +0100 Improve error message in deriving( Functor ) Fixes Trac #12163. Pretty simple. >--------------------------------------------------------------- cc92a446d6932cf06364529e71c866289088c59a compiler/typecheck/TcDeriv.hs | 13 ++++++++++--- testsuite/tests/generics/GenCannotDoRep0_0.stderr | 2 +- testsuite/tests/generics/GenCannotDoRep1_0.stderr | 10 +++++----- testsuite/tests/typecheck/should_fail/tcfail086.stderr | 10 +++++----- 4 files changed, 21 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 16aecdc..1a93687 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -1415,12 +1415,19 @@ cond_stdOK Nothing permissive (_, rep_tc) check_con :: DataCon -> Validity check_con con - | not (isVanillaDataCon con) - = NotValid (badCon con (text "has existentials or constraints in its type")) + | not (null eq_spec) + = bad "is a GADT" + | not (null ex_tvs) + = bad "has existential type variables in its type" + | not (null theta) + = bad "has constraints in its type" | not (permissive || all isTauTy (dataConOrigArgTys con)) - = NotValid (badCon con (text "has a higher-rank type")) + = bad "has a higher-rank type" | otherwise = IsValid + where + (_, ex_tvs, eq_spec, theta, _, _) = dataConFullSig con + bad msg = NotValid (badCon con (text msg)) no_cons_why :: TyCon -> SDoc no_cons_why rep_tc = quotes (pprSourceTyCon rep_tc) <+> diff --git a/testsuite/tests/generics/GenCannotDoRep0_0.stderr b/testsuite/tests/generics/GenCannotDoRep0_0.stderr index be649e0..02300d4 100644 --- a/testsuite/tests/generics/GenCannotDoRep0_0.stderr +++ b/testsuite/tests/generics/GenCannotDoRep0_0.stderr @@ -4,7 +4,7 @@ GenCannotDoRep0_0.hs:6:14: warning: GenCannotDoRep0_0.hs:13:45: error: • Can't make a derived instance of ‘Generic Dynamic’: - Constructor ‘Dynamic’ has existentials or constraints in its type + Constructor ‘Dynamic’ has existential type variables in its type Possible fix: use a standalone deriving declaration instead • In the data declaration for ‘Dynamic’ diff --git a/testsuite/tests/generics/GenCannotDoRep1_0.stderr b/testsuite/tests/generics/GenCannotDoRep1_0.stderr index 7764f24..1a576e6 100644 --- a/testsuite/tests/generics/GenCannotDoRep1_0.stderr +++ b/testsuite/tests/generics/GenCannotDoRep1_0.stderr @@ -1,6 +1,6 @@ -GenCannotDoRep1_0.hs:9:49: - Can't make a derived instance of ‘Generic1 Dynamic’: - Constructor ‘Dynamic’ has existentials or constraints in its type - Possible fix: use a standalone deriving declaration instead - In the data declaration for ‘Dynamic’ +GenCannotDoRep1_0.hs:9:49: error: + • Can't make a derived instance of ‘Generic1 Dynamic’: + Constructor ‘Dynamic’ has existential type variables in its type + Possible fix: use a standalone deriving declaration instead + • In the data declaration for ‘Dynamic’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail086.stderr b/testsuite/tests/typecheck/should_fail/tcfail086.stderr index f88fde1..0ea0b71 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail086.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail086.stderr @@ -1,6 +1,6 @@ -tcfail086.hs:6:38: - Can't make a derived instance of ‘Eq Ex’: - Constructor ‘Ex’ has existentials or constraints in its type - Possible fix: use a standalone deriving declaration instead - In the data declaration for ‘Ex’ +tcfail086.hs:6:38: error: + • Can't make a derived instance of ‘Eq Ex’: + Constructor ‘Ex’ has existential type variables in its type + Possible fix: use a standalone deriving declaration instead + • In the data declaration for ‘Ex’ From git at git.haskell.org Wed Jun 22 21:18:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 21:18:19 +0000 (UTC) Subject: [commit: ghc] master: Expand given superclasses more eagerly (ce97b72) Message-ID: <20160622211819.F29133A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ce97b7298d54bdfccd9dcf366a69c5617b4eb43f/ghc >--------------------------------------------------------------- commit ce97b7298d54bdfccd9dcf366a69c5617b4eb43f Author: Simon Peyton Jones Date: Wed Jun 22 14:17:58 2016 +0100 Expand given superclasses more eagerly This patch fixes Trac #12175, another delicate corner case of Note [Instance and Given overlap] in TcInteract. In #12175 we were not expanding given superclasses eagerly enough. It was easy to fix, and is actually rather neater than before. See Note [Eagerly expand given superclasses] in TcCanonical. The main change is to move the eager expansion of given superclasses to canClassNC. >--------------------------------------------------------------- ce97b7298d54bdfccd9dcf366a69c5617b4eb43f compiler/typecheck/TcCanonical.hs | 87 ++++++++++++++-------- compiler/typecheck/TcInteract.hs | 10 ++- compiler/typecheck/TcRnTypes.hs | 10 ++- compiler/typecheck/TcSMonad.hs | 2 +- compiler/typecheck/TcSimplify.hs | 12 +-- .../tests/indexed-types/should_compile/T12175.hs | 36 +++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 7 files changed, 113 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 ce97b7298d54bdfccd9dcf366a69c5617b4eb43f From git at git.haskell.org Wed Jun 22 21:18:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 21:18:22 +0000 (UTC) Subject: [commit: ghc] master: Remove unused arg to tcSuperClasses (a1b3359) Message-ID: <20160622211822.A20693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a1b3359636ebfdf3b65c21dc2ae5b5814c012630/ghc >--------------------------------------------------------------- commit a1b3359636ebfdf3b65c21dc2ae5b5814c012630 Author: Simon Peyton Jones Date: Wed Jun 22 14:12:08 2016 +0100 Remove unused arg to tcSuperClasses We don't need the FamInstEnvs argument any more. Just a tiny refactor. >--------------------------------------------------------------- a1b3359636ebfdf3b65c21dc2ae5b5814c012630 compiler/typecheck/TcInstDcls.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index 27ccd5a..511a9a6 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -782,10 +782,9 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds }) ; let dfun_ev_binds = TcEvBinds dfun_ev_binds_var ; ((sc_meth_ids, sc_meth_binds, sc_meth_implics), tclvl) <- pushTcLevelM $ - do { fam_envs <- tcGetFamInstEnvs - ; (sc_ids, sc_binds, sc_implics) + do { (sc_ids, sc_binds, sc_implics) <- tcSuperClasses dfun_id clas inst_tyvars dfun_ev_vars - inst_tys dfun_ev_binds fam_envs + inst_tys dfun_ev_binds sc_theta' -- Typecheck the methods @@ -958,7 +957,7 @@ Notice that -} tcSuperClasses :: DFunId -> Class -> [TcTyVar] -> [EvVar] -> [TcType] - -> TcEvBinds -> FamInstEnvs + -> TcEvBinds -> TcThetaType -> TcM ([EvVar], LHsBinds Id, Bag Implication) -- Make a new top-level function binding for each superclass, @@ -969,7 +968,7 @@ tcSuperClasses :: DFunId -> Class -> [TcTyVar] -> [EvVar] -> [TcType] -- See Note [Recursive superclasses] for why this is so hard! -- In effect, be build a special-purpose solver for the first step -- of solving each superclass constraint -tcSuperClasses dfun_id cls tyvars dfun_evs inst_tys dfun_ev_binds _fam_envs sc_theta +tcSuperClasses dfun_id cls tyvars dfun_evs inst_tys dfun_ev_binds sc_theta = do { (ids, binds, implics) <- mapAndUnzip3M tc_super (zip sc_theta [fIRST_TAG..]) ; return (ids, listToBag binds, listToBag implics) } where From simonpj at microsoft.com Wed Jun 22 21:24:05 2016 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Wed, 22 Jun 2016 21:24:05 +0000 Subject: [commit: ghc] master: Accept new (lower) allocations for T7257 (15641b0) In-Reply-To: <20160622210820.C04623A300@ghc.haskell.org> References: <20160622210820.C04623A300@ghc.haskell.org> Message-ID: Does anyone know what made T7257 better? Simon | -----Original Message----- | From: ghc-commits [mailto:ghc-commits-bounces at haskell.org] On Behalf Of | git at git.haskell.org | Sent: 22 June 2016 22:08 | To: ghc-commits at haskell.org | Subject: [commit: ghc] master: Accept new (lower) allocations for T7257 | (15641b0) | | Repository : ssh://git at git.haskell.org/ghc | | On branch : master | Link : | https://na01.safelinks.protection.outlook.com/?url=http%3a%2f%2fghc.hask | ell.org%2ftrac%2fghc%2fchangeset%2f15641b07f1d3ccb5f35b4f31539ecceb5fb38 | c17%2fghc&data=01%7c01%7csimonpj%40064d.mgd.microsoft.com%7c32fafc88b758 | 43148b2a08d39ae1ea3f%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=eLrMob | XyWHA691jI3t4pf0CbGybfrVqptmkpTDdtDI8%3d | | >--------------------------------------------------------------- | | commit 15641b07f1d3ccb5f35b4f31539ecceb5fb38c17 | Author: Simon Marlow | Date: Wed Jun 22 20:54:59 2016 +0100 | | Accept new (lower) allocations for T7257 | | | >--------------------------------------------------------------- | | 15641b07f1d3ccb5f35b4f31539ecceb5fb38c17 | testsuite/tests/perf/should_run/all.T | 3 ++- | 1 file changed, 2 insertions(+), 1 deletion(-) | | diff --git a/testsuite/tests/perf/should_run/all.T | b/testsuite/tests/perf/should_run/all.T | index caf4eff..3cb6f8e 100644 | --- a/testsuite/tests/perf/should_run/all.T | +++ b/testsuite/tests/perf/should_run/all.T | @@ -276,9 +276,10 @@ test('T7257', | [(wordsize(32), 989850664, 10), | # expected value: 1246287228 (i386/Linux) | # 2016-04-06: 989850664 (i386/Linux) no idea | what happened | - (wordsize(64), 1654893248, 5)]), | + (wordsize(64), 1414893248, 5)]), | # 2012-09-21: 1774893760 (amd64/Linux) | # 2015-11-03: 1654893248 (amd64/Linux) | + # 2016-06-22: 1414893248 (amd64/Linux, sizeExpr | fix) | stats_num_field('peak_megabytes_allocated', | [(wordsize(32), 217, 5), | # 2012-10-08: 217 (x86/Linux) | | _______________________________________________ | ghc-commits mailing list | ghc-commits at haskell.org | https://na01.safelinks.protection.outlook.com/?url=http%3a%2f%2fmail.has | kell.org%2fcgi-bin%2fmailman%2flistinfo%2fghc- | commits&data=01%7c01%7csimonpj%40064d.mgd.microsoft.com%7c32fafc88b75843 | 148b2a08d39ae1ea3f%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=RftvNpBH | H7bw53EdhgnsdV%2f6M2LNgFVB1t7gCwOTT7A%3d From git at git.haskell.org Wed Jun 22 21:25:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 22 Jun 2016 21:25:26 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #12163 (210a2e1) Message-ID: <20160622212526.436E63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/210a2e122ce3b7c56c780e4541b9f222abe7d2f7/ghc >--------------------------------------------------------------- commit 210a2e122ce3b7c56c780e4541b9f222abe7d2f7 Author: Simon Peyton Jones Date: Wed Jun 22 22:28:55 2016 +0100 Test Trac #12163 >--------------------------------------------------------------- 210a2e122ce3b7c56c780e4541b9f222abe7d2f7 testsuite/tests/deriving/should_fail/T12163.hs | 8 ++++++++ testsuite/tests/deriving/should_fail/T12163.stderr | 6 ++++++ testsuite/tests/deriving/should_fail/all.T | 2 +- 3 files changed, 15 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/deriving/should_fail/T12163.hs b/testsuite/tests/deriving/should_fail/T12163.hs new file mode 100644 index 0000000..862fdd0 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T12163.hs @@ -0,0 +1,8 @@ + {-# LANGUAGE DeriveFunctor #-} + {-# LANGUAGE GADTs #-} + +module T12163 where + +data T a b where + Mk :: Int -> b -> T Int b + deriving (Functor) diff --git a/testsuite/tests/deriving/should_fail/T12163.stderr b/testsuite/tests/deriving/should_fail/T12163.stderr new file mode 100644 index 0000000..708a1b0 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T12163.stderr @@ -0,0 +1,6 @@ + +T12163.hs:8:16: error: + • Can't make a derived instance of ‘Functor (T a)’: + Constructor ‘Mk’ is a GADT + Possible fix: use a standalone deriving declaration instead + • In the data declaration for ‘T’ diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T index e0c6e62..bcb410b 100644 --- a/testsuite/tests/deriving/should_fail/all.T +++ b/testsuite/tests/deriving/should_fail/all.T @@ -58,4 +58,4 @@ test('T9687', normal, compile_fail, ['']) test('T8984', normal, compile_fail, ['']) test('T9968a', normal, compile_fail, ['']) - +test('T12163', normal, compile_fail, ['']) From git at git.haskell.org Thu Jun 23 09:15:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 09:15:57 +0000 (UTC) Subject: [commit: ghc] master: Remove unused import (e556f76) Message-ID: <20160623091557.F1FC93A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e556f76875a28a97dd6618b8019bc11a1cc17b02/ghc >--------------------------------------------------------------- commit e556f76875a28a97dd6618b8019bc11a1cc17b02 Author: Simon Peyton Jones Date: Thu Jun 23 08:49:28 2016 +0100 Remove unused import >--------------------------------------------------------------- e556f76875a28a97dd6618b8019bc11a1cc17b02 compiler/hsSyn/PlaceHolder.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/hsSyn/PlaceHolder.hs b/compiler/hsSyn/PlaceHolder.hs index 7b3391d..2e195df 100644 --- a/compiler/hsSyn/PlaceHolder.hs +++ b/compiler/hsSyn/PlaceHolder.hs @@ -17,7 +17,6 @@ import ConLike (ConLike) import FieldLabel import SrcLoc (Located) import TcEvidence ( HsWrapper ) -import Outputable ( OutputableBndr ) import Data.Data hiding ( Fixity ) import BasicTypes (Fixity) From git at git.haskell.org Thu Jun 23 09:16:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 09:16:00 +0000 (UTC) Subject: [commit: ghc] master: Give lookupGRE_Name a better API (3e0af46) Message-ID: <20160623091600.DB90D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3e0af469c97d34bea92032d54d155afc65bd4b20/ghc >--------------------------------------------------------------- commit 3e0af469c97d34bea92032d54d155afc65bd4b20 Author: Simon Peyton Jones Date: Thu Jun 23 08:47:31 2016 +0100 Give lookupGRE_Name a better API lookupGRE_Name should return either zero or one GREs, never several. This is a consequence of INVARIANT 1 on GlobalRdrEnv. So it's better if it returns a Maybe; the panic on multiple results is put in one place, instead of being scattered or ignored. Just refactoring, no change in behaviour >--------------------------------------------------------------- 3e0af469c97d34bea92032d54d155afc65bd4b20 compiler/basicTypes/RdrName.hs | 16 +++++++++++----- compiler/main/InteractiveEval.hs | 3 +-- compiler/rename/RnEnv.hs | 2 +- compiler/rename/RnNames.hs | 4 ++-- compiler/rename/RnPat.hs | 7 ++++--- compiler/rename/RnSource.hs | 10 +++++----- compiler/typecheck/FamInst.hs | 2 +- compiler/typecheck/TcDeriv.hs | 2 +- compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcForeign.hs | 2 +- 10 files changed, 28 insertions(+), 22 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3e0af469c97d34bea92032d54d155afc65bd4b20 From git at git.haskell.org Thu Jun 23 09:16:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 09:16:03 +0000 (UTC) Subject: [commit: ghc] master: Narrow the warning for simplifiable constraints (643706e) Message-ID: <20160623091603.98C9D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/643706e44935cd15c2248e5345dadd3e9804688e/ghc >--------------------------------------------------------------- commit 643706e44935cd15c2248e5345dadd3e9804688e Author: Simon Peyton Jones Date: Thu Jun 23 08:50:45 2016 +0100 Narrow the warning for simplifiable constraints In Trac #11948 I added the warning -Wsimplifiable-class-constraints which warns if the class constraints in a type signature are simplifiable. But in fact the fragility it warns about only happens with NoMonoLocalBinds, so this patch switches off the warning if you have MonoLocalBinds (and suggests using it in the error message). See Note [Simplifiable given constraints] in TcValidity. >--------------------------------------------------------------- 643706e44935cd15c2248e5345dadd3e9804688e compiler/typecheck/TcValidity.hs | 20 ++++++++++++++------ .../should_compile/SomethingShowable.stderr | 4 ++-- 2 files changed, 16 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index fb1a567..4653eaa 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -863,6 +863,8 @@ check_class_pred env dflags ctxt pred cls tys -- See Note [Simplifiable given constraints] check_simplifiable_class_constraint + | xopt LangExt.MonoLocalBinds dflags + = return () | DataTyCtxt {} <- ctxt -- Don't do this check for the "stupid theta" = return () -- of a data type declaration | otherwise @@ -879,8 +881,8 @@ check_class_pred env dflags ctxt pred cls tys = vcat [ hang (text "The constraint" <+> quotes (ppr (tidyType env pred))) 2 (text "matches an instance declaration") , ppr match - , hang (text "This makes type inference very fragile;") - 2 (text "try simplifying it using the instance") ] + , hang (text "This makes type inference for inner bindings fragile;") + 2 (text "either use MonoLocalBinds, or simplify it using the instance") ] simplifiable_constraint_warn [] = pprPanic "check_class_pred" (ppr pred) {- Note [Simplifiable given constraints] @@ -888,10 +890,16 @@ check_class_pred env dflags ctxt pred cls tys A type signature like f :: Eq [(a,b)] => a -> b is very fragile, for reasons described at length in TcInteract -Note [Instance and Given overlap]. So this warning discourages uses -from writing simplifiable class constraints, at least unless the -top-level instance is explicitly declared as OVERLAPPABLE. -Trac #11948 provoked me to do this. +Note [Instance and Given overlap]. As that Note discusses, for the +most part the clever stuff in TcInteract means that we don't use a +top-level instance if a local Given might fire, so there is no +fragility. But if we /infer/ the type of a local let-binding, things +can go wrong (Trac #11948 is an example, discussed in the Note). + +So this warning is switched on only if we have NoMonoLocalBinds; in +that case the warning discourages uses from writing simplifiable class +constraints, at least unless the top-level instance is explicitly +declared as OVERLAPPABLE. -} ------------------------- diff --git a/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr b/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr index 40f15bf..88beccf 100644 --- a/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr +++ b/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr @@ -9,5 +9,5 @@ Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0, SomethingShowable.hs:5:1: warning: [-Wsimplifiable-class-constraints (in -Wdefault)] The constraint ‘Show Bool’ matches an instance declaration instance Show Bool -- Defined in ‘GHC.Show’ - This makes type inference very fragile; - try simplifying it using the instance + This makes type inference for inner bindings fragile; + either use MonoLocalBinds, or simplify it using the instance From git at git.haskell.org Thu Jun 23 09:16:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 09:16:06 +0000 (UTC) Subject: [commit: ghc] master: Narrow the use of record wildcards slightly (2f8cd14) Message-ID: <20160623091606.490B53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f8cd14fe909a377b3e084a4f2ded83a0e6d44dd/ghc >--------------------------------------------------------------- commit 2f8cd14fe909a377b3e084a4f2ded83a0e6d44dd Author: Simon Peyton Jones Date: Thu Jun 23 09:02:00 2016 +0100 Narrow the use of record wildcards slightly In reviewing the fix to Trac #12130 I found the wild-card fill-in code for ".." notation in record constructions hard to understand. It went to great contortions (including the find_tycon code) to allow data T = C { x, y :: Int } f x = C { .. } to expand to f x = C { x = x, y = y } where 'y' is an /imported function/! That seems way over the top for what record wildcards are supposed to do. So I have narrowed the record-wildcard expansion to include only /locally-bound/ variables; i.e. not top level, and certainly not imported. I don't think anyone is using record wildcards in this bizarre way, so I don't expect any fallout. Even if there is, you can easily initialise fields with eponymous but imported values by hand. An intermediate position would be to allow /local/ top-level definitions. But I doubt anyone is doing that either. Let's see if there's any fallout. It's a local change, easy to revert, so I've just gone ahead to save everyone's time. >--------------------------------------------------------------- 2f8cd14fe909a377b3e084a4f2ded83a0e6d44dd compiler/rename/RnPat.hs | 39 +++++++++++++++++++++++---------------- docs/users_guide/glasgow_exts.rst | 6 ++++-- 2 files changed, 27 insertions(+), 18 deletions(-) diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs index 8c78314..f44d492 100644 --- a/compiler/rename/RnPat.hs +++ b/compiler/rename/RnPat.hs @@ -588,23 +588,13 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) ; con_fields <- lookupConstructorFields con ; when (null con_fields) (addErr (badDotDotCon con)) ; let present_flds = map (occNameFS . rdrNameOcc) $ getFieldLbls flds - parent_tc = find_tycon rdr_env con -- For constructor uses (but not patterns) - -- the arg should be in scope (unqualified) - -- ignoring the record field itself + -- the arg should be in scope locally; + -- i.e. not top level or imported -- Eg. data R = R { x,y :: Int } -- f x = R { .. } -- Should expand to R {x=x}, not R{x=x,y=y} - arg_in_scope lbl - = rdr `elemLocalRdrEnv` lcl_env - || notNull [ gre | gre <- lookupGRE_RdrName rdr rdr_env - , case gre_par gre of - ParentIs p -> Just p /= parent_tc - FldParent p _ -> Just p /= parent_tc - PatternSynonym -> False - NoParent -> True ] - where - rdr = mkVarUnqual lbl + arg_in_scope lbl = mkVarUnqual lbl `elemLocalRdrEnv` lcl_env dot_dot_gres = [ (lbl, sel, head gres) | fl <- con_fields @@ -646,11 +636,12 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) | Just gre <- lookupGRE_Name env con_name = case gre_par gre of ParentIs p -> Just p - _ -> Nothing + _ -> Nothing -- Can happen if the con_name + -- is for a pattern synonym | otherwise = Nothing - -- This can happen if the datacon is not in scope - -- and we are in a TH splice (Trac #12130) + -- Data constructor not lexically in scope at all + -- See Note [Disambiguation and Template Haskell] dup_flds :: [[RdrName]] -- Each list represents a RdrName that occurred more than once @@ -659,6 +650,22 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) (_, dup_flds) = removeDups compare (getFieldLbls flds) +{- Note [Disambiguation and Template Haskell] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (Trac #12130) + module Foo where + import M + b = $(funny) + + module M(funny) where + data T = MkT { x :: Int } + funny :: Q Exp + funny = [| MkT { x = 3 } |] + +When we splice, neither T nor MkT are lexically in scope, so find_tycon will +fail. But there is no need for diambiguation anyway, so we just return Nothing +-} + rnHsRecUpdFields :: [LHsRecUpdField RdrName] -> RnM ([LHsRecUpdField Name], FreeVars) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 82b7d7c..95f1a0b 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -3053,8 +3053,10 @@ More details: unqualified). - In the case of expressions (but not patterns), the variable ``f`` - is in scope unqualified, apart from the binding of the record - selector itself. + is in scope unqualified, and is not imported or bound at top level. + For example, ``f`` can be bound by an enclosing pattern match or + let/where-binding. (The motivation here is that it should be + easy for the reader to figure out what the "``..``" expands to.) These rules restrict record wildcards to the situations in which the user could have written the expanded version. For example :: From git at git.haskell.org Thu Jun 23 13:48:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 13:48:29 +0000 (UTC) Subject: [commit: ghc] wip/rae: Very confusing typo in error message. (202f7ee) Message-ID: <20160623134829.9B1FD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/202f7eeda16892d829d5afbd38c0db0e14e61124/ghc >--------------------------------------------------------------- commit 202f7eeda16892d829d5afbd38c0db0e14e61124 Author: Richard Eisenberg Date: Fri Apr 22 15:29:10 2016 -0400 Very confusing typo in error message. >--------------------------------------------------------------- 202f7eeda16892d829d5afbd38c0db0e14e61124 compiler/typecheck/TcInteract.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 452db5f..f659b22 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -165,7 +165,7 @@ solveSimpleWanteds simples | n `intGtLimit` limit = failTcS (hang (text "solveSimpleWanteds: too many iterations" <+> parens (text "limit =" <+> ppr limit)) - 2 (vcat [ text "Set limit with -fsolver-iterations=n; n=0 for no limit" + 2 (vcat [ text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit" , text "Simples =" <+> ppr simples , text "WC =" <+> ppr wc ])) From git at git.haskell.org Thu Jun 23 13:48:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 13:48:33 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #11974 by adding more smarts to TcDefaults. (cdfd3cc) Message-ID: <20160623134833.57EBF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/cdfd3cca2408688bb8fde4927f5521b527665601/ghc >--------------------------------------------------------------- commit cdfd3cca2408688bb8fde4927f5521b527665601 Author: Richard Eisenberg Date: Fri Apr 22 22:28:35 2016 -0400 Fix #11974 by adding more smarts to TcDefaults. Test cases: typecheck/should_compile/T11974 typecheck/should_fail/T11974b >--------------------------------------------------------------- cdfd3cca2408688bb8fde4927f5521b527665601 compiler/prelude/PrelNames.hs | 12 +++++++ compiler/typecheck/TcDefaults.hs | 37 ++++++++++++---------- compiler/typecheck/TcSimplify.hs | 2 +- testsuite/tests/typecheck/should_compile/T11974.hs | 5 +++ testsuite/tests/typecheck/should_compile/all.T | 1 + testsuite/tests/typecheck/should_fail/T11974b.hs | 7 ++++ .../tests/typecheck/should_fail/T11974b.stderr | 15 +++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 8 files changed, 62 insertions(+), 18 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc cdfd3cca2408688bb8fde4927f5521b527665601 From git at git.haskell.org Thu Jun 23 13:48:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 13:48:37 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #10963 and #11975 by adding new cmds to GHCi. (61a4a3e) Message-ID: <20160623134837.1D0513A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/61a4a3eb883a55066172ca4c07abb7e225a5e96c/ghc >--------------------------------------------------------------- commit 61a4a3eb883a55066172ca4c07abb7e225a5e96c Author: Richard Eisenberg Date: Fri Apr 22 22:39:17 2016 -0400 Fix #10963 and #11975 by adding new cmds to GHCi. See the user's guide entry or the Note [TcRnExprMode] in TcRnDriver. Test cases: ghci/scripts/T{10963,11975} >--------------------------------------------------------------- 61a4a3eb883a55066172ca4c07abb7e225a5e96c compiler/main/GHC.hs | 2 +- compiler/main/HscMain.hs | 8 +-- compiler/main/InteractiveEval.hs | 8 +-- compiler/typecheck/TcBinds.hs | 9 +-- compiler/typecheck/TcExpr.hs | 11 ++-- compiler/typecheck/TcPatSyn.hs | 3 +- compiler/typecheck/TcRnDriver.hs | 101 ++++++++++++++++++++++------- compiler/typecheck/TcSimplify.hs | 93 +++++++++++++++++--------- docs/users_guide/ghci.rst | 82 +++++++++++++++++++++-- ghc/GHCi/UI.hs | 12 +++- ghc/GHCi/UI/Info.hs | 2 +- testsuite/tests/ghc-api/T8639_api.hs | 2 +- testsuite/tests/ghci/scripts/T10963.script | 7 ++ testsuite/tests/ghci/scripts/T10963.stderr | 12 ++++ testsuite/tests/ghci/scripts/T10963.stdout | 4 ++ testsuite/tests/ghci/scripts/T11975.script | 9 +++ testsuite/tests/ghci/scripts/T11975.stdout | 15 +++++ testsuite/tests/ghci/scripts/all.T | 2 + 18 files changed, 300 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 61a4a3eb883a55066172ca4c07abb7e225a5e96c From git at git.haskell.org Thu Jun 23 13:48:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 13:48:39 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Fix #10963 and #11975 by adding new cmds to GHCi. (61a4a3e) Message-ID: <20160623134839.401083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: 348f2db Make the Ord Module independent of Unique order (2nd try) 15641b0 Accept new (lower) allocations for T7257 7e7aeab Comments only cc92a44 Improve error message in deriving( Functor ) a1b3359 Remove unused arg to tcSuperClasses ce97b72 Expand given superclasses more eagerly 210a2e1 Test Trac #12163 3e0af46 Give lookupGRE_Name a better API e556f76 Remove unused import 643706e Narrow the warning for simplifiable constraints 2f8cd14 Narrow the use of record wildcards slightly 202f7ee Very confusing typo in error message. cdfd3cc Fix #11974 by adding more smarts to TcDefaults. 61a4a3e Fix #10963 and #11975 by adding new cmds to GHCi. From git at git.haskell.org Thu Jun 23 14:05:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 14:05:43 +0000 (UTC) Subject: [commit: ghc] master: Have Core linter accept programs using StaticPointers and -fhpc. (7fc20b0) Message-ID: <20160623140543.601CA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7fc20b02b20c97209b97f0e36d34a4ef40f537a4/ghc >--------------------------------------------------------------- commit 7fc20b02b20c97209b97f0e36d34a4ef40f537a4 Author: Facundo Domínguez Date: Wed Jun 22 14:09:57 2016 -0300 Have Core linter accept programs using StaticPointers and -fhpc. Summary: This patch uses collectArgsTicks instead of collectArgs to test that StaticPtr only occurs at the top of RHSs of top-level expressions. Ticks introduced by -fhpc would interfere otherwise. Test Plan: ./validate Reviewers: thomie, austin, goldfire, bgamari, simonpj Reviewed By: simonpj Differential Revision: https://phabricator.haskell.org/D2355 GHC Trac Issues: #12207 >--------------------------------------------------------------- 7fc20b02b20c97209b97f0e36d34a4ef40f537a4 compiler/coreSyn/CoreLint.hs | 2 +- testsuite/tests/typecheck/should_compile/all.T | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 06e45830..e7acafc 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -552,7 +552,7 @@ lintRhs :: CoreExpr -> LintM OutType -- but produce errors otherwise. lintRhs rhs | (binders0, rhs') <- collectTyBinders rhs - , (fun@(Var b), args) <- collectArgs rhs' + , (fun@(Var b), args, _) <- collectArgsTicks (const True) rhs' , Just con <- isDataConId_maybe b , dataConName con == staticPtrDataConName , length args == 5 diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 0f222aa..7e3c33f 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -421,8 +421,8 @@ test('T8474', normal, compile, ['']) test('T8563', normal, compile, ['']) test('T8565', normal, compile, ['']) test('T8644', normal, compile, ['']) -test('TcStaticPointers01', expect_broken_for(12207, ['hpc']), compile, ['']) -test('TcStaticPointers02', expect_broken_for(12207, ['hpc']), compile, ['']) +test('TcStaticPointers01', normal, compile, ['']) +test('TcStaticPointers02', normal, compile, ['']) test('T8762', normal, compile, ['']) test('MutRec', normal, compile, ['']) test('T8856', normal, compile, ['']) From git at git.haskell.org Thu Jun 23 14:56:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 14:56:17 +0000 (UTC) Subject: [commit: ghc] master: Provide Uniquable version of SCC (35d1564) Message-ID: <20160623145617.E9A9F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/35d1564cea2e611a4fecf24f09eff83f8a55af1c/ghc >--------------------------------------------------------------- commit 35d1564cea2e611a4fecf24f09eff83f8a55af1c Author: Bartosz Nitka Date: Tue Jun 14 03:28:30 2016 -0700 Provide Uniquable version of SCC We want to remove the `Ord Unique` instance because there's no way to implement it in deterministic way and it's too easy to use by accident. We sometimes compute SCC for datatypes whose Ord instance is implemented in terms of Unique. The Ord constraint on SCC is just an artifact of some internal data structures. We can have an alternative implementation with a data structure that uses Uniquable instead. This does exactly that and I'm pleased that I didn't have to introduce any duplication to do that. Test Plan: ./validate I looked at performance tests and it's a tiny bit better. Reviewers: bgamari, simonmar, ezyang, austin, goldfire Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2359 GHC Trac Issues: #4012 >--------------------------------------------------------------- 35d1564cea2e611a4fecf24f09eff83f8a55af1c compiler/basicTypes/NameEnv.hs | 2 +- compiler/cmm/CmmBuildInfoTables.hs | 2 +- compiler/codeGen/StgCmmUtils.hs | 2 +- compiler/iface/MkIface.hs | 2 +- compiler/main/GhcMake.hs | 5 +- compiler/nativeGen/AsmCodeGen.hs | 2 +- .../nativeGen/RegAlloc/Linear/JoinToTargets.hs | 4 +- compiler/nativeGen/RegAlloc/Liveness.hs | 6 +- compiler/rename/RnSource.hs | 5 +- compiler/simplCore/OccurAnal.hs | 10 +- compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcEvidence.hs | 2 +- compiler/typecheck/TcSMonad.hs | 2 +- compiler/typecheck/TcTyDecls.hs | 5 +- compiler/types/Type.hs | 2 +- compiler/utils/Digraph.hs | 127 +++++++++++++++++---- compiler/vectorise/Vectorise/Type/Classify.hs | 2 +- testsuite/tests/determinism/determinism001.hs | 2 +- 18 files changed, 136 insertions(+), 48 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 35d1564cea2e611a4fecf24f09eff83f8a55af1c From git at git.haskell.org Thu Jun 23 15:43:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 15:43:04 +0000 (UTC) Subject: [commit: ghc] master: Remove Ord TyCon (bb74021) Message-ID: <20160623154304.621043A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bb7402187819a489d933643f694d819b63ae25c2/ghc >--------------------------------------------------------------- commit bb7402187819a489d933643f694d819b63ae25c2 Author: Bartosz Nitka Date: Thu Jun 23 06:24:47 2016 -0700 Remove Ord TyCon After 35d1564cea2e: Provide Uniquable version of SCC we can remove this. We want to remove it because when used it can introduce unnecessary nondeterminism. GHC Trac: #4012 >--------------------------------------------------------------- bb7402187819a489d933643f694d819b63ae25c2 compiler/types/TyCon.hs | 7 ------- 1 file changed, 7 deletions(-) diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index a275caa..ad83746 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -2140,13 +2140,6 @@ instance Eq TyCon where a == b = getUnique a == getUnique b a /= b = getUnique a /= getUnique b -instance Ord TyCon where - a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False } - a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False } - a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True } - a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True } - compare a b = getUnique a `compare` getUnique b - instance Uniquable TyCon where getUnique tc = tyConUnique tc From git at git.haskell.org Thu Jun 23 19:14:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 19:14:30 +0000 (UTC) Subject: [commit: ghc] master: Very confusing typo in error message. (7f5d560) Message-ID: <20160623191430.98ABF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7f5d560377458f3ec328b9fc60a875d9b91e978e/ghc >--------------------------------------------------------------- commit 7f5d560377458f3ec328b9fc60a875d9b91e978e Author: Richard Eisenberg Date: Fri Apr 22 15:29:10 2016 -0400 Very confusing typo in error message. >--------------------------------------------------------------- 7f5d560377458f3ec328b9fc60a875d9b91e978e compiler/typecheck/TcInteract.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 452db5f..f659b22 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -165,7 +165,7 @@ solveSimpleWanteds simples | n `intGtLimit` limit = failTcS (hang (text "solveSimpleWanteds: too many iterations" <+> parens (text "limit =" <+> ppr limit)) - 2 (vcat [ text "Set limit with -fsolver-iterations=n; n=0 for no limit" + 2 (vcat [ text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit" , text "Simples =" <+> ppr simples , text "WC =" <+> ppr wc ])) From git at git.haskell.org Thu Jun 23 19:14:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 19:14:34 +0000 (UTC) Subject: [commit: ghc] master: Fix #11974 by adding a more smarts to TcDefaults. (9a34bf1) Message-ID: <20160623191434.5AF693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9a34bf1985035858ece043bf38b47b6ff4b88efb/ghc >--------------------------------------------------------------- commit 9a34bf1985035858ece043bf38b47b6ff4b88efb Author: Richard Eisenberg Date: Fri Apr 22 22:28:35 2016 -0400 Fix #11974 by adding a more smarts to TcDefaults. Test cases: typecheck/should_compile/T11974 typecheck/should_fail/T11974b >--------------------------------------------------------------- 9a34bf1985035858ece043bf38b47b6ff4b88efb compiler/prelude/PrelNames.hs | 12 +++++++ compiler/typecheck/TcDefaults.hs | 37 ++++++++++++---------- compiler/typecheck/TcSimplify.hs | 2 +- testsuite/tests/typecheck/should_compile/T11974.hs | 5 +++ testsuite/tests/typecheck/should_compile/all.T | 1 + testsuite/tests/typecheck/should_fail/T11974b.hs | 7 ++++ .../tests/typecheck/should_fail/T11974b.stderr | 15 +++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 8 files changed, 62 insertions(+), 18 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9a34bf1985035858ece043bf38b47b6ff4b88efb From git at git.haskell.org Thu Jun 23 19:14:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 19:14:38 +0000 (UTC) Subject: [commit: ghc] master: Fix #10963 and #11975 by adding new cmds to GHCi. (8035d1a) Message-ID: <20160623191438.1F2063A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8035d1a5dc7290e8d3d61446ee4861e0b460214e/ghc >--------------------------------------------------------------- commit 8035d1a5dc7290e8d3d61446ee4861e0b460214e Author: Richard Eisenberg Date: Fri Apr 22 22:39:17 2016 -0400 Fix #10963 and #11975 by adding new cmds to GHCi. See the user's guide entry or the Note [TcRnExprMode] in TcRnDriver. Test cases: ghci/scripts/T{10963,11975} >--------------------------------------------------------------- 8035d1a5dc7290e8d3d61446ee4861e0b460214e compiler/main/GHC.hs | 2 +- compiler/main/HscMain.hs | 8 +-- compiler/main/InteractiveEval.hs | 8 +-- compiler/typecheck/TcBinds.hs | 9 +-- compiler/typecheck/TcExpr.hs | 11 ++-- compiler/typecheck/TcPatSyn.hs | 3 +- compiler/typecheck/TcRnDriver.hs | 101 ++++++++++++++++++++++------- compiler/typecheck/TcSimplify.hs | 93 +++++++++++++++++--------- docs/users_guide/ghci.rst | 82 +++++++++++++++++++++-- ghc/GHCi/UI.hs | 12 +++- ghc/GHCi/UI/Info.hs | 2 +- testsuite/tests/ghc-api/T8639_api.hs | 2 +- testsuite/tests/ghci/scripts/T10963.script | 7 ++ testsuite/tests/ghci/scripts/T10963.stderr | 12 ++++ testsuite/tests/ghci/scripts/T10963.stdout | 4 ++ testsuite/tests/ghci/scripts/T11975.script | 9 +++ testsuite/tests/ghci/scripts/T11975.stdout | 15 +++++ testsuite/tests/ghci/scripts/all.T | 2 + 18 files changed, 300 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 8035d1a5dc7290e8d3d61446ee4861e0b460214e From git at git.haskell.org Thu Jun 23 19:21:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 19:21:20 +0000 (UTC) Subject: [commit: ghc] master: Release notes for #11975 and #10963 (4ae950f) Message-ID: <20160623192120.0A69D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4ae950fbd83dea6170e765631af009e3c4f38a94/ghc >--------------------------------------------------------------- commit 4ae950fbd83dea6170e765631af009e3c4f38a94 Author: Richard Eisenberg Date: Thu Jun 23 15:24:42 2016 -0400 Release notes for #11975 and #10963 >--------------------------------------------------------------- 4ae950fbd83dea6170e765631af009e3c4f38a94 docs/users_guide/8.0.2-notes.rst | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst index 8466b49..1972e6d 100644 --- a/docs/users_guide/8.0.2-notes.rst +++ b/docs/users_guide/8.0.2-notes.rst @@ -21,3 +21,22 @@ Language - :ghc-flag:`-XStaticPointers` now allows the body of the ``static`` form to refer to closed local bindings. For instance, this is now permitted: ``f = static x where x = 'a'``. + +TODO FIXME Heading title +~~~~~~~~~~~~~~~~~~~~~~~~ + +- GHCi now supports two new commands. :ghci-cmd:`:type` ``+d`` performs + defaulting on the type before reporting it to the user, and + :ghci-cmd:`:type` ``+v`` refrains from instantiating any variables before + reporting, which is useful in concert with :ghc-flag:`-XTypeApplications`. + + .. code-block:: none + + *X> :type +d length + length :: [a] -> Int + + *X> :set -fprint-explicit-foralls + *X> :type length + length :: forall {a} {t :: * -> *}. Foldable t => t a -> Int + *X> :type +v length + length :: forall (t :: * -> *). Foldable t => forall a. t a -> Int From git at git.haskell.org Thu Jun 23 20:30:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 20:30:37 +0000 (UTC) Subject: [commit: ghc] wip/rae: s/Invisible/Inferred/g s/Visible/Required/g (fb8053a) Message-ID: <20160623203037.31B373A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/fb8053aae24a7243bd6055ab8f1da47137479ef5/ghc >--------------------------------------------------------------- commit fb8053aae24a7243bd6055ab8f1da47137479ef5 Author: Richard Eisenberg Date: Thu Jun 23 16:26:29 2016 -0400 s/Invisible/Inferred/g s/Visible/Required/g This renames VisibilityFlag from > data VisibilityFlag = Visible | Specified | Invisible to > data ArgFlag = Required | Specified | Inferred The old name was quite confusing, because both Specified and Invisible were invisible! The new names are hopefully clearer. >--------------------------------------------------------------- fb8053aae24a7243bd6055ab8f1da47137479ef5 compiler/basicTypes/DataCon.hs | 8 ++-- compiler/basicTypes/Var.hs | 83 +++++++++++++++++++------------------ compiler/iface/BuildTyCl.hs | 20 ++++----- compiler/iface/IfaceType.hs | 18 ++++---- compiler/iface/TcIface.hs | 4 +- compiler/prelude/TysWiredIn.hs | 2 +- compiler/prelude/TysWiredIn.hs-boot | 4 +- compiler/typecheck/Inst.hs | 6 +-- compiler/typecheck/TcBinds.hs | 8 ++-- compiler/typecheck/TcCanonical.hs | 4 +- compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcExpr.hs | 4 +- compiler/typecheck/TcGenDeriv.hs | 4 +- compiler/typecheck/TcHsType.hs | 6 +-- compiler/typecheck/TcPatSyn.hs | 8 ++-- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 2 +- compiler/typecheck/TcSigs.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 4 +- compiler/typecheck/TcTyDecls.hs | 15 +++---- compiler/typecheck/TcType.hs | 58 ++++++++++++++------------ compiler/types/Coercion.hs | 2 +- compiler/types/TyCoRep.hs | 80 +++++++++++++++++------------------ compiler/types/TyCon.hs | 24 +++++------ compiler/types/Type.hs | 30 +++++++------- 25 files changed, 203 insertions(+), 197 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 fb8053aae24a7243bd6055ab8f1da47137479ef5 From git at git.haskell.org Thu Jun 23 20:30:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 23 Jun 2016 20:30:39 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: s/Invisible/Inferred/g s/Visible/Required/g (fb8053a) Message-ID: <20160623203039.5271D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: 7fc20b0 Have Core linter accept programs using StaticPointers and -fhpc. 35d1564 Provide Uniquable version of SCC bb74021 Remove Ord TyCon 7f5d560 Very confusing typo in error message. 9a34bf1 Fix #11974 by adding a more smarts to TcDefaults. 8035d1a Fix #10963 and #11975 by adding new cmds to GHCi. 4ae950f Release notes for #11975 and #10963 fb8053a s/Invisible/Inferred/g s/Visible/Required/g From git at git.haskell.org Fri Jun 24 08:59:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 08:59:12 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: do not copy .hi/.o files to testdir (#12112) (df9611e) Message-ID: <20160624085912.3AB533A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/df9611ee5c056066fe88fe3ef2f64382cec8b741/ghc >--------------------------------------------------------------- commit df9611ee5c056066fe88fe3ef2f64382cec8b741 Author: Thomas Miedema Date: Fri Jun 24 10:41:48 2016 +0200 Testsuite: do not copy .hi/.o files to testdir (#12112) >--------------------------------------------------------------- df9611ee5c056066fe88fe3ef2f64382cec8b741 testsuite/driver/testlib.py | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 0fc764b..41e0fce 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -674,6 +674,8 @@ def get_package_cache_timestamp(): except: return 0.0 +do_not_copy = ('.hi', '.o', '.dyn_hi', '.dyn_o') # 12112 + def test_common_work (name, opts, func, args): try: t.total_tests = t.total_tests+1 @@ -729,9 +731,10 @@ def test_common_work (name, opts, func, args): # specify all other files that their test depends on (but # this seems to be necessary for only about 10% of all # tests). - files = set((f for f in os.listdir(opts.srcdir) - if f.startswith(name) and - not f.endswith(testdir_suffix))) + files = set(f for f in os.listdir(opts.srcdir) + if f.startswith(name) and not f == name and + not f.endswith(testdir_suffix) and + not os.path.splitext(f)[1] in do_not_copy) for filename in (opts.extra_files + extra_src_files.get(name, [])): if filename.startswith('/'): framework_fail(name, 'whole-test', From git at git.haskell.org Fri Jun 24 10:00:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 10:00:38 +0000 (UTC) Subject: [commit: ghc] master: Improve typechecking of instance defaults (d2958bd) Message-ID: <20160624100038.4C6233A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d2958bd08a049b61941f078e51809c7e63bc3354/ghc >--------------------------------------------------------------- commit d2958bd08a049b61941f078e51809c7e63bc3354 Author: Simon Peyton Jones Date: Thu Jun 23 14:51:22 2016 +0100 Improve typechecking of instance defaults In an instance declaration when you don't specify the code for a method, GHC fills in from the default binding in the class. The type of the default method can legitmiately be ambiguous --- see Note [Default methods in instances] in TcInstDcls --- so typechecking it can be tricky. Trac #12220 showed that although we were dealing with that ambiguity for /vanilla/ default methods, we were not doing so for /generic/ default methods. Moreover we were dealing with it clumsily, by generating post-typechecked code. This patch fixes the bug AND deletes code! We now use the same code path for both vanilla and generic default methods; and generate /pre-typechecked/ code in both cases. The key trick is that we can use Visible Type Application to deal with the ambiguity, which wasn't possible before. Hooray. There is a small hit to performance in compiler/perf/T1969 which consists of nothing BUT instance declarations with several default methods to fill, which we now have to typecheck. The actual hit is from 724 -> 756 or 4% in that extreme example. Real world programs have vastly fewer instance decls. >--------------------------------------------------------------- d2958bd08a049b61941f078e51809c7e63bc3354 compiler/coreSyn/TrieMap.hs | 3 +- compiler/iface/IfaceType.hs | 3 - compiler/typecheck/TcClassDcl.hs | 19 +-- compiler/typecheck/TcInstDcls.hs | 134 +++++++++------------ testsuite/tests/generics/GShow/GShow.hs | 3 +- testsuite/tests/generics/GenDerivOutput.stderr | 6 + .../tests/generics/T10604/T10604_deriving.stderr | 6 + testsuite/tests/generics/T12220.hs | 37 ++++++ testsuite/tests/generics/all.T | 1 + testsuite/tests/perf/compiler/all.T | 3 +- 10 files changed, 125 insertions(+), 90 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 d2958bd08a049b61941f078e51809c7e63bc3354 From git at git.haskell.org Fri Jun 24 10:00:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 10:00:41 +0000 (UTC) Subject: [commit: ghc] master: Comments around invisibility (c871ce4) Message-ID: <20160624100041.03D9F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c871ce4903312402fc7f90089f61977c420e2c60/ghc >--------------------------------------------------------------- commit c871ce4903312402fc7f90089f61977c420e2c60 Author: Simon Peyton Jones Date: Thu Jun 23 14:54:24 2016 +0100 Comments around invisibility Very minor >--------------------------------------------------------------- c871ce4903312402fc7f90089f61977c420e2c60 compiler/iface/IfaceType.hs | 2 +- compiler/types/TyCoRep.hs | 1 - compiler/types/Type.hs | 4 +++- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 5f30042..f541431 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -156,7 +156,7 @@ type IfaceForAllBndr = TyVarBndr IfaceTvBndr VisibilityFlag data IfaceTcArgs = ITC_Nil | ITC_Vis IfaceType IfaceTcArgs -- "Vis" means show when pretty-printing - | ITC_Invis IfaceKind IfaceTcArgs -- "Invis" means don't show when pretty-printin + | ITC_Invis IfaceKind IfaceTcArgs -- "Invis" means don't show when pretty-printing -- except with -fprint-explicit-kinds -- Encodes type constructors, kind constructors, diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 6b1b341..4d11aeb 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -2752,7 +2752,6 @@ pprTvBndrs tvs = sep (map pprTvBndr tvs) -- | Render the ... in @(forall ... .)@ or @(forall ... ->)@. -- Returns both the list of not-yet-rendered binders and the doc. --- No anonymous binders here! ppr_tv_bndrs :: [TyVarBinder] -> VisibilityFlag -- ^ visibility of the first binder in the list -> ([TyVarBinder], SDoc) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index c67b4ef..b9e489a 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1347,7 +1347,9 @@ filterOutInvisibleTyVars :: TyCon -> [TyVar] -> [TyVar] filterOutInvisibleTyVars tc tvs = snd $ partitionInvisibles tc mkTyVarTy tvs -- | Given a tycon and a list of things (which correspond to arguments), --- partitions the things into the invisible ones and the visible ones. +-- partitions the things into +-- Invisible or Specified ones and +-- Visible ones -- The callback function is necessary for this scenario: -- -- > T :: forall k. k -> k From git at git.haskell.org Fri Jun 24 10:00:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 10:00:44 +0000 (UTC) Subject: [commit: ghc] master: Fix renamer panic (393928d) Message-ID: <20160624100044.369163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/393928db9fc35ef8bdeb241c051224a6c4bdf749/ghc >--------------------------------------------------------------- commit 393928db9fc35ef8bdeb241c051224a6c4bdf749 Author: Simon Peyton Jones Date: Fri Jun 24 08:59:20 2016 +0100 Fix renamer panic This patch fixes Trac #12216 and #12127. The 'combine' function in 'imp_occ_env' in RnNames.filterImports checked for an empty field-selector list, which was (a) unnecessary and (b) wrong. I've elaborated the comments. This does NOT fix #11959 which is related but not the same (it concerns bundling of pattern synonyms). >--------------------------------------------------------------- 393928db9fc35ef8bdeb241c051224a6c4bdf749 compiler/rename/RnNames.hs | 22 +++++++++++++++------- testsuite/tests/rename/should_compile/T12127.hs | 3 +++ .../should_compile/{DodgyA.hs => T12127a.hs} | 6 +++--- testsuite/tests/rename/should_compile/all.T | 4 ++++ 4 files changed, 25 insertions(+), 10 deletions(-) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 3803f58..ab27b6a 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -743,8 +743,15 @@ The situation is made more complicated by associated types. E.g. instance C Bool where { data T Int = T3 } Then M's export_avails are (recall the AvailTC invariant from Avails.hs) C(C,T), T(T,T1,T2,T3) -Notice that T appears *twice*, once as a child and once as a parent. -From this we construct the imp_occ_env +Notice that T appears *twice*, once as a child and once as a parent. From +this list we construt a raw list including + T -> (T, T( T1, T2, T3 ), Nothing) + T -> (C, C( C, T ), Nothing) +and we combine these (in function 'combine' in 'imp_occ_env' in +'filterImports') to get + T -> (T, T(T,T1,T2,T3), Just C) + +So the overall imp_occ_env is C -> (C, C(C,T), Nothing) T -> (T, T(T,T1,T2,T3), Just C) T1 -> (T1, T(T,T1,T2,T3), Nothing) -- similarly T2,T3 @@ -797,12 +804,13 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) imp_occ_env = mkOccEnv_C combine [ (nameOccName n, (n, a, Nothing)) | a <- all_avails, n <- availNames a] where - -- See example in Note [Dealing with imports] - -- 'combine' is only called for associated types which appear twice - -- in the all_avails. In the example, we combine + -- See Note [Dealing with imports] + -- 'combine' is only called for associated data types which appear + -- twice in the all_avails. In the example, we combine -- T(T,T1,T2,T3) and C(C,T) to give (T, T(T,T1,T2,T3), Just C) - combine (name1, a1@(AvailTC p1 _ []), mp1) - (name2, a2@(AvailTC p2 _ []), mp2) + -- NB: the AvailTC can have fields as well as data constructors (Trac #12127) + combine (name1, a1@(AvailTC p1 _ _), mp1) + (name2, a2@(AvailTC p2 _ _), mp2) = ASSERT( name1 == name2 && isNothing mp1 && isNothing mp2 ) if p1 == name1 then (name1, a1, Just p2) else (name1, a2, Just p1) diff --git a/testsuite/tests/rename/should_compile/T12127.hs b/testsuite/tests/rename/should_compile/T12127.hs new file mode 100644 index 0000000..749e406 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T12127.hs @@ -0,0 +1,3 @@ +module T12127 where + +import T12127a( T(..), C(..) ) diff --git a/testsuite/tests/rename/should_compile/DodgyA.hs b/testsuite/tests/rename/should_compile/T12127a.hs similarity index 50% copy from testsuite/tests/rename/should_compile/DodgyA.hs copy to testsuite/tests/rename/should_compile/T12127a.hs index 39cb3ec..53c1b7e 100644 --- a/testsuite/tests/rename/should_compile/DodgyA.hs +++ b/testsuite/tests/rename/should_compile/T12127a.hs @@ -1,9 +1,9 @@ {-# LANGUAGE TypeFamilies #-} -module DodgyA(C(..), X(..)) where +module T12127a where class C a where - data X a + data T a instance C Int where - data X Int = X1 Bool + data T Int = MkT { x, y :: Int } diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T index a15146b..90b1d60 100644 --- a/testsuite/tests/rename/should_compile/all.T +++ b/testsuite/tests/rename/should_compile/all.T @@ -238,3 +238,7 @@ test('T11662', [extra_clean(['T11662_A.hi', 'T11662_A.o'])], multimod_compile, ['T11662', '-v0']) +test('T12127', + [extra_clean(['T12127a.hi', 'T12127a.o'])], + multimod_compile, + ['T12127', '-v0']) From git at git.haskell.org Fri Jun 24 10:00:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 10:00:46 +0000 (UTC) Subject: [commit: ghc] master: Remove bogus comment on ForAllTy (f86a337) Message-ID: <20160624100046.E393F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f86a33792459bea26fe27ae1086aa161bd046a0a/ghc >--------------------------------------------------------------- commit f86a33792459bea26fe27ae1086aa161bd046a0a Author: Simon Peyton Jones Date: Fri Jun 24 09:02:49 2016 +0100 Remove bogus comment on ForAllTy >--------------------------------------------------------------- f86a33792459bea26fe27ae1086aa161bd046a0a compiler/types/TyCoRep.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 4d11aeb..e82ba9d 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -276,8 +276,6 @@ data Type | ForAllTy {-# UNPACK #-} !TyVarBinder Type -- ^ A Π type. - -- This includes arrow types, constructed with - -- @ForAllTy (Anon ...)@. See also Note [TyBinder]. | FunTy Type Type -- ^ t1 -> t2 Very common, so an important special case From git at git.haskell.org Fri Jun 24 10:00:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 10:00:49 +0000 (UTC) Subject: [commit: ghc] master: Improve pretty-printing of Avail (bb84ee4) Message-ID: <20160624100049.A0CA03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bb84ee44e30eeedce37ce6b09684747e2c659836/ghc >--------------------------------------------------------------- commit bb84ee44e30eeedce37ce6b09684747e2c659836 Author: Simon Peyton Jones Date: Fri Jun 24 09:03:01 2016 +0100 Improve pretty-printing of Avail >--------------------------------------------------------------- bb84ee44e30eeedce37ce6b09684747e2c659836 compiler/basicTypes/Avail.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/basicTypes/Avail.hs b/compiler/basicTypes/Avail.hs index 9595abc..4dc6cb6 100644 --- a/compiler/basicTypes/Avail.hs +++ b/compiler/basicTypes/Avail.hs @@ -171,8 +171,11 @@ instance Outputable AvailInfo where ppr = pprAvail pprAvail :: AvailInfo -> SDoc -pprAvail (Avail _ n) = ppr n -pprAvail (AvailTC n ns fs) = ppr n <> braces (hsep (punctuate comma (map ppr ns ++ map (ppr . flLabel) fs))) +pprAvail (Avail _ n) + = ppr n +pprAvail (AvailTC n ns fs) + = ppr n <> braces (sep [ fsep (punctuate comma (map ppr ns)) <> semi + , fsep (punctuate comma (map (ppr . flLabel) fs))]) instance Binary AvailInfo where put_ bh (Avail b aa) = do From git at git.haskell.org Fri Jun 24 10:25:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 10:25:42 +0000 (UTC) Subject: [commit: ghc] master: Implement ReifyConStrictness for -fexternal-interpreter (#12219) (12c4449) Message-ID: <20160624102542.1A2B23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/12c44496c9b55b82e0bd659be88f3082f6bfaf9c/ghc >--------------------------------------------------------------- commit 12c44496c9b55b82e0bd659be88f3082f6bfaf9c Author: Simon Marlow Date: Wed Jun 22 13:46:27 2016 +0100 Implement ReifyConStrictness for -fexternal-interpreter (#12219) Fixes T10697_decided_1.run T10697_decided_1 [exit code non-0] (ext-interp) T10697_decided_2.run T10697_decided_2 [exit code non-0] (ext-interp) T10697_decided_3.run T10697_decided_3 [exit code non-0] (ext-interp) >--------------------------------------------------------------- 12c44496c9b55b82e0bd659be88f3082f6bfaf9c compiler/typecheck/TcSplice.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index e0fa1cb..bb9cfb3 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -1053,6 +1053,7 @@ handleTHMessage msg = case msg of ReifyAnnotations lookup tyrep -> wrapTHResult $ (map B.pack <$> getAnnotationsByTypeRep lookup tyrep) ReifyModule m -> wrapTHResult $ TH.qReifyModule m + ReifyConStrictness nm -> wrapTHResult $ TH.qReifyConStrictness nm AddDependentFile f -> wrapTHResult $ TH.qAddDependentFile f AddTopDecls decs -> wrapTHResult $ TH.qAddTopDecls decs IsExtEnabled ext -> wrapTHResult $ TH.qIsExtEnabled ext From git at git.haskell.org Fri Jun 24 10:25:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 10:25:44 +0000 (UTC) Subject: [commit: ghc] master: Fix T8761 (#12219, #12077) (0bab375) Message-ID: <20160624102544.B64673A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0bab375adbb362850d97e0a487fb51139284b680/ghc >--------------------------------------------------------------- commit 0bab375adbb362850d97e0a487fb51139284b680 Author: Simon Marlow Date: Thu Jun 23 18:20:06 2016 +0100 Fix T8761 (#12219, #12077) >--------------------------------------------------------------- 0bab375adbb362850d97e0a487fb51139284b680 testsuite/tests/th/T8761.hs | 6 ++++++ testsuite/tests/th/T8761.stderr | 21 +++++++++++---------- testsuite/tests/th/all.T | 3 +-- 3 files changed, 18 insertions(+), 12 deletions(-) diff --git a/testsuite/tests/th/T8761.hs b/testsuite/tests/th/T8761.hs index 4578822..c0c96b9 100644 --- a/testsuite/tests/th/T8761.hs +++ b/testsuite/tests/th/T8761.hs @@ -6,6 +6,7 @@ module T8761 where import Control.Monad import Language.Haskell.TH +import System.IO data Ex where MkEx :: forall a. a -> Ex data ExProv where MkExProv :: forall a. (Show a) => a -> ExProv @@ -108,4 +109,9 @@ do infos <- mapM reify [ 'P, 'Pe, 'Pu, 'Pue, 'Pur, 'Purp , 'Pure, 'Purep, 'Pep, 'Pup, 'Puep ] mapM_ (runIO . putStrLn . pprint) infos + runIO $ hFlush stdout + -- GHC does not guarantee to do this after TH code. In particular + -- when the output is going to a file, and we're using GHC with + -- the runtime linker or with -fexternal-interpreter, stdout will + -- not get flushed. [d| theAnswerIs = 42 |] diff --git a/testsuite/tests/th/T8761.stderr b/testsuite/tests/th/T8761.stderr index 8d34756..2ecf495 100644 --- a/testsuite/tests/th/T8761.stderr +++ b/testsuite/tests/th/T8761.stderr @@ -1,8 +1,4 @@ -pattern Q1 x1_0 x2_1 x3_2 <- ((x1_0, x2_1), [x3_2], _, _) -pattern x1_0 Q2 x2_1 = ((x1_0, x2_1)) -pattern Q3 {qx3, qy3, qz3} <- ((qx3, qy3), [qz3]) where - Q3 qx3 qy3 qz3 = ((qx3, qy3), [qz3]) -T8761.hs:(15,1)-(38,13): Splicing declarations +T8761.hs:(16,1)-(39,13): Splicing declarations do { [qx1, qy1, qz1] <- mapM (\ i -> newName $ "x" ++ show i) [1, 2, 3]; let nm1 = mkName "Q1" @@ -36,7 +32,7 @@ T8761.hs:(15,1)-(38,13): Splicing declarations pattern x1 `Q2` x2 = ((x1, x2)) pattern Q3{qx3, qy3, qz3} <- ((qx3, qy3), [qz3]) where Q3 qx3 qy3 qz3 = ((qx3, qy3), [qz3]) -T8761.hs:(41,1)-(45,29): Splicing declarations +T8761.hs:(42,1)-(46,29): Splicing declarations [d| pattern P1 x y z <- ((x, y), [z], _, _) pattern P2 x y z = ((x, y), [z]) pattern P3 x y z <- ((x, y), [z]) where @@ -46,7 +42,7 @@ T8761.hs:(41,1)-(45,29): Splicing declarations pattern P2 x y z = ((x, y), [z]) pattern P3 x y z <- ((x, y), [z]) where P3 x y z = ((x, y), [z]) -T8761.hs:(48,1)-(52,21): Splicing declarations +T8761.hs:(49,1)-(53,21): Splicing declarations [d| pattern x :*: y <- ((x, _), [y]) pattern x :+: y = (x, y) pattern x :~: y <- (x, y) where @@ -56,7 +52,7 @@ T8761.hs:(48,1)-(52,21): Splicing declarations pattern x :+: y = (x, y) pattern x :~: y <- (x, y) where (:~:) x y = (x, y) -T8761.hs:(55,1)-(61,23): Splicing declarations +T8761.hs:(56,1)-(62,23): Splicing declarations [d| pattern R1{x1, y1} <- ((x1, _), [y1]) getX1 = x1 ((1, 2), [3]) getY1 = y1 ((1, 2), [3]) @@ -70,7 +66,7 @@ T8761.hs:(55,1)-(61,23): Splicing declarations pattern R2{x2, y2} = (x2, [y2]) pattern R3{x3, y3} <- (x3, [y3]) where R3 x y = (x, [y]) -T8761.hs:(70,1)-(104,39): Splicing declarations +T8761.hs:(71,1)-(105,39): Splicing declarations [d| pattern P :: Bool pattern P <- True pattern Pe :: forall a. a -> Ex @@ -123,6 +119,10 @@ T8761.hs:(70,1)-(104,39): Splicing declarations pattern Pup x <- MkUnivProv x pattern Puep :: forall a. forall b. Show b => a -> b -> (ExProv, a) pattern Puep x y <- (MkExProv y, x) +pattern Q1 x1_0 x2_1 x3_2 <- ((x1_0, x2_1), [x3_2], _, _) +pattern x1_0 Q2 x2_1 = ((x1_0, x2_1)) +pattern Q3 {qx3, qy3, qz3} <- ((qx3, qy3), [qz3]) where + Q3 qx3 qy3 qz3 = ((qx3, qy3), [qz3]) pattern T8761.P :: GHC.Types.Bool pattern T8761.Pe :: () => forall (a0_0 :: *) . a0_0 -> T8761.Ex pattern T8761.Pu :: forall (a0_0 :: *) . a0_0 -> a0_0 @@ -147,12 +147,13 @@ pattern T8761.Pup :: forall (a0_0 :: *) . () => GHC.Show.Show a0_0 => a0_0 -> T8761.UnivProv a0_0 pattern T8761.Puep :: forall (a0_0 :: *) . () => forall (b0_1 :: *) . GHC.Show.Show b0_1 => a0_0 -> b0_1 -> (T8761.ExProv, a0_0) -T8761.hs:(107,1)-(111,25): Splicing declarations +T8761.hs:(108,1)-(117,25): Splicing declarations do { infos <- mapM reify ['P, 'Pe, 'Pu, 'Pue, 'Pur, 'Purp, 'Pure, 'Purep, 'Pep, 'Pup, 'Puep]; mapM_ (runIO . putStrLn . pprint) infos; + runIO $ hFlush stdout; [d| theAnswerIs = 42 |] } ======> theAnswerIs = 42 diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 77be4b7..637fecc 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -406,7 +406,6 @@ test('T11809', normal, compile, ['-v0']) test('T11797', normal, compile, ['-v0 -dsuppress-uniques']) test('T11941', normal, compile_fail, ['-v0']) test('T11484', normal, compile, ['-v0']) -test('T8761', unless(ghc_dynamic(), expect_broken(12077)), compile, - ['-v0 -ddump-splices -dsuppress-uniques']) +test('T8761', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T12130', extra_clean(['T12130a.hi','T12130a.o']), multimod_compile, ['T12130', '-v0 ' + config.ghc_th_way_flags]) From git at git.haskell.org Fri Jun 24 10:25:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 10:25:47 +0000 (UTC) Subject: [commit: ghc] master: Run all TH tests with -fexternal-interpreter (#12219) (d2006d0) Message-ID: <20160624102547.651363A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d2006d050e7a9111c0c448d6262f8994ef5761b7/ghc >--------------------------------------------------------------- commit d2006d050e7a9111c0c448d6262f8994ef5761b7 Author: Simon Marlow Date: Wed Jun 22 13:47:36 2016 +0100 Run all TH tests with -fexternal-interpreter (#12219) >--------------------------------------------------------------- d2006d050e7a9111c0c448d6262f8994ef5761b7 testsuite/config/ghc | 5 ++++- testsuite/tests/th/all.T | 17 ++++++++++------- 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/testsuite/config/ghc b/testsuite/config/ghc index aa6b047..68d4a64 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -29,7 +29,8 @@ config.other_ways = ['prof', 'normal_h', 'llvm', 'debugllvm', 'profllvm', 'profoptllvm', 'profthreadedllvm', 'debug', - 'ghci-ext'] + 'ghci-ext', + 'ext-interp'] if (ghc_with_native_codegen == 1): config.compile_ways.append('optasm') @@ -96,6 +97,7 @@ config.way_flags = { 'profoptllvm' : ['-O', '-prof', '-static', '-fprof-auto', '-fllvm'], 'profthreadedllvm' : ['-O', '-prof', '-static', '-fprof-auto', '-threaded', '-fllvm'], 'ghci-ext' : ['--interactive', '-v0', '-ignore-dot-ghci', '-fno-ghci-history', '-fexternal-interpreter', '+RTS', '-I0.1', '-RTS'], + 'ext-interp' : ['-fexternal-interpreter'], } config.way_rts_flags = { @@ -130,6 +132,7 @@ config.way_rts_flags = { 'profoptllvm' : ['-hc', '-p'], 'profthreadedllvm' : ['-p'], 'ghci-ext' : [], + 'ext-interp' : [], } # Useful classes of ways that can be used with only_ways(), omit_ways() and diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index aa87241..77be4b7 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -8,7 +8,9 @@ def f(name, opts): opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell' setTestOpts(f) setTestOpts(req_interp) -setTestOpts(only_ways(['normal','ghci'])) +# TH should work with -fexternal-interpreter too +setTestOpts(extra_ways(['ext-interp'])) +setTestOpts(only_ways(['normal','ghci','ext-interp'])) test('TH_mkName', normal, compile, ['-v0']) test('TH_1tuple', normal, compile_fail, ['-v0']) @@ -129,7 +131,7 @@ test('TH_scopedTvs', normal, compile, ['-v0']) test('TH_runIO', normal, compile_fail, ['-v0']) -test('TH_ghci1', normal, ghci_script, ['TH_ghci1.script']) +test('TH_ghci1', only_ways(['ghci']), ghci_script, ['TH_ghci1.script']) test('TH_linePragma', normal, compile_fail, ['-v0']) @@ -259,7 +261,8 @@ test('T7064', test('T7092', extra_clean(['T7092a.hi','T7092a.o']), multimod_compile, ['T7092', '-v0 ' + config.ghc_th_way_flags]) test('T7276', normal, compile_fail, ['-v0']) -test('T7276a', combined_output, ghci_script, ['T7276a.script']) +test('T7276a', [ only_ways(['ghci']), combined_output ], + ghci_script, ['T7276a.script']) test('TH_TyInstWhere1', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_TyInstWhere2', normal, compile, ['-v0']) @@ -272,7 +275,7 @@ test('T7532', multimod_compile, ['T7532', '-v0 ' + config.ghc_th_way_flags]) test('T2222', normal, compile, ['-v0']) -test('T1849', normal, ghci_script, ['T1849.script']) +test('T1849', only_ways(['ghci']), ghci_script, ['T1849.script']) test('T7681', normal, compile, ['-v0']) test('T7910', normal, compile_and_run, ['-v0']) @@ -317,7 +320,7 @@ test('T8577', extra_clean(['T8577a.hi', 'T8577a.o']), multimod_compile_fail, ['T8577', '-v0 ' + config.ghc_th_way_flags]) -test('T8625', normal, ghci_script, ['T8625.script']) +test('T8625', only_ways(['ghci']), ghci_script, ['T8625.script']) test('TH_StaticPointers', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], compile_and_run, ['']) test('TH_StaticPointers02', [], compile_fail, ['']) @@ -348,8 +351,8 @@ test('T1476b', normal, compile, ['-v0']) test('T8031', normal, compile, ['-v0']) test('T8624', normal, run_command, ['$MAKE -s --no-print-directory T8624']) test('TH_Lift', normal, compile, ['-v0']) -test('T10047', normal, ghci_script, ['T10047.script']) -test('T10019', normal, ghci_script, ['T10019.script']) +test('T10047', only_ways(['ghci']), ghci_script, ['T10047.script']) +test('T10019', only_ways(['ghci']), ghci_script, ['T10019.script']) test('T10267', extra_clean(['T10267a.hi', 'T10267a.o']), multimod_compile_fail, ['T10267', '-dsuppress-uniques -v0 ' + config.ghc_th_way_flags]) From git at git.haskell.org Fri Jun 24 10:25:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 10:25:50 +0000 (UTC) Subject: [commit: ghc] master: Remote GHCi: separate out message types (bdb0d24) Message-ID: <20160624102550.2384C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bdb0d24be9c83b08fd3f4b870a17f6be31a24b1b/ghc >--------------------------------------------------------------- commit bdb0d24be9c83b08fd3f4b870a17f6be31a24b1b Author: Simon Marlow Date: Wed Jun 22 18:13:48 2016 +0100 Remote GHCi: separate out message types Summary: From a suggestion by @goldfire: clean up the message types, so that rather than one Message type with all the messages, we have a separate THMessage type for messages sent back to GHC during TH execution. At the same time I also removed the QDone/QFailed/QException messages into their own type, and made the result type of RunTH more accurate. Test Plan: validate Reviewers: goldfire, ezyang, austin, niteria, bgamari, erikd Subscribers: thomie, goldfire Differential Revision: https://phabricator.haskell.org/D2356 >--------------------------------------------------------------- bdb0d24be9c83b08fd3f4b870a17f6be31a24b1b compiler/typecheck/TcSplice.hs | 30 ++++--- iserv/src/Main.hs | 12 +-- libraries/ghci/GHCi/Message.hs | 173 ++++++++++++++++++++++++----------------- libraries/ghci/GHCi/TH.hs | 10 +-- 4 files changed, 129 insertions(+), 96 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 bdb0d24be9c83b08fd3f4b870a17f6be31a24b1b From git at git.haskell.org Fri Jun 24 10:25:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 10:25:52 +0000 (UTC) Subject: [commit: ghc] master: Remote GHCi: comments only (eb73219) Message-ID: <20160624102552.D02D53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eb732195f6c005c769232a79e5d17e3d768603d1/ghc >--------------------------------------------------------------- commit eb732195f6c005c769232a79e5d17e3d768603d1 Author: Simon Marlow Date: Thu Jun 23 09:22:32 2016 +0100 Remote GHCi: comments only Summary: Add more Notes and signposts across the codebase to help navigation. Test Plan: validate Reviewers: goldfire, simonpj, austin, ezyang, hvr, bgamari, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2358 >--------------------------------------------------------------- eb732195f6c005c769232a79e5d17e3d768603d1 compiler/ghci/GHCi.hs | 7 +++ compiler/typecheck/TcSplice.hs | 16 +++++-- iserv/src/Main.hs | 11 +++++ libraries/ghci/GHCi/CreateBCO.hs | 1 + libraries/ghci/GHCi/Message.hs | 17 ++++++- libraries/ghci/GHCi/RemoteTypes.hs | 8 ++++ libraries/ghci/GHCi/Run.hs | 5 +- libraries/ghci/GHCi/TH.hs | 98 +++++++++++++++++++++++++++++++++++++- 8 files changed, 156 insertions(+), 7 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc eb732195f6c005c769232a79e5d17e3d768603d1 From git at git.haskell.org Fri Jun 24 10:27:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 10:27:48 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #12229 (dadd8b8) Message-ID: <20160624102748.394533A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dadd8b84a6ba157d54d6f84be247f9dbf06e1611/ghc >--------------------------------------------------------------- commit dadd8b84a6ba157d54d6f84be247f9dbf06e1611 Author: Simon Peyton Jones Date: Fri Jun 24 11:31:32 2016 +0100 Test Trac #12229 >--------------------------------------------------------------- dadd8b84a6ba157d54d6f84be247f9dbf06e1611 testsuite/tests/rename/should_fail/T12229.hs | 11 +++++++++++ testsuite/tests/rename/should_fail/T12229.stderr | 5 +++++ testsuite/tests/rename/should_fail/all.T | 1 + 3 files changed, 17 insertions(+) diff --git a/testsuite/tests/rename/should_fail/T12229.hs b/testsuite/tests/rename/should_fail/T12229.hs new file mode 100644 index 0000000..5f5bea4 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T12229.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE RecordWildCards #-} + +module T12229 where + +data T = MkT { x, pi :: Float } + +f x = MkT { .. } -- 'pi' is not initialised, because + -- there is no local binding + +g x pi = MkT { .. } -- 'pi' is initialised + diff --git a/testsuite/tests/rename/should_fail/T12229.stderr b/testsuite/tests/rename/should_fail/T12229.stderr new file mode 100644 index 0000000..4fc8678 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T12229.stderr @@ -0,0 +1,5 @@ + +T12229.hs:7:7: warning: [-Wmissing-fields (in -Wdefault)] + • Fields of ‘MkT’ not initialised: pi + • In the expression: MkT {..} + In an equation for ‘f’: f x = MkT {..} diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index 78b80e8..3ddfea2 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -138,3 +138,4 @@ test('T10781', normal, compile_fail, ['']) test('T11071', normal, compile_fail, ['']) test('T11071a', normal, compile_fail, ['']) test('T11663', normal, compile_fail, ['']) +test('T12229', normal, compile, ['']) From git at git.haskell.org Fri Jun 24 12:59:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 12:59:38 +0000 (UTC) Subject: [commit: ghc] wip/rae: s/Invisible/Inferred/g s/Visible/Required/g (1b4cab5) Message-ID: <20160624125938.EE5763A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/1b4cab521b42be652d505e90d40bf85e6c852c4b/ghc >--------------------------------------------------------------- commit 1b4cab521b42be652d505e90d40bf85e6c852c4b Author: Richard Eisenberg Date: Thu Jun 23 16:26:29 2016 -0400 s/Invisible/Inferred/g s/Visible/Required/g This renames VisibilityFlag from > data VisibilityFlag = Visible | Specified | Invisible to > data ArgFlag = Required | Specified | Inferred The old name was quite confusing, because both Specified and Invisible were invisible! The new names are hopefully clearer. >--------------------------------------------------------------- 1b4cab521b42be652d505e90d40bf85e6c852c4b compiler/basicTypes/DataCon.hs | 8 ++-- compiler/basicTypes/Var.hs | 83 +++++++++++++++++++------------------ compiler/iface/BuildTyCl.hs | 20 ++++----- compiler/iface/IfaceType.hs | 18 ++++---- compiler/iface/TcIface.hs | 4 +- compiler/prelude/TysWiredIn.hs | 2 +- compiler/prelude/TysWiredIn.hs-boot | 4 +- compiler/typecheck/Inst.hs | 6 +-- compiler/typecheck/TcBinds.hs | 8 ++-- compiler/typecheck/TcCanonical.hs | 4 +- compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcExpr.hs | 4 +- compiler/typecheck/TcGenDeriv.hs | 4 +- compiler/typecheck/TcHsType.hs | 6 +-- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 8 ++-- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 2 +- compiler/typecheck/TcSigs.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 4 +- compiler/typecheck/TcTyDecls.hs | 15 +++---- compiler/typecheck/TcType.hs | 58 ++++++++++++++------------ compiler/types/Coercion.hs | 2 +- compiler/types/TyCoRep.hs | 80 +++++++++++++++++------------------ compiler/types/TyCon.hs | 24 +++++------ compiler/types/Type.hs | 34 +++++++-------- 26 files changed, 206 insertions(+), 200 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 1b4cab521b42be652d505e90d40bf85e6c852c4b From git at git.haskell.org Fri Jun 24 12:59:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 12:59:41 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: s/Invisible/Inferred/g s/Visible/Required/g (1b4cab5) Message-ID: <20160624125941.1C1E73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: df9611e Testsuite: do not copy .hi/.o files to testdir (#12112) d2958bd Improve typechecking of instance defaults c871ce4 Comments around invisibility 393928d Fix renamer panic f86a337 Remove bogus comment on ForAllTy bb84ee4 Improve pretty-printing of Avail 12c4449 Implement ReifyConStrictness for -fexternal-interpreter (#12219) d2006d0 Run all TH tests with -fexternal-interpreter (#12219) bdb0d24 Remote GHCi: separate out message types eb73219 Remote GHCi: comments only 0bab375 Fix T8761 (#12219, #12077) dadd8b8 Test Trac #12229 1b4cab5 s/Invisible/Inferred/g s/Visible/Required/g From git at git.haskell.org Fri Jun 24 18:44:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 18:44:43 +0000 (UTC) Subject: [commit: ghc] master: Fix typo in Data.Bitraverse Haddocks (9bc2233) Message-ID: <20160624184443.DF4883A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9bc22330dea6a89109b5537ad52ea9669384a49e/ghc >--------------------------------------------------------------- commit 9bc22330dea6a89109b5537ad52ea9669384a49e Author: Ryan Scott Date: Fri Jun 24 14:40:42 2016 -0400 Fix typo in Data.Bitraverse Haddocks >--------------------------------------------------------------- 9bc22330dea6a89109b5537ad52ea9669384a49e libraries/base/Data/Bitraversable.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Data/Bitraversable.hs b/libraries/base/Data/Bitraversable.hs index 7e64bb5..42e9635 100644 --- a/libraries/base/Data/Bitraversable.hs +++ b/libraries/base/Data/Bitraversable.hs @@ -130,7 +130,7 @@ bimapM = bitraverse -- | Sequences all the actions in a structure, building a new structure with -- the same shape using the results of the actions. For a version that ignores --- the results, see 'sequence_'. +-- the results, see 'bisequence_'. -- -- @'bisequence' ≡ 'bitraverse' 'id' 'id'@ -- From git at git.haskell.org Fri Jun 24 18:44:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 18:44:46 +0000 (UTC) Subject: [commit: ghc] master: Clean up outdated comments in template-haskell changelog (31b5806) Message-ID: <20160624184446.AC26A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/31b58065baf967fc8e82b058179f028cbb56dfe2/ghc >--------------------------------------------------------------- commit 31b58065baf967fc8e82b058179f028cbb56dfe2 Author: Ryan Scott Date: Fri Jun 24 14:42:26 2016 -0400 Clean up outdated comments in template-haskell changelog * Replaced 2.11's *TBA* with *May 2016* * Removed an outdated TODO comment * Removed lines which incorrectly stated that some strictness-related functions had been removed (they have been deprecated instead) >--------------------------------------------------------------- 31b58065baf967fc8e82b058179f028cbb56dfe2 libraries/template-haskell/changelog.md | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md index e746cb54..5cd8ad8 100644 --- a/libraries/template-haskell/changelog.md +++ b/libraries/template-haskell/changelog.md @@ -1,6 +1,6 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) -## 2.11.0.0 *TBA* +## 2.11.0.0 *May 2016* * Bundled with GHC 8.0.1 @@ -30,9 +30,8 @@ in Haskell source code (`SourceUnpackedness` and `SourceStrictness`, as well as `Bang`), and one for strictness information after a constructor is compiled (`DecidedStrictness`). `Strict`, `StrictType` and `VarStrictType` - have been deprecated in favor of `Bang`, `BangType` and `VarBangType`, and - three functions (`isStrict`, `isLazy`, and `unpack`) were removed because - they no longer serve any use in this new design. (#10697) + have been deprecated in favor of `Bang`, `BangType` and `VarBangType`. + (#10697) * Add `reifyConStrictness` to query a data constructor's `DecidedStrictness` values for its fields (#10697) @@ -45,8 +44,6 @@ * Add `MonadFail Q` instance for GHC 8.0 and later (#11661) - * TODO: document API changes and important bugfixes - * Add support for OVERLAP(S/PED/PING) pragmas on instances From git at git.haskell.org Fri Jun 24 18:44:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 18:44:49 +0000 (UTC) Subject: [commit: ghc] master: Add template-haskell changelog note for #8761 (a33b498) Message-ID: <20160624184449.A8BF23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a33b498d5f648a576dac6d219115866f05721196/ghc >--------------------------------------------------------------- commit a33b498d5f648a576dac6d219115866f05721196 Author: Ryan Scott Date: Fri Jun 24 14:48:09 2016 -0400 Add template-haskell changelog note for #8761 >--------------------------------------------------------------- a33b498d5f648a576dac6d219115866f05721196 libraries/template-haskell/changelog.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md index 5cd8ad8..e9084e2 100644 --- a/libraries/template-haskell/changelog.md +++ b/libraries/template-haskell/changelog.md @@ -1,5 +1,13 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) +## next *TBA* + * Bundled with GHC *TBA* + + * Add support for pattern synonyms. This introduces one new constructor to + `Info` (`PatSynI`), two new constructors to `Dec` (`PatSynD` and + `PatSynSigD`), and two new data types (`PatSynDir` and `PatSynArgs`), + among other changes. (#8761) + ## 2.11.0.0 *May 2016* * Bundled with GHC 8.0.1 From git at git.haskell.org Fri Jun 24 23:18:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 23:18:47 +0000 (UTC) Subject: [commit: ghc] wip/rae: s/Invisible/Inferred/g s/Visible/Required/g (2b534ca) Message-ID: <20160624231847.B6DC13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/2b534ca98351ce9ef7f342fd51a9bb25c0e3f0a8/ghc >--------------------------------------------------------------- commit 2b534ca98351ce9ef7f342fd51a9bb25c0e3f0a8 Author: Richard Eisenberg Date: Thu Jun 23 16:26:29 2016 -0400 s/Invisible/Inferred/g s/Visible/Required/g This renames VisibilityFlag from > data VisibilityFlag = Visible | Specified | Invisible to > data ArgFlag = Required | Specified | Inferred The old name was quite confusing, because both Specified and Invisible were invisible! The new names are hopefully clearer. >--------------------------------------------------------------- 2b534ca98351ce9ef7f342fd51a9bb25c0e3f0a8 compiler/basicTypes/DataCon.hs | 8 ++-- compiler/basicTypes/Var.hs | 83 +++++++++++++++++++------------------ compiler/iface/BuildTyCl.hs | 20 ++++----- compiler/iface/IfaceType.hs | 18 ++++---- compiler/iface/TcIface.hs | 4 +- compiler/prelude/TysWiredIn.hs | 2 +- compiler/prelude/TysWiredIn.hs-boot | 4 +- compiler/typecheck/Inst.hs | 6 +-- compiler/typecheck/TcBinds.hs | 8 ++-- compiler/typecheck/TcCanonical.hs | 4 +- compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcExpr.hs | 4 +- compiler/typecheck/TcGenDeriv.hs | 4 +- compiler/typecheck/TcHsType.hs | 6 +-- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 8 ++-- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 2 +- compiler/typecheck/TcSigs.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 4 +- compiler/typecheck/TcTyDecls.hs | 15 +++---- compiler/typecheck/TcType.hs | 58 ++++++++++++++------------ compiler/types/Coercion.hs | 2 +- compiler/types/TyCoRep.hs | 80 +++++++++++++++++------------------ compiler/types/TyCon.hs | 24 +++++------ compiler/types/Type.hs | 34 +++++++-------- 26 files changed, 206 insertions(+), 200 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 2b534ca98351ce9ef7f342fd51a9bb25c0e3f0a8 From git at git.haskell.org Fri Jun 24 23:23:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 24 Jun 2016 23:23:41 +0000 (UTC) Subject: [commit: ghc] wip/rae: Refactor tcInferArgs and add comments. (dfd3738) Message-ID: <20160624232341.863D63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/dfd3738506a3fb598ffe17d0980a2c595ff847c6/ghc >--------------------------------------------------------------- commit dfd3738506a3fb598ffe17d0980a2c595ff847c6 Author: Richard Eisenberg Date: Fri Jun 24 19:25:07 2016 -0400 Refactor tcInferArgs and add comments. This removes an unnecessary loop looking for invisible binders and tries to clarify what the very closely-related functions tcInferArgs, tc_infer_args, tcInferApps all do. >--------------------------------------------------------------- dfd3738506a3fb598ffe17d0980a2c595ff847c6 compiler/typecheck/Inst.hs | 2 +- compiler/typecheck/TcHsType.hs | 71 ++++++++++++++++++++---------------------- compiler/types/TyCoRep.hs | 8 ++++- compiler/types/Type.hs | 17 +++++++++- 4 files changed, 57 insertions(+), 41 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc dfd3738506a3fb598ffe17d0980a2c595ff847c6 From git at git.haskell.org Sat Jun 25 13:30:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 25 Jun 2016 13:30:22 +0000 (UTC) Subject: [commit: ghc] master: s/Invisible/Inferred/g s/Visible/Required/g (5fdb854) Message-ID: <20160625133022.72F8F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5fdb854cbad734ed8113ea23485d834156b49df1/ghc >--------------------------------------------------------------- commit 5fdb854cbad734ed8113ea23485d834156b49df1 Author: Richard Eisenberg Date: Thu Jun 23 16:26:29 2016 -0400 s/Invisible/Inferred/g s/Visible/Required/g This renames VisibilityFlag from > data VisibilityFlag = Visible | Specified | Invisible to > data ArgFlag = Required | Specified | Inferred The old name was quite confusing, because both Specified and Invisible were invisible! The new names are hopefully clearer. >--------------------------------------------------------------- 5fdb854cbad734ed8113ea23485d834156b49df1 compiler/basicTypes/DataCon.hs | 8 ++-- compiler/basicTypes/Var.hs | 83 +++++++++++++++++++------------------ compiler/iface/BuildTyCl.hs | 20 ++++----- compiler/iface/IfaceType.hs | 18 ++++---- compiler/iface/TcIface.hs | 4 +- compiler/prelude/TysWiredIn.hs | 2 +- compiler/prelude/TysWiredIn.hs-boot | 4 +- compiler/typecheck/Inst.hs | 6 +-- compiler/typecheck/TcBinds.hs | 8 ++-- compiler/typecheck/TcCanonical.hs | 4 +- compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcExpr.hs | 4 +- compiler/typecheck/TcGenDeriv.hs | 4 +- compiler/typecheck/TcHsType.hs | 6 +-- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 8 ++-- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 2 +- compiler/typecheck/TcSigs.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 4 +- compiler/typecheck/TcTyDecls.hs | 15 +++---- compiler/typecheck/TcType.hs | 58 ++++++++++++++------------ compiler/types/Coercion.hs | 2 +- compiler/types/TyCoRep.hs | 80 +++++++++++++++++------------------ compiler/types/TyCon.hs | 24 +++++------ compiler/types/Type.hs | 34 +++++++-------- 26 files changed, 206 insertions(+), 200 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 5fdb854cbad734ed8113ea23485d834156b49df1 From git at git.haskell.org Sat Jun 25 13:30:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 25 Jun 2016 13:30:25 +0000 (UTC) Subject: [commit: ghc] master: Refactor tcInferArgs and add comments. (4cc5a39) Message-ID: <20160625133025.2B69A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4cc5a39ec79af7dcc4a5ac96823c704c34c5c202/ghc >--------------------------------------------------------------- commit 4cc5a39ec79af7dcc4a5ac96823c704c34c5c202 Author: Richard Eisenberg Date: Fri Jun 24 19:25:07 2016 -0400 Refactor tcInferArgs and add comments. This removes an unnecessary loop looking for invisible binders and tries to clarify what the very closely-related functions tcInferArgs, tc_infer_args, tcInferApps all do. >--------------------------------------------------------------- 4cc5a39ec79af7dcc4a5ac96823c704c34c5c202 compiler/typecheck/Inst.hs | 2 +- compiler/typecheck/TcHsType.hs | 71 ++++++++++++++++++++---------------------- compiler/types/TyCoRep.hs | 8 ++++- compiler/types/Type.hs | 17 +++++++++- 4 files changed, 57 insertions(+), 41 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4cc5a39ec79af7dcc4a5ac96823c704c34c5c202 From git at git.haskell.org Sat Jun 25 16:07:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 25 Jun 2016 16:07:48 +0000 (UTC) Subject: [commit: ghc] master: Allow building static libs. (8c1cedd) Message-ID: <20160625160748.EAB463A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8c1ceddd50158f79f9ff103f8f34be9856d4da1d/ghc >--------------------------------------------------------------- commit 8c1ceddd50158f79f9ff103f8f34be9856d4da1d Author: Moritz Angermann Date: Sat Jun 25 17:07:57 2016 +0100 Allow building static libs. Summary: Commit 90538d86af579595987826cd893828d6f379f35a, seems to have broken static linking. The introduction of `argFixup` in `runLink` rearranges libs, and considers anything with an `-l` prefix or `.a` suffix a lib, which fails for libs that are just being linked together (e.g. `-o lib.a`). The proposed solution explicitly checks for the existance of the `-o` flag. Reviewers: rwbarton, erikd, Phyx, bgamari, austin Reviewed By: Phyx Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2362 >--------------------------------------------------------------- 8c1ceddd50158f79f9ff103f8f34be9856d4da1d compiler/main/SysTools.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index c86935e..6cdb07e 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -928,6 +928,8 @@ runLink dflags args = do This functions moves libraries on the link all the way back but keeps the order amongst them the same. -} argFixup [] r = [] ++ r + -- retain any lib in "-o" position. + argFixup (o@(Option "-o"):o'@(FileOption _ _):xs) r = o:o':argFixup xs r argFixup (o@(Option opt):xs) r = if testLib opt then argFixup xs (r ++ [o]) else o:argFixup xs r From git at git.haskell.org Sun Jun 26 18:51:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 26 Jun 2016 18:51:31 +0000 (UTC) Subject: [commit: ghc] master: rts/Linker.c: Improve ugly C pre-processor hack (da60e3e) Message-ID: <20160626185131.825373A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/da60e3e94ea3e737609444615f61649121782a1a/ghc >--------------------------------------------------------------- commit da60e3e94ea3e737609444615f61649121782a1a Author: Erik de Castro Lopo Date: Mon Jun 27 04:54:47 2016 +1000 rts/Linker.c: Improve ugly C pre-processor hack Test Plan: Build on x86_64/linux, x86_64/darwin and powerpc/linux Reviewers: Phyx, bgamari, simonmar, austin Reviewed By: Phyx Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2364 >--------------------------------------------------------------- da60e3e94ea3e737609444615f61649121782a1a rts/Linker.c | 29 +++++++++++++---------------- 1 file changed, 13 insertions(+), 16 deletions(-) diff --git a/rts/Linker.c b/rts/Linker.c index dd36425..af87713 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -327,11 +327,16 @@ static void *lookupSymbolInDLLs ( unsigned char *lbl ); #ifndef x86_64_HOST_ARCH static void zapTrailingAtSign ( unsigned char *sym ); #endif + +#if defined(x86_64_HOST_ARCH) +#define ONLY_USED_x86_64_HOST_ARCH(x) (x) +#else +#define ONLY_USED_x86_64_HOST_ARCH(x) (x) GNUC3_ATTRIBUTE(__unused__) +#endif + static char *allocateImageAndTrampolines ( pathchar* arch_name, char* member_name, -#if defined(x86_64_HOST_ARCH) FILE* f, -#endif int size, int isThin); #if defined(x86_64_HOST_ARCH) @@ -2121,11 +2126,8 @@ static HsInt loadArchive_ (pathchar *path) #if defined(mingw32_HOST_OS) // TODO: We would like to use allocateExec here, but allocateExec // cannot currently allocate blocks large enough. - image = allocateImageAndTrampolines(path, fileName, -#if defined(x86_64_HOST_ARCH) - f, -#endif - memberSize, isThin); + image = allocateImageAndTrampolines(path, fileName, f, memberSize, + isThin); #elif defined(darwin_HOST_OS) if (RTS_LINKER_USE_MMAP) image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1, 0); @@ -2354,11 +2356,8 @@ preloadObjectFile (pathchar *path) // TODO: We would like to use allocateExec here, but allocateExec // cannot currently allocate blocks large enough. - image = allocateImageAndTrampolines(path, "itself", -#if defined(x86_64_HOST_ARCH) - f, -#endif - fileSize, HS_BOOL_FALSE); + image = allocateImageAndTrampolines(path, "itself", f, fileSize, + HS_BOOL_FALSE); if (image == NULL) { fclose(f); return NULL; @@ -3074,11 +3073,9 @@ static int verifyCOFFHeader ( COFF_header *hdr, pathchar *filename); static char * allocateImageAndTrampolines ( pathchar* arch_name, char* member_name, -#if defined(x86_64_HOST_ARCH) - FILE* f, -#endif + FILE* ONLY_USED_x86_64_HOST_ARCH (f), int size, - int isThin) + int ONLY_USED_x86_64_HOST_ARCH (isThin)) { char* image; #if defined(x86_64_HOST_ARCH) From marlowsd at gmail.com Mon Jun 27 07:42:30 2016 From: marlowsd at gmail.com (Simon Marlow) Date: Mon, 27 Jun 2016 08:42:30 +0100 Subject: [commit: ghc] master: Accept new (lower) allocations for T7257 (15641b0) In-Reply-To: References: <20160622210820.C04623A300@ghc.haskell.org> Message-ID: Yes, it was the sizeExpr fix. It validated locally and on Travis, but I'm guessing it was right on the boundary. On 22 June 2016 at 22:37, Bartosz Nitka wrote: > Appears to be: > a47b62cb3685 Second attempt to fix sizeExpr > > https://perf.haskell.org/ghc/#revision/9d62d09a6c399c98491b7a63a7a1366c89fcf5db > > 2016-06-22 22:24 GMT+01:00 Simon Peyton Jones via ghc-devs < > ghc-devs at haskell.org>: > >> Does anyone know what made T7257 better? >> >> Simon >> >> | -----Original Message----- >> | From: ghc-commits [mailto:ghc-commits-bounces at haskell.org] On Behalf Of >> | git at git.haskell.org >> | Sent: 22 June 2016 22:08 >> | To: ghc-commits at haskell.org >> | Subject: [commit: ghc] master: Accept new (lower) allocations for T7257 >> | (15641b0) >> | >> | Repository : ssh://git at git.haskell.org/ghc >> | >> | On branch : master >> | Link : >> | >> https://na01.safelinks.protection.outlook.com/?url=http%3a%2f%2fghc.hask >> | ell.org >> %2ftrac%2fghc%2fchangeset%2f15641b07f1d3ccb5f35b4f31539ecceb5fb38 >> | c17%2fghc&data=01%7c01%7csimonpj%40064d.mgd.microsoft.com >> %7c32fafc88b758 >> | 43148b2a08d39ae1ea3f%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=eLrMob >> | XyWHA691jI3t4pf0CbGybfrVqptmkpTDdtDI8%3d >> | >> | >--------------------------------------------------------------- >> | >> | commit 15641b07f1d3ccb5f35b4f31539ecceb5fb38c17 >> | Author: Simon Marlow >> | Date: Wed Jun 22 20:54:59 2016 +0100 >> | >> | Accept new (lower) allocations for T7257 >> | >> | >> | >--------------------------------------------------------------- >> | >> | 15641b07f1d3ccb5f35b4f31539ecceb5fb38c17 >> | testsuite/tests/perf/should_run/all.T | 3 ++- >> | 1 file changed, 2 insertions(+), 1 deletion(-) >> | >> | diff --git a/testsuite/tests/perf/should_run/all.T >> | b/testsuite/tests/perf/should_run/all.T >> | index caf4eff..3cb6f8e 100644 >> | --- a/testsuite/tests/perf/should_run/all.T >> | +++ b/testsuite/tests/perf/should_run/all.T >> | @@ -276,9 +276,10 @@ test('T7257', >> | [(wordsize(32), 989850664, 10), >> | # expected value: 1246287228 (i386/Linux) >> | # 2016-04-06: 989850664 (i386/Linux) no idea >> | what happened >> | - (wordsize(64), 1654893248, 5)]), >> | + (wordsize(64), 1414893248, 5)]), >> | # 2012-09-21: 1774893760 (amd64/Linux) >> | # 2015-11-03: 1654893248 (amd64/Linux) >> | + # 2016-06-22: 1414893248 (amd64/Linux, sizeExpr >> | fix) >> | stats_num_field('peak_megabytes_allocated', >> | [(wordsize(32), 217, 5), >> | # 2012-10-08: 217 (x86/Linux) >> | >> | _______________________________________________ >> | ghc-commits mailing list >> | ghc-commits at haskell.org >> | >> https://na01.safelinks.protection.outlook.com/?url=http%3a%2f%2fmail.has >> | kell.org%2fcgi-bin%2fmailman%2flistinfo%2fghc- >> | commits&data=01%7c01%7csimonpj%40064d.mgd.microsoft.com >> %7c32fafc88b75843 >> | 148b2a08d39ae1ea3f%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=RftvNpBH >> | H7bw53EdhgnsdV%2f6M2LNgFVB1t7gCwOTT7A%3d >> _______________________________________________ >> ghc-devs mailing list >> ghc-devs at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs >> > > > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From git at git.haskell.org Mon Jun 27 07:42:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 27 Jun 2016 07:42:03 +0000 (UTC) Subject: [commit: ghc] master: Don't run the run_command tests with ext-interp (ff1cc26) Message-ID: <20160627074203.7BC9E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ff1cc262cf6bcac5a8f714c4aff5a4fd945cff73/ghc >--------------------------------------------------------------- commit ff1cc262cf6bcac5a8f714c4aff5a4fd945cff73 Author: Simon Marlow Date: Sun Jun 26 06:54:26 2016 +0100 Don't run the run_command tests with ext-interp >--------------------------------------------------------------- ff1cc262cf6bcac5a8f714c4aff5a4fd945cff73 testsuite/tests/th/all.T | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 637fecc..10da6f0 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -48,6 +48,7 @@ test('TH_NestedSplices', # normal way first, which is why the work is done by a Makefile rule. test('TH_spliceE5_prof', [req_profiling, + only_ways(['normal']), when(ghc_dynamic(), expect_broken(11495)), extra_clean(['TH_spliceE5_prof_Lib.p.o', 'TH_spliceE5_prof_Lib.hi', 'TH_spliceE5_prof_Lib.dyn_o', 'TH_spliceE5_prof_Lib.dyn_hi', @@ -58,7 +59,7 @@ test('TH_spliceE5_prof', test('TH_spliceE5_prof_ext', [req_profiling, - omit_ways(['ghci']), + only_ways(['normal']), extra_clean(['TH_spliceE5_prof_ext_Lib.hi', 'TH_spliceE5_prof_ext_Lib.o'])], run_command, @@ -145,8 +146,9 @@ test('T2713', normal, compile_fail, ['-v0']) test('T2674', normal, compile_fail, ['-v0']) test('TH_emptycase', normal, compile, ['-v0']) -test('T2386', extra_clean(['T2386_Lib.hi', 'T2386_Lib.o']), - run_command, +test('T2386', [ extra_clean(['T2386_Lib.hi', 'T2386_Lib.o']), + only_ways(['normal']) ], + run_command, ['$MAKE -s --no-print-directory T2386'] ) test('T2685', extra_clean(['T2685a.hi','T2685a.o']), @@ -216,7 +218,9 @@ test('T5434', extra_clean(['T5434a.hi','T5434a.o']), test('T5508', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_Depends', [extra_clean(['TH_Depends_External.o', 'TH_Depends_External.hi', - 'TH_Depends_external.txt'])], + 'TH_Depends_external.txt']), + only_ways(['normal']), + ], run_command, ['$MAKE -s --no-print-directory TH_Depends']) test('T5597', extra_clean(['T5597a.hi','T5597a.o']), @@ -267,8 +271,10 @@ test('T7276a', [ only_ways(['ghci']), combined_output ], test('TH_TyInstWhere1', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_TyInstWhere2', normal, compile, ['-v0']) -test('T7445', extra_clean(['T7445a.hi', 'T7445a.o']), - run_command, +test('T7445', [ extra_clean(['T7445a.hi', 'T7445a.o']), + only_ways(['normal']), + ], + run_command, ['$MAKE -s --no-print-directory T7445'] ) test('T7532', extra_clean(['T7532a.hi', 'T7532a.o']), @@ -299,7 +305,7 @@ test('TH_Roles4', normal, compile, ['-v0']) test('T8186', normal, compile_and_run, ['-v0']) test('T8333', - normal, + only_ways(['normal']), run_command, ['$MAKE -s --no-print-directory T8333']) @@ -349,7 +355,9 @@ test('T7484', normal, compile_fail, ['-v0']) test('T1476', normal, compile, ['-v0']) test('T1476b', normal, compile, ['-v0']) test('T8031', normal, compile, ['-v0']) -test('T8624', normal, run_command, ['$MAKE -s --no-print-directory T8624']) +test('T8624', only_ways(['normal']), + run_command, + ['$MAKE -s --no-print-directory T8624']) test('TH_Lift', normal, compile, ['-v0']) test('T10047', only_ways(['ghci']), ghci_script, ['T10047.script']) test('T10019', only_ways(['ghci']), ghci_script, ['T10019.script']) From git at git.haskell.org Mon Jun 27 07:42:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 27 Jun 2016 07:42:06 +0000 (UTC) Subject: [commit: ghc] master: Make T8761 deterministic, I hope (7843c71) Message-ID: <20160627074206.293DD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7843c71c7e48cdba115bef422184e855ede23a67/ghc >--------------------------------------------------------------- commit 7843c71c7e48cdba115bef422184e855ede23a67 Author: Simon Marlow Date: Sun Jun 26 06:53:56 2016 +0100 Make T8761 deterministic, I hope Summary: T8761 seems to get different interleaving in its output on Phabricator, so this switches it to use stderr consistently. Test Plan: worksforme Reviewers: goldfire, austin, bgamari, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2363 >--------------------------------------------------------------- 7843c71c7e48cdba115bef422184e855ede23a67 testsuite/tests/th/T8761.hs | 14 +++++++------- testsuite/tests/th/T8761.stderr | 13 ++++++------- 2 files changed, 13 insertions(+), 14 deletions(-) diff --git a/testsuite/tests/th/T8761.hs b/testsuite/tests/th/T8761.hs index c0c96b9..b8177ff 100644 --- a/testsuite/tests/th/T8761.hs +++ b/testsuite/tests/th/T8761.hs @@ -34,7 +34,7 @@ do pats <- sequence [prefixPat, infixPat, recordPat] -- pretty print the pattern synonyms: - mapM_ (runIO . putStrLn . pprint) pats + mapM_ (runIO . hPutStrLn stderr . pprint) pats -- splice in the pattern synonyms return pats @@ -108,10 +108,10 @@ getY1' = y1 ((1, 2), [3]) -- should yield 3 do infos <- mapM reify [ 'P, 'Pe, 'Pu, 'Pue, 'Pur, 'Purp , 'Pure, 'Purep, 'Pep, 'Pup, 'Puep ] - mapM_ (runIO . putStrLn . pprint) infos - runIO $ hFlush stdout - -- GHC does not guarantee to do this after TH code. In particular - -- when the output is going to a file, and we're using GHC with - -- the runtime linker or with -fexternal-interpreter, stdout will - -- not get flushed. + mapM_ (runIO . hPutStrLn stderr . pprint) infos + -- NB. use stderr rather than stdout, because GHC does not + -- guarantee to flush stdout after TH code. In particular when + -- the output is going to a file, and we're using GHC with the + -- runtime linker or with -fexternal-interpreter, stdout will not + -- get flushed. [d| theAnswerIs = 42 |] diff --git a/testsuite/tests/th/T8761.stderr b/testsuite/tests/th/T8761.stderr index 2ecf495..6a7af1e 100644 --- a/testsuite/tests/th/T8761.stderr +++ b/testsuite/tests/th/T8761.stderr @@ -1,3 +1,7 @@ +pattern Q1 x1_0 x2_1 x3_2 <- ((x1_0, x2_1), [x3_2], _, _) +pattern x1_0 Q2 x2_1 = ((x1_0, x2_1)) +pattern Q3 {qx3, qy3, qz3} <- ((qx3, qy3), [qz3]) where + Q3 qx3 qy3 qz3 = ((qx3, qy3), [qz3]) T8761.hs:(16,1)-(39,13): Splicing declarations do { [qx1, qy1, qz1] <- mapM (\ i -> newName $ "x" ++ show i) [1, 2, 3]; @@ -25,7 +29,7 @@ T8761.hs:(16,1)-(39,13): Splicing declarations = patSynD nm3 (recordPatSyn [qx3, qy3, qz3]) (explBidir [cls]) patP; pats <- sequence [prefixPat, infixPat, recordPat]; - mapM_ (runIO . putStrLn . pprint) pats; + mapM_ (runIO . hPutStrLn stderr . pprint) pats; return pats } ======> pattern Q1 x1 x2 x3 <- ((x1, x2), [x3], _, _) @@ -119,10 +123,6 @@ T8761.hs:(71,1)-(105,39): Splicing declarations pattern Pup x <- MkUnivProv x pattern Puep :: forall a. forall b. Show b => a -> b -> (ExProv, a) pattern Puep x y <- (MkExProv y, x) -pattern Q1 x1_0 x2_1 x3_2 <- ((x1_0, x2_1), [x3_2], _, _) -pattern x1_0 Q2 x2_1 = ((x1_0, x2_1)) -pattern Q3 {qx3, qy3, qz3} <- ((qx3, qy3), [qz3]) where - Q3 qx3 qy3 qz3 = ((qx3, qy3), [qz3]) pattern T8761.P :: GHC.Types.Bool pattern T8761.Pe :: () => forall (a0_0 :: *) . a0_0 -> T8761.Ex pattern T8761.Pu :: forall (a0_0 :: *) . a0_0 -> a0_0 @@ -152,8 +152,7 @@ T8761.hs:(108,1)-(117,25): Splicing declarations reify ['P, 'Pe, 'Pu, 'Pue, 'Pur, 'Purp, 'Pure, 'Purep, 'Pep, 'Pup, 'Puep]; - mapM_ (runIO . putStrLn . pprint) infos; - runIO $ hFlush stdout; + mapM_ (runIO . hPutStrLn stderr . pprint) infos; [d| theAnswerIs = 42 |] } ======> theAnswerIs = 42 From git at git.haskell.org Mon Jun 27 09:38:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 27 Jun 2016 09:38:47 +0000 (UTC) Subject: [commit: ghc] master: Remove some `undefined`s (82282e8) Message-ID: <20160627093847.B5CFA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/82282e8dc0599c105996fe2071b5439d50323225/ghc >--------------------------------------------------------------- commit 82282e8dc0599c105996fe2071b5439d50323225 Author: Ömer Sinan Ağacan Date: Mon Jun 27 09:15:39 2016 +0000 Remove some `undefined`s These get annoying when `undefined` is actually used as placeholder in WIP code. Some of these were also completely redundant (just call `deAnnotate'` instead of `deAnnotate` etc.). >--------------------------------------------------------------- 82282e8dc0599c105996fe2071b5439d50323225 compiler/ghci/ByteCodeGen.hs | 4 ++-- compiler/ghci/RtClosureInspect.hs | 5 ++--- compiler/nativeGen/RegAlloc/Linear/Main.hs | 9 ++++----- compiler/utils/BufWrite.hs | 5 ++--- 4 files changed, 10 insertions(+), 13 deletions(-) diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index e752fc2..0d4c64b 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -1388,7 +1388,7 @@ pushAtom _ _ (AnnLit lit) = do pushAtom _ _ expr = pprPanic "ByteCodeGen.pushAtom" - (pprCoreExpr (deAnnotate (undefined, expr))) + (pprCoreExpr (deAnnotate' expr)) -- ----------------------------------------------------------------------------- @@ -1628,7 +1628,7 @@ atomPrimRep e | Just e' <- bcView e = atomPrimRep e' atomPrimRep (AnnVar v) = bcIdPrimRep v atomPrimRep (AnnLit l) = typePrimRep (literalType l) atomPrimRep (AnnCoercion {}) = VoidRep -atomPrimRep other = pprPanic "atomPrimRep" (ppr (deAnnotate (undefined,other))) +atomPrimRep other = pprPanic "atomPrimRep" (ppr (deAnnotate' other)) atomRep :: AnnExpr' Id ann -> ArgRep atomRep e = toArgRep (atomPrimRep e) diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index a76a298..f4076bb 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, ScopedTypeVariables, MagicHash, UnboxedTuples #-} +{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables, MagicHash, UnboxedTuples #-} ----------------------------------------------------------------------------- -- @@ -702,13 +702,12 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do -- -- [SPJ May 11] I don't understand the difference between my_ty and old_ty - go max_depth _ _ _ | seq max_depth False = undefined go 0 my_ty _old_ty a = do traceTR (text "Gave up reconstructing a term after" <> int max_depth <> text " steps") clos <- trIO $ getClosureData dflags a return (Suspension (tipe clos) my_ty a Nothing) - go max_depth my_ty old_ty a = do + go !max_depth my_ty old_ty a = do let monomorphic = not(isTyVarTy my_ty) -- This ^^^ is a convention. The ancestor tests for -- monomorphism and passes a type instead of a tv diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs index 9f71158..edb2394 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Main.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- @@ -579,10 +579,9 @@ releaseRegs regs = do let platform = targetPlatform dflags assig <- getAssigR free <- getFreeRegsR - let loop _ free _ | free `seq` False = undefined - loop assig free [] = do setAssigR assig; setFreeRegsR free; return () - loop assig free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs - loop assig free (r:rs) = + let loop assig !free [] = do setAssigR assig; setFreeRegsR free; return () + loop assig !free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs + loop assig !free (r:rs) = case lookupUFM assig r of Just (InBoth real _) -> loop (delFromUFM assig r) (frReleaseReg platform real free) rs diff --git a/compiler/utils/BufWrite.hs b/compiler/utils/BufWrite.hs index 48a2c4c..eff5705 100644 --- a/compiler/utils/BufWrite.hs +++ b/compiler/utils/BufWrite.hs @@ -64,9 +64,8 @@ bPutStr :: BufHandle -> String -> IO () bPutStr (BufHandle buf r hdl) !str = do i <- readFastMutInt r loop str i - where loop _ i | i `seq` False = undefined - loop "" i = do writeFastMutInt r i; return () - loop (c:cs) i + where loop "" !i = do writeFastMutInt r i; return () + loop (c:cs) !i | i >= buf_size = do hPutBuf hdl buf buf_size loop (c:cs) 0 From git at git.haskell.org Mon Jun 27 09:47:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 27 Jun 2016 09:47:36 +0000 (UTC) Subject: [commit: ghc] master: Typos in user manual and code: recurisve -> recursive (60c24b2) Message-ID: <20160627094736.79B343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/60c24b26231e1295321f86445b000c7199d73838/ghc >--------------------------------------------------------------- commit 60c24b26231e1295321f86445b000c7199d73838 Author: Ömer Sinan Ağacan Date: Mon Jun 27 09:50:37 2016 +0000 Typos in user manual and code: recurisve -> recursive >--------------------------------------------------------------- 60c24b26231e1295321f86445b000c7199d73838 compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcSimplify.hs | 2 +- docs/users_guide/glasgow_exts.rst | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index 315aa92..d4cc023 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -142,7 +142,7 @@ Note [Instances and loop breakers] * Instead the idea is to inline df_i into op1_i, which may then select methods from the MkC record, and thereby break the recursion with - df_i, leaving a *self*-recurisve op1_i. (If op1_i doesn't call op at + df_i, leaving a *self*-recursive op1_i. (If op1_i doesn't call op at the same type, it won't mention df_i, so there won't be recursion in the first place.) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 18adee8..a2e306d 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -480,7 +480,7 @@ signature where F is a type function. This happened in Trac #3972. We could do more than once but we'd have to have /some/ limit: in the -the recurisve case, we would go on forever in the common case where +the recursive case, we would go on forever in the common case where the constraints /are/ satisfiable (Trac #10592 comment:12!). For stratightforard situations without type functions the try_harder diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 95f1a0b..45b0d1c 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -11376,7 +11376,7 @@ obfuscates matters, so we do not do so here.) The translation is carefully crafted to make bang patterns meaningful for reursive and polymorphic bindings as well as straightforward -non-recurisve bindings. +non-recursive bindings. Here are some examples of how this translation works. The first expression of each sequence is Haskell source; the subsequent ones are From git at git.haskell.org Mon Jun 27 09:55:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 27 Jun 2016 09:55:39 +0000 (UTC) Subject: [commit: ghc] master: rts/Linker.c: Rename ONLY_USED_x86_64_HOST_ARCH macro (afa6e83) Message-ID: <20160627095539.D2DF13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/afa6e8309e8e7a069abcf7879791d53cdf22f00a/ghc >--------------------------------------------------------------- commit afa6e8309e8e7a069abcf7879791d53cdf22f00a Author: Erik de Castro Lopo Date: Mon Jun 27 19:37:06 2016 +1000 rts/Linker.c: Rename ONLY_USED_x86_64_HOST_ARCH macro Summary: Rename it to `USED_IF_x86_64_HOST_ARCH` to make it more like the existing `USED_IF` macros as suggested by Simon Marlow. Test Plan: Build on x86_64 windows Reviewers: Phyx, bgamari, simonmar, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2365 >--------------------------------------------------------------- afa6e8309e8e7a069abcf7879791d53cdf22f00a rts/Linker.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/rts/Linker.c b/rts/Linker.c index af87713..f7ac748 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -329,9 +329,9 @@ static void *lookupSymbolInDLLs ( unsigned char *lbl ); #endif #if defined(x86_64_HOST_ARCH) -#define ONLY_USED_x86_64_HOST_ARCH(x) (x) +#define USED_IF_x86_64_HOST_ARCH /* Nothing */ #else -#define ONLY_USED_x86_64_HOST_ARCH(x) (x) GNUC3_ATTRIBUTE(__unused__) +#define USED_IF_x86_64_HOST_ARCH STG_UNUSED #endif static char *allocateImageAndTrampolines ( @@ -3073,9 +3073,9 @@ static int verifyCOFFHeader ( COFF_header *hdr, pathchar *filename); static char * allocateImageAndTrampolines ( pathchar* arch_name, char* member_name, - FILE* ONLY_USED_x86_64_HOST_ARCH (f), + FILE* f USED_IF_x86_64_HOST_ARCH, int size, - int ONLY_USED_x86_64_HOST_ARCH (isThin)) + int isThin USED_IF_x86_64_HOST_ARCH) { char* image; #if defined(x86_64_HOST_ARCH) From git at git.haskell.org Tue Jun 28 12:21:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 12:21:29 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: never pick up .T files in .run directories (bbf0aa2) Message-ID: <20160628122129.796583A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bbf0aa27281d905ac8767fcbc7a26f1bfa38a1b2/ghc >--------------------------------------------------------------- commit bbf0aa27281d905ac8767fcbc7a26f1bfa38a1b2 Author: Thomas Miedema Date: Tue Jun 21 09:52:36 2016 +0200 Testsuite: never pick up .T files in .run directories And use os.walk instead of calling os.listdir many times. The testsuite driver should be able to handle backward slashes on Windows now. >--------------------------------------------------------------- bbf0aa27281d905ac8767fcbc7a26f1bfa38a1b2 testsuite/driver/runtests.py | 2 +- testsuite/driver/testlib.py | 21 ++++++++------------- 2 files changed, 9 insertions(+), 14 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 917003b..b2054fe 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -257,7 +257,7 @@ print('Timeout is ' + str(config.timeout)) if config.rootdirs == []: config.rootdirs = ['.'] -t_files = findTFiles(config.rootdirs) +t_files = list(findTFiles(config.rootdirs)) print('Found', len(t_files), '.T files...') diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 41e0fce..d4fcf13 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1933,19 +1933,14 @@ def cleanup(): # Return a list of all the files ending in '.T' below directories roots. def findTFiles(roots): - # It would be better to use os.walk, but that - # gives backslashes on Windows, which trip the - # testsuite later :-( - return [filename for root in roots for filename in findTFiles_(root)] - -def findTFiles_(path): - if os.path.isdir(path): - paths = [os.path.join(path, x) for x in os.listdir(path)] - return findTFiles(paths) - elif path[-2:] == '.T': - return [path] - else: - return [] + for root in roots: + for path, dirs, files in os.walk(root, topdown=True): + # Never pick up .T files in uncleaned .run directories. + dirs[:] = [dir for dir in sorted(dirs) + if not dir.endswith(testdir_suffix)] + for filename in files: + if filename.endswith('.T'): + yield os.path.join(path, filename) # ----------------------------------------------------------------------------- # Output a test summary to the specified file object From git at git.haskell.org Tue Jun 28 12:21:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 12:21:32 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: report duplicate testnames when `make TEST=` (7593c2f) Message-ID: <20160628122132.2085A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7593c2fbe4a68bf23b193461fab63456d98702c2/ghc >--------------------------------------------------------------- commit 7593c2fbe4a68bf23b193461fab63456d98702c2 Author: Thomas Miedema Date: Tue Jun 21 12:32:04 2016 +0200 Testsuite: report duplicate testnames when `make TEST=` >--------------------------------------------------------------- 7593c2fbe4a68bf23b193461fab63456d98702c2 testsuite/driver/testlib.py | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index d4fcf13..1381ccf 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -619,6 +619,15 @@ def runTest (opts, name, func, args): # name :: String # setup :: TestOpts -> IO () def test (name, setup, func, args): + global aloneTests + global parallelTests + global allTestNames + global thisdir_settings + if name in allTestNames: + framework_fail(name, 'duplicate', 'There are multiple tests with this name') + if not re.match('^[0-9]*[a-zA-Z][a-zA-Z0-9._-]*$', name): + framework_fail(name, 'bad_name', 'This test has an invalid name') + if config.run_only_some_tests: if name not in config.only: return @@ -630,15 +639,6 @@ def test (name, setup, func, args): # report on any tests we couldn't find and error out. config.only.remove(name) - global aloneTests - global parallelTests - global allTestNames - global thisdir_settings - if name in allTestNames: - framework_fail(name, 'duplicate', 'There are multiple tests with this name') - if not re.match('^[0-9]*[a-zA-Z][a-zA-Z0-9._-]*$', name): - framework_fail(name, 'bad_name', 'This test has an invalid name') - # Make a deep copy of the default_testopts, as we need our own copy # of any dictionaries etc inside it. Otherwise, if one test modifies # them, all tests will see the modified version! From git at git.haskell.org Tue Jun 28 12:21:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 12:21:34 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: remove one level of indentation [skip ci] (1f45bce) Message-ID: <20160628122134.C48593A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f45bce0e7b3fb04a136874d56f50feaa55db92b/ghc >--------------------------------------------------------------- commit 1f45bce0e7b3fb04a136874d56f50feaa55db92b Author: Thomas Miedema Date: Tue Jun 21 13:56:21 2016 +0200 Testsuite: remove one level of indentation [skip ci] Refactoring only. Move try/except out of do_test. >--------------------------------------------------------------- 1f45bce0e7b3fb04a136874d56f50feaa55db92b testsuite/driver/testlib.py | 262 ++++++++++++++++++++++---------------------- 1 file changed, 129 insertions(+), 133 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 1f45bce0e7b3fb04a136874d56f50feaa55db92b From git at git.haskell.org Tue Jun 28 12:21:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 12:21:37 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: simplify extra_file handling (206b4a1) Message-ID: <20160628122137.72D833A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/206b4a1d0e82e8f0f40f6e36cf657146a8d4b36a/ghc >--------------------------------------------------------------- commit 206b4a1d0e82e8f0f40f6e36cf657146a8d4b36a Author: Thomas Miedema Date: Tue Jun 21 18:58:50 2016 +0200 Testsuite: simplify extra_file handling Before, `extra_files(['.hpc/Main.mix'])` meant copy `Main.mix` to `/.hpc/Main.mix`. This feature wasn't really necessary, so now it just means copy `Main.mix` to `/Main.mix`. This simplifies the implementation. Some small other cleanups as well. -40 lines of code. >--------------------------------------------------------------- 206b4a1d0e82e8f0f40f6e36cf657146a8d4b36a testsuite/driver/extra_files.py | 30 +++++++++--------- testsuite/driver/testlib.py | 68 ++++++++--------------------------------- 2 files changed, 28 insertions(+), 70 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 206b4a1d0e82e8f0f40f6e36cf657146a8d4b36a From git at git.haskell.org Tue Jun 28 12:21:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 12:21:40 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: do not print timeout message (bafd615) Message-ID: <20160628122140.1B42F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bafd615e40c2a11af1390e736f6122033eecc4c6/ghc >--------------------------------------------------------------- commit bafd615e40c2a11af1390e736f6122033eecc4c6 Author: Thomas Miedema Date: Tue Jun 28 11:58:33 2016 +0200 Testsuite: do not print timeout message This is a followup to e1293bbfb1fa1fdeb56446a7b957d6f628042e71, but then for Windows timeout. >--------------------------------------------------------------- bafd615e40c2a11af1390e736f6122033eecc4c6 testsuite/timeout/timeout.hs | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/testsuite/timeout/timeout.hs b/testsuite/timeout/timeout.hs index 3532497..3684b91 100644 --- a/testsuite/timeout/timeout.hs +++ b/testsuite/timeout/timeout.hs @@ -33,9 +33,6 @@ main = do _ -> die ("Can't parse " ++ show secs ++ " as a number of seconds") _ -> die ("Bad arguments " ++ show args) -timeoutMsg :: String -> String -timeoutMsg cmd = "Timeout happened...killing process "++cmd++"..." - run :: Int -> String -> IO () #if !defined(mingw32_HOST_OS) run secs cmd = do @@ -61,7 +58,6 @@ run secs cmd = do r <- takeMVar m case r of Nothing -> do - hPutStrLn stderr (timeoutMsg cmd) killProcess pid exitWith (ExitFailure 99) Just (Exited r) -> exitWith r @@ -122,8 +118,7 @@ run secs cmd = let millisecs = secs * 1000 rc <- waitForSingleObject handle (fromIntegral millisecs) if rc == cWAIT_TIMEOUT - then do hPutStrLn stderr (timeoutMsg cmd) - terminateJobObject job 99 + then do terminateJobObject job 99 exitWith (ExitFailure 99) else alloca $ \p_exitCode -> do r <- getExitCodeProcess handle p_exitCode From git at git.haskell.org Tue Jun 28 12:21:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 12:21:42 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: open/close stdin/stdout/stderr explicitly (58f0086) Message-ID: <20160628122142.BDA023A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/58f0086b70f2f409b9f88de1611efcf18756f9e5/ghc >--------------------------------------------------------------- commit 58f0086b70f2f409b9f88de1611efcf18756f9e5 Author: Thomas Miedema Date: Mon Jun 20 14:36:03 2016 +0200 Testsuite: open/close stdin/stdout/stderr explicitly This allows run_command's to contain `|`, and `no_stdin` isn't necessary anymore. Unfortunately it doesn't fix T7037 on Windows which I had hoped it would (testsuite driver tries to read a file that it just created itself, but the OS says it doesn't exist). The only drawback of this commit is that the command that the testsuite prints to the terminal (for debugging purposes) doesn't mention the files that stdout and stderr are redirected to anymore. This is probably ok. Update submodule unix. Differential Revision: https://phabricator.haskell.org/D1234 >--------------------------------------------------------------- 58f0086b70f2f409b9f88de1611efcf18756f9e5 libraries/base/tests/IO/all.T | 7 +- libraries/unix | 2 +- testsuite/driver/testglobals.py | 3 - testsuite/driver/testlib.py | 137 ++++++++++++++---------------- testsuite/tests/ghc-e/should_run/Makefile | 2 +- testsuite/tests/rts/all.T | 2 +- 6 files changed, 68 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 58f0086b70f2f409b9f88de1611efcf18756f9e5 From git at git.haskell.org Tue Jun 28 12:21:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 12:21:45 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: cleanup printing of summary (d8e9b87) Message-ID: <20160628122145.6EECD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d8e9b876de8733600f6684b8f91ca2a67078edb4/ghc >--------------------------------------------------------------- commit d8e9b876de8733600f6684b8f91ca2a67078edb4 Author: Thomas Miedema Date: Tue Jun 21 18:35:42 2016 +0200 Testsuite: cleanup printing of summary Just use a simple list of tuples, instead of a nested map. -90 lines of code. >--------------------------------------------------------------- d8e9b876de8733600f6684b8f91ca2a67078edb4 testsuite/driver/runtests.py | 4 +- testsuite/driver/testglobals.py | 21 ++---- testsuite/driver/testlib.py | 162 ++++++++++------------------------------ 3 files changed, 50 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 d8e9b876de8733600f6684b8f91ca2a67078edb4 From git at git.haskell.org Tue Jun 28 12:21:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 12:21:48 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: run all indexed-types ways on ./validate --slow (6b3b631) Message-ID: <20160628122148.2877E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6b3b631e90aa5f6f9322efcb81e9b13d14d087f0/ghc >--------------------------------------------------------------- commit 6b3b631e90aa5f6f9322efcb81e9b13d14d087f0 Author: Thomas Miedema Date: Mon Jun 27 23:11:48 2016 +0200 Testsuite: run all indexed-types ways on ./validate --slow I don't know why some ways were omitted before. >--------------------------------------------------------------- 6b3b631e90aa5f6f9322efcb81e9b13d14d087f0 testsuite/tests/indexed-types/should_compile/all.T | 3 --- testsuite/tests/indexed-types/should_fail/all.T | 2 -- testsuite/tests/indexed-types/should_run/all.T | 2 -- 3 files changed, 7 deletions(-) diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 31c9555..06b1222 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -1,6 +1,3 @@ -# Keep optimised tests, so we test coercion optimisation -setTestOpts(omit_ways(['optasm', 'optllvm', 'hpc'])) - test('Simple1', normal, compile, ['']) test('Simple2', normal, compile, ['']) test('Simple3', normal, compile, ['']) diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 041282e..1aaa07e 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -1,5 +1,3 @@ -setTestOpts(omit_ways(['optasm'])) - test('SimpleFail1a', normal, compile_fail, ['']) test('SimpleFail1b', normal, compile_fail, ['']) test('SimpleFail2a', normal, compile_fail, ['']) diff --git a/testsuite/tests/indexed-types/should_run/all.T b/testsuite/tests/indexed-types/should_run/all.T index 15971eb..a4b9838 100644 --- a/testsuite/tests/indexed-types/should_run/all.T +++ b/testsuite/tests/indexed-types/should_run/all.T @@ -1,5 +1,3 @@ -setTestOpts(omit_ways(['hpc', 'ghci', 'threaded1', 'threaded2'])) - test('T2985', normal, compile_and_run, ['']) test('T4235', normal, compile_and_run, ['']) From git at git.haskell.org Tue Jun 28 12:21:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 12:21:51 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: framework failure improvements (#11165) (782cacf) Message-ID: <20160628122151.12F863A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/782cacf57300908d8a608bac7d26be59586f2af0/ghc >--------------------------------------------------------------- commit 782cacf57300908d8a608bac7d26be59586f2af0 Author: Thomas Miedema Date: Fri Jun 24 16:18:05 2016 +0200 Testsuite: framework failure improvements (#11165) * add framework failures to unexpected results list * report errors in .T files as framework failures (show in summary) * don't report missing tests when framework failures in .T files >--------------------------------------------------------------- 782cacf57300908d8a608bac7d26be59586f2af0 testsuite/driver/runtests.py | 20 +++++++++++++------- testsuite/driver/testlib.py | 7 +++++-- 2 files changed, 18 insertions(+), 9 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index efd8b09..8a11f44 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -298,20 +298,26 @@ def cleanup_and_exit(exitcode): exit(exitcode) # First collect all the tests to be run +t_files_ok = True for file in t_files: if_verbose(2, '====> Scanning %s' % file) newTestDir(tempdir, os.path.dirname(file)) try: exec(open(file).read()) - except Exception: - print('*** framework failure: found an error while executing ', file, ':') - t.n_framework_failures = t.n_framework_failures + 1 + except Exception as e: traceback.print_exc() + framework_fail(file, '', str(e)) + t_files_ok = False -if config.only: - # See Note [Mutating config.only] - sys.stderr.write("ERROR: tests not found: {0}\n".format(list(config.only))) - cleanup_and_exit(1) +for name in config.only: + if t_files_ok: + # See Note [Mutating 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 + # .T file errors. + pass if config.list_broken: global brokens diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index e9548c7..6d4d77c 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1841,7 +1841,9 @@ def findTFiles(roots): def summary(t, file, short=False): file.write('\n') - printUnexpectedTests(file, [t.unexpected_passes, t.unexpected_failures, t.unexpected_stat_failures]) + printUnexpectedTests(file, + [t.unexpected_passes, t.unexpected_failures, + t.unexpected_stat_failures, t.framework_failures]) if short: # Only print the list of unexpected tests above. @@ -1897,7 +1899,8 @@ def summary(t, file, short=False): def printUnexpectedTests(file, testInfoss): unexpected = {name for testInfos in testInfoss - for (_, name, _, _) in testInfos} + for (_, name, _, _) in testInfos + if not name.endswith('.T')} if unexpected: file.write('Unexpected results from:\n') file.write('TEST="' + ' '.join(unexpected) + '"\n') From git at git.haskell.org Tue Jun 28 12:21:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 12:21:53 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: mark tests expect_broken (3fb9837) Message-ID: <20160628122153.ABC9D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3fb9837f3d69a6353df5a09d86c94f855dba20dc/ghc >--------------------------------------------------------------- commit 3fb9837f3d69a6353df5a09d86c94f855dba20dc Author: Thomas Miedema Date: Mon Jun 27 23:12:19 2016 +0200 Testsuite: mark tests expect_broken * T7837 is still broken for prof_ways (#9406) * T11627b is broken on Windows for WAY=prof_hc_hb (#12236) * T8089 is also broken for WAY=profasm on Windows >--------------------------------------------------------------- 3fb9837f3d69a6353df5a09d86c94f855dba20dc libraries/base/tests/all.T | 11 +++++------ testsuite/tests/indexed-types/should_compile/all.T | 3 ++- testsuite/tests/profiling/should_run/all.T | 2 ++ 3 files changed, 9 insertions(+), 7 deletions(-) diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index ac22336..7950786 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -194,12 +194,11 @@ test('T9681', normal, compile_fail, ['']) # Probably something like 1s is already enough, but I don't know enough to # make an educated guess how long it needs to be guaranteed to reach the C # call." -test('T8089', [exit_code(99), - run_timeout_multiplier(0.01), - when(opsys('mingw32'), - expect_broken_for(7325, ['normal', 'hpc', 'optasm'])), - ], - compile_and_run, ['']) +test('T8089', + [exit_code(99), run_timeout_multiplier(0.01), + when(opsys('mingw32'), + expect_broken_for(7325, ['normal', 'hpc', 'optasm', 'profasm']))], + compile_and_run, ['']) test('T9826',normal, compile_and_run,['']) test('T9848', [ stats_num_field('bytes allocated', diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 06b1222..84cd5dc 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -206,7 +206,8 @@ test('T7489', normal, compile, ['']) test('T7585', normal, compile, ['']) test('T7282', normal, compile, ['']) test('T7804', normal, compile, ['']) -test('T7837', normal, compile, ['-O -ddump-rule-firings']) +test('T7837', expect_broken_for(9406, prof_ways), compile, + ['-O -ddump-rule-firings']) test('T4185', normal, compile, ['']) # Caused infinite loop in the compiler diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index f3ea9b1..76956bd 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -103,6 +103,8 @@ test('T11627a', [extra_ways(extra_prof_ways)], compile_and_run, ['']) test('T11627b', [ extra_run_opts('+RTS -i0 -RTS') # census after each GC , extra_ways(extra_prof_ways) + , when(opsys('mingw32'), + expect_broken_for(12236, ['prof_hc_hb'])) ] , compile_and_run , ['']) From git at git.haskell.org Tue Jun 28 12:21:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 12:21:56 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: do not add -debug explicitly in .T file (0eb0378) Message-ID: <20160628122156.596083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0eb037814b39dc66a2c5549d2310e9853bc8292a/ghc >--------------------------------------------------------------- commit 0eb037814b39dc66a2c5549d2310e9853bc8292a Author: Thomas Miedema Date: Tue Jun 28 00:21:58 2016 +0200 Testsuite: do not add -debug explicitly in .T file This prevents `cannot find -lHSrts_debug_p` when running `make TEST=T9078 WAY=profasm` (#9078). >--------------------------------------------------------------- 0eb037814b39dc66a2c5549d2310e9853bc8292a testsuite/tests/rts/T9078.stderr | 2 -- testsuite/tests/rts/all.T | 6 +++--- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/rts/T9078.stderr b/testsuite/tests/rts/T9078.stderr deleted file mode 100644 index 901a1ca..0000000 --- a/testsuite/tests/rts/T9078.stderr +++ /dev/null @@ -1,2 +0,0 @@ -cap 0: initialised -cap 0: shutting down diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index bfdf318..086f479 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -259,9 +259,9 @@ test('T8124', [ only_ways(threaded_ways), omit_ways(['ghci']), # The ghci way gets confused by the RTS options test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], compile_and_run, ['']) -# I couldn't reproduce 9078 with the -threaded runtime, but could easily -# with the non-threaded one. -test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug']) +# T9078 needs to be compiled with -debug, which threaded1 does for us. +# Assert failure is reproducible with ghc-7.8.2. +test('T9078', only_ways(['threaded1']), compile_and_run, ['']) test('T10017', [ when(opsys('mingw32'), skip) , only_ways(threaded_ways), extra_run_opts('+RTS -N2 -RTS') ], compile_and_run, ['']) From git at git.haskell.org Tue Jun 28 12:37:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 12:37:46 +0000 (UTC) Subject: [commit: ghc] master: Don't omit any evidence bindings (af21e38) Message-ID: <20160628123746.8CA333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/af21e38855f7d517774542b360178b05045ecb08/ghc >--------------------------------------------------------------- commit af21e38855f7d517774542b360178b05045ecb08 Author: Simon Peyton Jones Date: Fri Jun 24 15:49:05 2016 +0100 Don't omit any evidence bindings This fixes Trac #12156, where we were omitting to make an evidence binding (because cec_suppress was on), but yet the program was compiled and run. The fix is easy, and involves deleting code :-). >--------------------------------------------------------------- af21e38855f7d517774542b360178b05045ecb08 compiler/typecheck/TcErrors.hs | 57 +++++++++++----------- .../should_compile/T12156.hs} | 3 ++ .../partial-sigs/should_compile/T12156.stderr | 3 ++ testsuite/tests/partial-sigs/should_compile/all.T | 1 + 4 files changed, 36 insertions(+), 28 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 990418a..9cccb63 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -246,6 +246,16 @@ data HoleChoice | HoleWarn -- Defer to runtime, emit a compile-time warning | HoleDefer -- Defer to runtime, no warning +instance Outputable HoleChoice where + ppr HoleError = text "HoleError" + ppr HoleWarn = text "HoleWarn" + ppr HoleDefer = text "HoleDefer" + +instance Outputable TypeErrorChoice where + ppr TypeError = text "TypeError" + ppr TypeWarn = text "TypeWarn" + ppr TypeDefer = text "TypeDefer" + data ReportErrCtxt = CEC { cec_encl :: [Implication] -- Enclosing implications -- (innermost first) @@ -427,7 +437,7 @@ reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_insol = insols, wc_impl , ("skolem eq1", very_wrong, True, mkSkolReporter) , ("skolem eq2", skolem_eq, True, mkSkolReporter) , ("non-tv eq", non_tv_eq, True, mkSkolReporter) - , ("Out of scope", is_out_of_scope, True, mkHoleReporter) + , ("Out of scope", is_out_of_scope, True, mkHoleReporter) , ("Holes", is_hole, False, mkHoleReporter) -- The only remaining equalities are alpha ~ ty, @@ -536,14 +546,14 @@ mkSkolReporter ctxt cts mkHoleReporter :: Reporter -- Reports errors one at a time mkHoleReporter ctxt - = mapM_ $ \ct -> - do { err <- mkHoleError ctxt ct - ; maybeReportHoleError ctxt ct err - ; maybeAddDeferredHoleBinding ctxt err ct } + = mapM_ $ \ct -> do { err <- mkHoleError ctxt ct + ; maybeReportHoleError ctxt ct err + ; maybeAddDeferredHoleBinding ctxt err ct } mkUserTypeErrorReporter :: Reporter mkUserTypeErrorReporter ctxt - = mapM_ $ \ct -> maybeReportError ctxt =<< mkUserTypeError ctxt ct + = mapM_ $ \ct -> do { err <- mkUserTypeError ctxt ct + ; maybeReportError ctxt err } mkUserTypeError :: ReportErrCtxt -> Ct -> TcM ErrMsg mkUserTypeError ctxt ct = mkErrorMsgFromCt ctxt ct @@ -561,7 +571,6 @@ mkGroupReporter :: (ReportErrCtxt -> [Ct] -> TcM ErrMsg) -- and report only the first (to avoid a cascade) mkGroupReporter mk_err ctxt cts = mapM_ (reportGroup mk_err ctxt) (equivClasses cmp_loc cts) - where eq_lhs_type :: Ct -> Ct -> Bool eq_lhs_type ct1 ct2 @@ -585,9 +594,13 @@ reportGroup mk_err ctxt cts = (_, cts') -> do { err <- mk_err ctxt cts' ; maybeReportError ctxt err - ; mapM_ (maybeAddDeferredBinding ctxt err) cts' } - -- Add deferred bindings for all - -- But see Note [Always warn with -fdefer-type-errors] + -- But see Note [Always warn with -fdefer-type-errors] + ; traceTc "reportGroup" (ppr cts') + ; mapM_ (addDeferredBinding ctxt err) cts' } + -- Add deferred bindings for all + -- Redundant if we are going to abort compilation, + -- but that's hard to know for sure, and if we don't + -- abort, we need bindings for all (e.g. Trac #12156) where isMonadFailInstanceMissing ct = case ctLocOrigin (ctLoc ct) of @@ -657,23 +670,10 @@ addDeferredBinding ctxt err ct maybeAddDeferredHoleBinding :: ReportErrCtxt -> ErrMsg -> Ct -> TcM () maybeAddDeferredHoleBinding ctxt err ct - | isExprHoleCt ct - , case cec_expr_holes ctxt of - HoleDefer -> True - HoleWarn -> True - HoleError -> False - = addDeferredBinding ctxt err ct -- Only add bindings for holes in expressions - | otherwise -- not for holes in partial type signatures - = return () - -maybeAddDeferredBinding :: ReportErrCtxt -> ErrMsg -> Ct -> TcM () -maybeAddDeferredBinding ctxt err ct = - case cec_defer_type_errors ctxt of - TypeDefer -> deferred - TypeWarn -> deferred - TypeError -> return () - where - deferred = addDeferredBinding ctxt err ct + | isExprHoleCt ct + = addDeferredBinding ctxt err ct -- Only add bindings for holes in expressions + | otherwise -- not for holes in partial type signatures + = return () tryReporters :: ReportErrCtxt -> [ReporterSpec] -> [Ct] -> TcM (ReportErrCtxt, [Ct]) -- Use the first reporter in the list whose predicate says True @@ -696,9 +696,10 @@ tryReporters ctxt reporters cts tryReporter :: ReportErrCtxt -> ReporterSpec -> [Ct] -> TcM (ReportErrCtxt, [Ct]) tryReporter ctxt (str, keep_me, suppress_after, reporter) cts | null yeses = return (ctxt, cts) - | otherwise = do { traceTc "tryReporter:" (text str <+> ppr yeses) + | otherwise = do { traceTc "tryReporter{ " (text str <+> ppr yeses) ; reporter ctxt yeses ; let ctxt' = ctxt { cec_suppress = suppress_after || cec_suppress ctxt } + ; traceTc "tryReporter end }" (text str <+> ppr (cec_suppress ctxt) <+> ppr suppress_after) ; return (ctxt', nos) } where (yeses, nos) = partition (\ct -> keep_me ct (classifyPredType (ctPred ct))) cts diff --git a/testsuite/tests/module/T7765.hs b/testsuite/tests/partial-sigs/should_compile/T12156.hs similarity index 51% copy from testsuite/tests/module/T7765.hs copy to testsuite/tests/partial-sigs/should_compile/T12156.hs index 6ca9a1f..b8d639f 100644 --- a/testsuite/tests/module/T7765.hs +++ b/testsuite/tests/partial-sigs/should_compile/T12156.hs @@ -1 +1,4 @@ module Main where + +main = print v + diff --git a/testsuite/tests/partial-sigs/should_compile/T12156.stderr b/testsuite/tests/partial-sigs/should_compile/T12156.stderr new file mode 100644 index 0000000..6508d8a --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T12156.stderr @@ -0,0 +1,3 @@ + +T12156.hs:3:14: warning: [-Wtyped-holes (in -Wdefault)] + Variable not in scope: v diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T index 262bf7e..f4b869c 100644 --- a/testsuite/tests/partial-sigs/should_compile/all.T +++ b/testsuite/tests/partial-sigs/should_compile/all.T @@ -64,3 +64,4 @@ test('SuperCls', normal, compile, ['']) test('T12033', normal, compile, ['']) test('T11339a', normal, compile, ['']) test('T11670', normal, compile, ['']) +test('T12156', normal, compile, ['-fdefer-typed-holes']) From git at git.haskell.org Tue Jun 28 12:37:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 12:37:50 +0000 (UTC) Subject: [commit: ghc] master: Deal correctly with unused imports for 'coerce' (23b80ac) Message-ID: <20160628123750.065B33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23b80ac41cc945cea0fc6ff9ade6b4be8aa81b7f/ghc >--------------------------------------------------------------- commit 23b80ac41cc945cea0fc6ff9ade6b4be8aa81b7f Author: Simon Peyton Jones Date: Tue Jun 28 12:13:13 2016 +0100 Deal correctly with unused imports for 'coerce' We only do newtype unwrapping for Coercible constraints if the newtype's data constructor is in scope. We were trying to record the fact that the data constructor was thereby 'used', so that an import statement would not be flagged as unnecsssary (by -Wunused-imports). But the code was simply wrong. It was wrong because it assumed that only one level of unwrapping happened, whereas tcTopNormaliseNewTypeTF_maybe actually unwraps multiple layers. So we need to return a /list/ of data constructors that are used. This entailed a bit of refactoring, as usual. Fixes Trac #12067 >--------------------------------------------------------------- 23b80ac41cc945cea0fc6ff9ade6b4be8aa81b7f compiler/typecheck/FamInst.hs | 36 ++++++---- compiler/typecheck/TcCanonical.hs | 22 +++--- compiler/typecheck/TcSMonad.hs | 8 +-- compiler/types/Coercion.hs | 80 ++++++++++++---------- compiler/types/FamInstEnv.hs | 2 +- compiler/types/TyCon.hs | 5 ++ testsuite/tests/typecheck/should_compile/T12067.hs | 9 +++ .../tests/typecheck/should_compile/T12067a.hs | 6 ++ testsuite/tests/typecheck/should_compile/all.T | 2 + 9 files changed, 102 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 23b80ac41cc945cea0fc6ff9ade6b4be8aa81b7f From git at git.haskell.org Tue Jun 28 12:37:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 12:37:52 +0000 (UTC) Subject: [commit: ghc] master: Wibble error message for #11471 (dc62a22) Message-ID: <20160628123752.A852D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dc62a22279846abe7e84ef57896f0a38f6b7b845/ghc >--------------------------------------------------------------- commit dc62a22279846abe7e84ef57896f0a38f6b7b845 Author: Simon Peyton Jones Date: Tue Jun 28 13:39:51 2016 +0100 Wibble error message for #11471 I'm not quite sure why this changed with my two recent commits, but it /has/ changed (in a benign way) so I'm accepting it. Maybe it wasn't me anyway... but life is short and I'm not inclined to dig further. >--------------------------------------------------------------- dc62a22279846abe7e84ef57896f0a38f6b7b845 testsuite/tests/dependent/should_fail/T11471.stderr | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/dependent/should_fail/T11471.stderr b/testsuite/tests/dependent/should_fail/T11471.stderr index 0578910..80c5fc6 100644 --- a/testsuite/tests/dependent/should_fail/T11471.stderr +++ b/testsuite/tests/dependent/should_fail/T11471.stderr @@ -16,3 +16,4 @@ T11471.hs:15:35: error: • In the second argument of ‘f’, namely ‘3#’ In the expression: f (undefined :: Proxy Int#) 3# In an equation for ‘bad’: bad = f (undefined :: Proxy Int#) 3# + • Relevant bindings include bad :: F Int# (bound at T11471.hs:15:1) From git at git.haskell.org Tue Jun 28 14:04:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 28 Jun 2016 14:04:01 +0000 (UTC) Subject: [commit: ghc] master: Stop the simplifier from removing StaticPtr binds. (dd92c67) Message-ID: <20160628140401.20EBF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dd92c67be573604290560b93890ce4b8eccd40b3/ghc >--------------------------------------------------------------- commit dd92c67be573604290560b93890ce4b8eccd40b3 Author: Facundo Domínguez Date: Mon Jun 27 22:30:50 2016 -0300 Stop the simplifier from removing StaticPtr binds. Summary: We have the FloatOut pass create exported ids for floated StaticPtr bindings. The simplifier doesn't try to remove those. This patch also improves on 7fc20b by making a common definition collectStaticPtrSatArgs to test for StaticPtr binds. Fixes #12207. Test Plan: ./validate Reviewers: simonpj, austin, bgamari, simonmar, goldfire Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2366 GHC Trac Issues: #12207 >--------------------------------------------------------------- dd92c67be573604290560b93890ce4b8eccd40b3 compiler/coreSyn/CoreLint.hs | 5 +---- compiler/coreSyn/CoreUtils.hs | 28 +++++++++++++++++++++++++++- compiler/main/TidyPgm.hs | 10 +++------- compiler/simplCore/SetLevels.hs | 18 +++++++++++++++--- compiler/simplCore/SimplCore.hs | 18 ++++++++++++++++-- testsuite/tests/codeGen/should_run/all.T | 4 +--- testsuite/tests/rts/all.T | 8 ++------ 7 files changed, 65 insertions(+), 26 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc dd92c67be573604290560b93890ce4b8eccd40b3 From git at git.haskell.org Wed Jun 29 09:38:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 29 Jun 2016 09:38:24 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #12185 (2e9079f) Message-ID: <20160629093824.CCD543A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2e9079ff2be2bbd65e399ef68b46439dbde04961/ghc >--------------------------------------------------------------- commit 2e9079ff2be2bbd65e399ef68b46439dbde04961 Author: Simon Peyton Jones Date: Wed Jun 29 10:41:55 2016 +0100 Test Trac #12185 >--------------------------------------------------------------- 2e9079ff2be2bbd65e399ef68b46439dbde04961 testsuite/tests/typecheck/should_compile/T12185.hs | 20 ++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 21 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T12185.hs b/testsuite/tests/typecheck/should_compile/T12185.hs new file mode 100644 index 0000000..d2007db --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T12185.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE FlexibleContexts, RankNTypes, TypeFamilies #-} + +module T12185 where + +class Foo a + +newtype Bar r = Pow r deriving (Eq) + +instance (Foo r) => Foo (Bar r) + +type family Ctx a where Ctx t = (Foo (Bar t), Eq (Bar t)) + +run :: (forall t . (Ctx t) => t -> Int) -> Int +run g = undefined + +foo :: (Foo (Bar t)) => t -> Int +foo = undefined + +main :: IO () +main = print $ run foo diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 9843539..33d91d1 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -529,3 +529,4 @@ test('T11339d', normal, compile, ['']) test('T11974', normal, compile, ['']) test('T12067', extra_clean(['T12067a.hi', 'T12067a.o']), multimod_compile, ['T12067', '-v0']) +test('T12185', normal, compile, ['']) From git at git.haskell.org Wed Jun 29 11:13:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 29 Jun 2016 11:13:33 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: fixes for python2.6 support (848e3ce) Message-ID: <20160629111333.153993A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/848e3ceb881ef5a5bbfe23965b75d22f96a21229/ghc >--------------------------------------------------------------- commit 848e3ceb881ef5a5bbfe23965b75d22f96a21229 Author: Thomas Miedema Date: Wed Jun 29 13:16:05 2016 +0200 Testsuite: fixes for python2.6 support >--------------------------------------------------------------- 848e3ceb881ef5a5bbfe23965b75d22f96a21229 testsuite/driver/testlib.py | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 6d4d77c..79ac62b 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1236,7 +1236,7 @@ def simple_run(name, way, prog, extra_run_opts): def rts_flags(way): args = config.way_rts_flags.get(way, []) - return '+RTS {} -RTS'.format(' '.join(args)) if args else '' + return '+RTS {0} -RTS'.format(' '.join(args)) if args else '' # ----------------------------------------------------------------------------- # Run a program in the interpreter and check its output @@ -1898,9 +1898,9 @@ def summary(t, file, short=False): file.write('WARNING: Testsuite run was terminated early\n') def printUnexpectedTests(file, testInfoss): - unexpected = {name for testInfos in testInfoss + unexpected = set(name for testInfos in testInfoss for (_, name, _, _) in testInfos - if not name.endswith('.T')} + if not name.endswith('.T')) if unexpected: file.write('Unexpected results from:\n') file.write('TEST="' + ' '.join(unexpected) + '"\n') From git at git.haskell.org Wed Jun 29 12:51:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 29 Jun 2016 12:51:03 +0000 (UTC) Subject: [commit: ghc] master: Refactor match to not use Unique order (9a645a1) Message-ID: <20160629125103.4DEC73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9a645a1687aca21f965206f1d8c8bb23dd6410e5/ghc >--------------------------------------------------------------- commit 9a645a1687aca21f965206f1d8c8bb23dd6410e5 Author: Bartosz Nitka Date: Wed Jun 29 03:27:49 2016 -0700 Refactor match to not use Unique order Unique order can introduce nondeterminism. As a step towards removing the Ord Unique instance I've refactored the code to use deterministic sets instead. Test Plan: ./validate Reviewers: simonmar, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2369 GHC Trac Issues: #4012 >--------------------------------------------------------------- 9a645a1687aca21f965206f1d8c8bb23dd6410e5 compiler/deSugar/Match.hs | 32 +++++++++++++++++++++++--------- 1 file changed, 23 insertions(+), 9 deletions(-) diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs index fc70cc6..ecbed46 100644 --- a/compiler/deSugar/Match.hs +++ b/compiler/deSugar/Match.hs @@ -46,6 +46,8 @@ import Util import Name import Outputable import BasicTypes ( isGenerated ) +import Unique +import UniqDFM import Control.Monad( when, unless ) import qualified Data.Map as Map @@ -196,9 +198,9 @@ match vars@(v:_) ty eqns -- Eqns *can* be empty match_group [] = panic "match_group" match_group eqns@((group,_) : _) = case group of - PgCon {} -> matchConFamily vars ty (subGroup [(c,e) | (PgCon c, e) <- eqns]) + PgCon {} -> matchConFamily vars ty (subGroupUniq [(c,e) | (PgCon c, e) <- eqns]) PgSyn {} -> matchPatSyn vars ty (dropGroup eqns) - PgLit {} -> matchLiterals vars ty (subGroup [(l,e) | (PgLit l, e) <- eqns]) + PgLit {} -> matchLiterals vars ty (subGroupOrd [(l,e) | (PgLit l, e) <- eqns]) PgAny -> matchVariables vars ty (dropGroup eqns) PgN {} -> matchNPats vars ty (dropGroup eqns) PgNpK {} -> matchNPlusKPats vars ty (dropGroup eqns) @@ -809,22 +811,34 @@ groupEquations dflags eqns same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool (pg1,_) `same_gp` (pg2,_) = pg1 `sameGroup` pg2 -subGroup :: Ord a => [(a, EquationInfo)] -> [[EquationInfo]] +subGroup :: (m -> [[EquationInfo]]) -- Map.elems + -> m -- Map.empty + -> (a -> m -> Maybe [EquationInfo]) -- Map.lookup + -> (a -> [EquationInfo] -> m -> m) -- Map.insert + -> [(a, EquationInfo)] -> [[EquationInfo]] -- Input is a particular group. The result sub-groups the -- equations by with particular constructor, literal etc they match. -- Each sub-list in the result has the same PatGroup -- See Note [Take care with pattern order] -subGroup group - = map reverse $ Map.elems $ foldl accumulate Map.empty group +-- Parameterized by map operations to allow different implementations +-- and constraints, eg. types without Ord instance. +subGroup elems empty lookup insert group + = map reverse $ elems $ foldl accumulate empty group where accumulate pg_map (pg, eqn) - = case Map.lookup pg pg_map of - Just eqns -> Map.insert pg (eqn:eqns) pg_map - Nothing -> Map.insert pg [eqn] pg_map - + = case lookup pg pg_map of + Just eqns -> insert pg (eqn:eqns) pg_map + Nothing -> insert pg [eqn] pg_map -- pg_map :: Map a [EquationInfo] -- Equations seen so far in reverse order of appearance +subGroupOrd :: Ord a => [(a, EquationInfo)] -> [[EquationInfo]] +subGroupOrd = subGroup Map.elems Map.empty Map.lookup Map.insert + +subGroupUniq :: Uniquable a => [(a, EquationInfo)] -> [[EquationInfo]] +subGroupUniq = + subGroup eltsUDFM emptyUDFM (flip lookupUDFM) (\k v m -> addToUDFM m k v) + {- Note [Pattern synonym groups] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If we see From git at git.haskell.org Wed Jun 29 13:06:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 29 Jun 2016 13:06:46 +0000 (UTC) Subject: [commit: ghc] master: Double the file descriptor limit for openFile008 (8f7194f) Message-ID: <20160629130646.24F373A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8f7194fae23bdc6db72fc5784933f50310ce51f9/ghc >--------------------------------------------------------------- commit 8f7194fae23bdc6db72fc5784933f50310ce51f9 Author: Bartosz Nitka Date: Wed Jun 29 06:10:20 2016 -0700 Double the file descriptor limit for openFile008 I have get test failures on `openFile008` with `openFile: resource exhausted (Too many open files)` when running inside `./validate`, but not when I run the test individually. I suspect that's because with `./validate` parallelism of 33 threads I go just above the `1024` file descriptor limit. This is probably related to the recent change: `58f0086b70f2: Testsuite: open/close stdin/stdout/stderr explicitly` but I haven't looked deep enough to understand exactly how. I think bumping this is harmless, but I don't really know why it's necessary at all. Test Plan: ./validate Reviewers: austin, thomie, hvr, bgamari, simonmar Reviewed By: simonmar Subscribers: simonmar Differential Revision: https://phabricator.haskell.org/D2368 >--------------------------------------------------------------- 8f7194fae23bdc6db72fc5784933f50310ce51f9 libraries/base/tests/IO/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/tests/IO/all.T b/libraries/base/tests/IO/all.T index 56bb44d..44619dc 100644 --- a/libraries/base/tests/IO/all.T +++ b/libraries/base/tests/IO/all.T @@ -75,7 +75,7 @@ test('openFile005', extra_clean(['openFile005.out1', 'openFile005.out2']), compile_and_run, ['']) test('openFile006', extra_clean(['openFile006.out']), compile_and_run, ['']) test('openFile007', extra_clean(['openFile007.out']), compile_and_run, ['']) -test('openFile008', cmd_prefix('ulimit -n 1024; '), compile_and_run, ['']) +test('openFile008', cmd_prefix('ulimit -n 2048; '), compile_and_run, ['']) test('putStr001', normal, compile_and_run, ['']) test('readFile001', extra_clean(['readFile001.out']), From git at git.haskell.org Wed Jun 29 15:52:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 29 Jun 2016 15:52:57 +0000 (UTC) Subject: [commit: packages/hpc] master: Testsuite: only ignore stdout for T9619 and hpc_raytrace (956887d) Message-ID: <20160629155257.A1FB63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/956887d4a15de3e68aae82b14bfa1630c8149649 >--------------------------------------------------------------- commit 956887d4a15de3e68aae82b14bfa1630c8149649 Author: Thomas Miedema Date: Sat Jun 25 00:40:11 2016 +0200 Testsuite: only ignore stdout for T9619 and hpc_raytrace >--------------------------------------------------------------- 956887d4a15de3e68aae82b14bfa1630c8149649 tests/raytrace/test.T | 4 ++-- tests/simple/tixs/test.T | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/raytrace/test.T b/tests/raytrace/test.T index 2f4e51a..220cf6d 100644 --- a/tests/raytrace/test.T +++ b/tests/raytrace/test.T @@ -4,13 +4,13 @@ hpc_prefix = "perl hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" # TODO. It is unclear what the purpose of this test is. It produces lots of # output, but the expected output file is missing. I (thomie) added -# the ignore_output setup function, just to make the test pass for the +# the ignore_stdout setup function, just to make the test pass for the # moment. # Note that the subdirectory tixs also has a test.T file, and those tests # depend on some of the files in this directory. # Also note that testsuite/tests/programs/galois_raytrace has a similar (but # not the same) copy of this program. test('hpc_raytrace', - [cmd_prefix(hpc_prefix), reqlib('parsec'), ignore_output], + [cmd_prefix(hpc_prefix), reqlib('parsec'), ignore_stdout], multimod_compile_and_run, ['Main','-fhpc -package parsec']) diff --git a/tests/simple/tixs/test.T b/tests/simple/tixs/test.T index a32b4a9..19fae7e 100644 --- a/tests/simple/tixs/test.T +++ b/tests/simple/tixs/test.T @@ -68,7 +68,7 @@ test('hpc_hand_overlay', test('hpc_bad_001', exit_code(1), run_command, ["{hpc} bad arguments"]) -test('T9619', ignore_output, run_command, +test('T9619', ignore_stdout, run_command, # Having the same mix file in two different hpcdirs should work. ["{hpc} report hpc_sample.tix --hpcdir=.hpc --hpcdir=.hpc.copy"]) From git at git.haskell.org Wed Jun 29 15:53:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 29 Jun 2016 15:53:34 +0000 (UTC) Subject: [commit: packages/stm] master: Testsuite: only ignore stdout of T2411 (fe88993) Message-ID: <20160629155334.31E7E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/stm On branch : master Link : http://git.haskell.org/packages/stm.git/commitdiff/fe8899331e6ca7bdf80d57cf77dd597023ae4718 >--------------------------------------------------------------- commit fe8899331e6ca7bdf80d57cf77dd597023ae4718 Author: Thomas Miedema Date: Sat Jun 25 00:38:09 2016 +0200 Testsuite: only ignore stdout of T2411 >--------------------------------------------------------------- fe8899331e6ca7bdf80d57cf77dd597023ae4718 tests/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/all.T b/tests/all.T index 26000af..213ea75 100644 --- a/tests/all.T +++ b/tests/all.T @@ -23,7 +23,7 @@ test('stm060', normal, compile_and_run, ['-package stm']) test('stm061', normal, compile_and_run, ['-package stm']) test('stm062', normal, compile_and_run, ['-package stm']) test('stm063', when(fast(),skip), compile_and_run, ['-package stm']) -test('T2411', ignore_output, compile_and_run, ['-package stm']) +test('T2411', ignore_stdout, compile_and_run, ['-package stm']) test('T3049', normal, compile_and_run, ['-package stm']) test('T4057', normal, compile_and_run, ['-package stm']) test('stm064', normal, compile_and_run, ['-package stm']) From git at git.haskell.org Wed Jun 29 16:16:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 29 Jun 2016 16:16:57 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: use ignore_stderr/stdout instead of ignore_output (1084d37) Message-ID: <20160629161657.AFEF03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1084d3755cac6ccd90f8decc0d79c315387ae388/ghc >--------------------------------------------------------------- commit 1084d3755cac6ccd90f8decc0d79c315387ae388 Author: Thomas Miedema Date: Fri Jun 24 20:45:04 2016 +0200 Testsuite: use ignore_stderr/stdout instead of ignore_output The problem with ignore_output is that it hides errors for WAY=ghci. GHCi always returns with exit code 0 (unless it is broken itself). For example: ghci015 must have been failing with compile errors for years, but we didn't notice because all output was ignored. Therefore, replace all uses of ignore_output with either ignore_stderr or ignore_stdout. In some cases I opted for adding the expected output. Update submodule hpc and stm. Reviewed by: simonmar Differential Revision: https://phabricator.haskell.org/D2367 >--------------------------------------------------------------- 1084d3755cac6ccd90f8decc0d79c315387ae388 libraries/base/tests/all.T | 8 --- libraries/base/tests/topHandler03.stderr | 1 + libraries/hpc | 2 +- libraries/stm | 2 +- testsuite/driver/extra_files.py | 1 + testsuite/driver/testglobals.py | 6 +- testsuite/driver/testlib.py | 49 +++++++------- testsuite/tests/cabal/Makefile | 3 +- testsuite/tests/cabal/all.T | 16 ++++- testsuite/tests/cabal/cabal03/Makefile | 8 +-- testsuite/tests/cabal/cabal03/all.T | 2 +- testsuite/tests/cabal/cabal03/cabal03.stderr | 4 ++ testsuite/tests/cabal/cabal05/all.T | 2 +- testsuite/tests/cabal/cabal05/cabal05.stderr | 5 ++ testsuite/tests/cabal/cabal09/all.T | 2 +- testsuite/tests/cabal/ghcpkg04.stderr | 4 +- testsuite/tests/concurrent/should_run/all.T | 6 +- testsuite/tests/dph/enumfromto/dph-enumfromto.T | 3 +- testsuite/tests/driver/Makefile | 8 +-- testsuite/tests/driver/all.T | 6 +- testsuite/tests/ghc-e/should_fail/Makefile | 14 ++-- testsuite/tests/ghc-e/should_fail/T7962.stderr | 3 + .../tests/ghc-e/should_fail/T9905fail1.stderr | 4 ++ .../tests/ghc-e/should_fail/T9905fail2.stderr | 3 + .../tests/ghc-e/should_fail/T9905fail3.stderr | 2 + testsuite/tests/ghc-e/should_fail/T9930fail.stderr | 2 + testsuite/tests/ghc-e/should_fail/all.T | 14 ++-- .../tests/ghc-e/should_fail/ghc-e-fail1.stderr | 3 + .../tests/ghc-e/should_fail/ghc-e-fail2.stderr | 4 ++ testsuite/tests/ghci/scripts/all.T | 8 ++- testsuite/tests/ghci/scripts/ghci015.hs | 4 +- testsuite/tests/hpc/all.T | 2 +- testsuite/tests/perf/should_run/all.T | 4 +- testsuite/tests/rts/T11223/all.T | 2 +- .../tests/{ghc-api/T7478/C.hs => rts/T9839_01.hs} | 0 testsuite/tests/rts/T9839_01.stderr | 1 + testsuite/tests/rts/T9839_02.stderr | 1 + testsuite/tests/rts/T9839_03.stderr | 1 + testsuite/tests/rts/T9839_05.stderr | 1 + testsuite/tests/rts/T9839_06.stderr | 1 + testsuite/tests/rts/all.T | 74 +++++++++++++--------- 41 files changed, 174 insertions(+), 112 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 1084d3755cac6ccd90f8decc0d79c315387ae388 From git at git.haskell.org Thu Jun 30 07:25:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 07:25:16 +0000 (UTC) Subject: [commit: ghc] master: Fix pretty-printer for IfaceCo (24194a6) Message-ID: <20160630072516.304283A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/24194a6aed950ed4c3733e3c582abf8a15d98ffd/ghc >--------------------------------------------------------------- commit 24194a6aed950ed4c3733e3c582abf8a15d98ffd Author: Simon Peyton Jones Date: Wed Jun 29 23:21:49 2016 +0100 Fix pretty-printer for IfaceCo As Trac #12242 showed, there was a missing case in the pretty printer for IfaceCo. I've refactored it so that the pattern-match ovelap checker will spot it next time. >--------------------------------------------------------------- 24194a6aed950ed4c3733e3c582abf8a15d98ffd compiler/iface/IfaceType.hs | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 27f2776..f200872 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -910,17 +910,22 @@ ppr_co ctxt_prec (IfaceInstCo co ty) ppr_co ctxt_prec (IfaceAxiomRuleCo tc cos) = maybeParen ctxt_prec TyConPrec $ ppr tc <+> parens (interpp'SP cos) -ppr_co ctxt_prec co - = ppr_special_co ctxt_prec doc cos - where (doc, cos) = case co of - { IfaceAxiomInstCo n i cos -> (ppr n <> brackets (ppr i), cos) - ; IfaceSymCo co -> (text "Sym", [co]) - ; IfaceTransCo co1 co2 -> (text "Trans", [co1,co2]) - ; IfaceNthCo d co -> (text "Nth:" <> int d, - [co]) - ; IfaceLRCo lr co -> (ppr lr, [co]) - ; IfaceSubCo co -> (text "Sub", [co]) - ; _ -> panic "pprIfaceCo" } +ppr_co ctxt_prec (IfaceAxiomInstCo n i cos) + = ppr_special_co ctxt_prec (ppr n <> brackets (ppr i)) cos +ppr_co ctxt_prec (IfaceSymCo co) + = ppr_special_co ctxt_prec (text "Sym") [co] +ppr_co ctxt_prec (IfaceTransCo co1 co2) + = ppr_special_co ctxt_prec (text "Trans") [co1,co2] +ppr_co ctxt_prec (IfaceNthCo d co) + = ppr_special_co ctxt_prec (text "Nth:" <> int d) [co] +ppr_co ctxt_prec (IfaceLRCo lr co) + = ppr_special_co ctxt_prec (ppr lr) [co] +ppr_co ctxt_prec (IfaceSubCo co) + = ppr_special_co ctxt_prec (text "Sub") [co] +ppr_co ctxt_prec (IfaceCoherenceCo co1 co2) + = ppr_special_co ctxt_prec (text "Coh") [co1,co2] +ppr_co ctxt_prec (IfaceKindCo co) + = ppr_special_co ctxt_prec (text "Kind") [co] ppr_special_co :: TyPrec -> SDoc -> [IfaceCoercion] -> SDoc ppr_special_co ctxt_prec doc cos From git at git.haskell.org Thu Jun 30 08:40:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 08:40:10 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: do not depend on sys.stdout.encoding (e8d6271) Message-ID: <20160630084010.AB8B73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e8d62711e6cbc3065ee5e6f6a654667f02a0bcd1/ghc >--------------------------------------------------------------- commit e8d62711e6cbc3065ee5e6f6a654667f02a0bcd1 Author: Thomas Miedema Date: Wed Jun 29 22:56:58 2016 +0200 Testsuite: do not depend on sys.stdout.encoding The cause of #12213 is in dump_stdout and dump_stderr: print(read_no_crs()) Commit 6f6f515401a29d26eaa5daae308b8e700abd4c04 changed read_no_crs to return a unicode string. Printing a unicode strings works fine as long as sys.stdout.encoding is 'UTF-8'. There are two reasons why sys.stdout.encoding might not be 'UTF-8'. * When output is going to a file, sys.stdout and sys.stdout do not respect the locale: $ LC_ALL=en_US.utf8 python -c 'import sys; print(sys.stderr.encoding)' UTF-8 $ LC_ALL=en_US.utf8 python -c 'import sys; print(sys.stderr.encoding)' 2>/dev/null None * When output is going to the terminal, explicitly reopening sys.stdout has the side-effect of changing sys.stdout.encoding from 'UTF-8' to 'None'. sys.stdout = os.fdopen(sys.__stdout__.fileno(), "w", 0) We currently do this to set a buffersize of 0 (the actual buffersize used is irrelevant for the sys.stdout.encoding problem). Solution: fix dump_stdout and dump_stderr to not use read_no_crs. >--------------------------------------------------------------- e8d62711e6cbc3065ee5e6f6a654667f02a0bcd1 testsuite/driver/testlib.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 493e52b..595baab 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1366,7 +1366,7 @@ def stdout_ok(name, way): def dump_stdout( name ): print('Stdout:') - print(read_no_crs(in_testdir(name, 'run.stdout'))) + print(open(in_testdir(name, 'run.stdout')).read()) def stderr_ok(name, way): actual_stderr_file = add_suffix(name, 'run.stderr') @@ -1379,7 +1379,7 @@ def stderr_ok(name, way): def dump_stderr( name ): print("Stderr:") - print(read_no_crs(in_testdir(name, 'run.stderr'))) + print(open(in_testdir(name, 'run.stderr')).read()) def read_no_crs(file): str = '' From git at git.haskell.org Thu Jun 30 10:18:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 10:18:38 +0000 (UTC) Subject: [commit: ghc] branch 'wip/check-uniques-fix' created Message-ID: <20160630101838.4F7353A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/check-uniques-fix Referencing: a038d43bd7c8148be0ff532c981f58b448a3cd90 From git at git.haskell.org Thu Jun 30 10:18:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 10:18:41 +0000 (UTC) Subject: [commit: ghc] wip/check-uniques-fix: CheckUniques: Decode source files as UTF-8 (a038d43) Message-ID: <20160630101841.181A93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/check-uniques-fix Link : http://ghc.haskell.org/trac/ghc/changeset/a038d43bd7c8148be0ff532c981f58b448a3cd90/ghc >--------------------------------------------------------------- commit a038d43bd7c8148be0ff532c981f58b448a3cd90 Author: Ben Gamari Date: Thu Jun 30 12:17:49 2016 +0200 CheckUniques: Decode source files as UTF-8 >--------------------------------------------------------------- a038d43bd7c8148be0ff532c981f58b448a3cd90 utils/checkUniques/check-uniques.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/checkUniques/check-uniques.py b/utils/checkUniques/check-uniques.py index 42b375e..0ab1cfd 100755 --- a/utils/checkUniques/check-uniques.py +++ b/utils/checkUniques/check-uniques.py @@ -12,7 +12,7 @@ def find_uniques(source_files): uniques = defaultdict(lambda: defaultdict(lambda: set())) unique_re = re.compile(r"([\w\d]+)\s*=\s*mk([\w\d']+)Unique\s+(\d+)") for f in source_files: - ms = unique_re.findall(open(f).read()) + ms = unique_re.findall(open(f).read().decode('utf8')) for m in ms: name = m[0] _type = m[1] From git at git.haskell.org Thu Jun 30 12:53:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 12:53:16 +0000 (UTC) Subject: [commit: ghc] master: Delete Ord Unique (fb6e2c7) Message-ID: <20160630125316.A1BAE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fb6e2c7fe213004c7398a13e3cc38d4428b66b12/ghc >--------------------------------------------------------------- commit fb6e2c7fe213004c7398a13e3cc38d4428b66b12 Author: Bartosz Nitka Date: Wed Jun 29 07:34:55 2016 -0700 Delete Ord Unique Ord Unique can be a source of invisible, accidental nondeterminism as explained in Note [No Ord for Unique]. This removes it, leaving a note with rationale. It's unfortunate that I had to write Ord instances for codegen data structures by hand, but I believe that it's a right trade-off here. Test Plan: ./validate Reviewers: simonmar, austin, bgamari Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2370 GHC Trac Issues: #4012 >--------------------------------------------------------------- fb6e2c7fe213004c7398a13e3cc38d4428b66b12 compiler/basicTypes/DataCon.hs | 7 --- compiler/basicTypes/DataCon.hs-boot | 1 - compiler/basicTypes/Module.hs | 4 +- compiler/basicTypes/Unique.hs | 47 +++++++++++++++----- compiler/cmm/CLabel.hs | 87 ++++++++++++++++++++++++++++++++++++- compiler/cmm/CmmCommonBlockElim.hs | 8 ++-- compiler/cmm/CmmExpr.hs | 5 ++- compiler/cmm/CmmNode.hs | 22 +++++++--- compiler/nativeGen/Reg.hs | 23 +++++++++- 9 files changed, 169 insertions(+), 35 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc fb6e2c7fe213004c7398a13e3cc38d4428b66b12 From git at git.haskell.org Thu Jun 30 13:59:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 13:59:17 +0000 (UTC) Subject: [commit: ghc] master: Add a new determinism test (9854f14) Message-ID: <20160630135917.4A4853A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9854f14ef0a3a6f399a1aa4c141c5e3dddcd77ff/ghc >--------------------------------------------------------------- commit 9854f14ef0a3a6f399a1aa4c141c5e3dddcd77ff Author: Bartosz Nitka Date: Thu Jun 30 06:59:02 2016 -0700 Add a new determinism test This is one of the testcases that I forgot to commit >--------------------------------------------------------------- 9854f14ef0a3a6f399a1aa4c141c5e3dddcd77ff testsuite/driver/extra_files.py | 1 + testsuite/tests/determinism/determ021/A.hs | 8 ++++++++ .../determinism/{determ003 => determ021}/Makefile | 2 +- .../determinism/{determ009 => determ021}/all.T | 4 ++-- .../tests/determinism/determ021/determ021.stdout | 22 ++++++++++++++++++++++ 5 files changed, 34 insertions(+), 3 deletions(-) diff --git a/testsuite/driver/extra_files.py b/testsuite/driver/extra_files.py index 43e78af..bc5d460 100644 --- a/testsuite/driver/extra_files.py +++ b/testsuite/driver/extra_files.py @@ -202,6 +202,7 @@ extra_src_files = { 'determ017': ['A.hs'], 'determ018': ['A.hs'], 'determ019': ['A.hs'], + 'determ021': ['A.hs'], 'dodgy': ['DodgyA.hs'], 'driver011': ['A011.hs'], 'driver012': ['A012.hs'], diff --git a/testsuite/tests/determinism/determ021/A.hs b/testsuite/tests/determinism/determ021/A.hs new file mode 100644 index 0000000..773a012 --- /dev/null +++ b/testsuite/tests/determinism/determ021/A.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# OPTIONS_GHC -ddump-types #-} +module A where + +test2 f = do + x <- f 3 + y <- f 4 + return (x + y) diff --git a/testsuite/tests/determinism/determ003/Makefile b/testsuite/tests/determinism/determ021/Makefile similarity index 96% copy from testsuite/tests/determinism/determ003/Makefile copy to testsuite/tests/determinism/determ021/Makefile index faff63e..e88edef 100644 --- a/testsuite/tests/determinism/determ003/Makefile +++ b/testsuite/tests/determinism/determ021/Makefile @@ -2,7 +2,7 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk -determ003: +determ021: $(RM) A.hi A.o '$(TEST_HC)' $(TEST_HC_OPTS) -O -dinitial-unique=0 -dunique-increment=1 A.hs $(CP) A.hi A.normal.hi diff --git a/testsuite/tests/determinism/determ009/all.T b/testsuite/tests/determinism/determ021/all.T similarity index 50% copy from testsuite/tests/determinism/determ009/all.T copy to testsuite/tests/determinism/determ021/all.T index 7cae393..35af362 100644 --- a/testsuite/tests/determinism/determ009/all.T +++ b/testsuite/tests/determinism/determ021/all.T @@ -1,4 +1,4 @@ -test('determ009', +test('determ021', extra_clean(['A.o', 'A.hi', 'A.normal.hi']), run_command, - ['$MAKE -s --no-print-directory determ009']) + ['$MAKE -s --no-print-directory determ021']) diff --git a/testsuite/tests/determinism/determ021/determ021.stdout b/testsuite/tests/determinism/determ021/determ021.stdout new file mode 100644 index 0000000..747064f --- /dev/null +++ b/testsuite/tests/determinism/determ021/determ021.stdout @@ -0,0 +1,22 @@ +[1 of 1] Compiling A ( A.hs, A.o ) +TYPE SIGNATURES + test2 :: + forall t b (f :: * -> *). + (Num b, Num t, Applicative f) => + (t -> f b) -> f b +TYPE CONSTRUCTORS +COERCION AXIOMS +Dependent modules: [] +Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0, + integer-gmp-1.0.0.1] +[1 of 1] Compiling A ( A.hs, A.o ) +TYPE SIGNATURES + test2 :: + forall t b (f :: * -> *). + (Num b, Num t, Applicative f) => + (t -> f b) -> f b +TYPE CONSTRUCTORS +COERCION AXIOMS +Dependent modules: [] +Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0, + integer-gmp-1.0.0.1] From git at git.haskell.org Thu Jun 30 14:17:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 14:17:28 +0000 (UTC) Subject: [commit: ghc] master: Reorganize some determinism tests (b6b20a5) Message-ID: <20160630141728.3A23A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b6b20a5074ad7d712b4d8448043fc25e4c7bcdaa/ghc >--------------------------------------------------------------- commit b6b20a5074ad7d712b4d8448043fc25e4c7bcdaa Author: Bartosz Nitka Date: Thu Jun 30 07:18:22 2016 -0700 Reorganize some determinism tests This directory structure makes it easier to find the tests >--------------------------------------------------------------- b6b20a5074ad7d712b4d8448043fc25e4c7bcdaa testsuite/tests/determinism/{should_compile => determ001}/Makefile | 0 testsuite/tests/determinism/{ => determ001}/all.T | 0 testsuite/tests/determinism/{ => determ001}/determinism001.hs | 0 testsuite/tests/determinism/{ => determ001}/determinism001.stdout | 0 .../{annotations/should_compile => determinism/determ004}/Makefile | 0 testsuite/tests/determinism/{should_compile => determ004}/all.T | 0 testsuite/tests/determinism/{should_compile => determ004}/determ004.hs | 0 testsuite/tests/determinism/{typecheck => determ005}/A.hs | 0 testsuite/tests/determinism/{typecheck => determ005}/Makefile | 0 testsuite/tests/determinism/{typecheck => determ005}/all.T | 0 testsuite/tests/determinism/{typecheck => determ005}/determ005.stdout | 0 .../tests/determinism/{simplCore/should_compile => determ006}/Makefile | 2 +- .../tests/determinism/{simplCore/should_compile => determ006}/all.T | 0 .../{simplCore/should_compile => determ006}/determ006.stdout | 0 .../{simplCore/should_compile => determ006}/spec-inline-determ.hs | 0 15 files changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/determinism/should_compile/Makefile b/testsuite/tests/determinism/determ001/Makefile similarity index 100% rename from testsuite/tests/determinism/should_compile/Makefile rename to testsuite/tests/determinism/determ001/Makefile diff --git a/testsuite/tests/determinism/all.T b/testsuite/tests/determinism/determ001/all.T similarity index 100% rename from testsuite/tests/determinism/all.T rename to testsuite/tests/determinism/determ001/all.T diff --git a/testsuite/tests/determinism/determinism001.hs b/testsuite/tests/determinism/determ001/determinism001.hs similarity index 100% rename from testsuite/tests/determinism/determinism001.hs rename to testsuite/tests/determinism/determ001/determinism001.hs diff --git a/testsuite/tests/determinism/determinism001.stdout b/testsuite/tests/determinism/determ001/determinism001.stdout similarity index 100% rename from testsuite/tests/determinism/determinism001.stdout rename to testsuite/tests/determinism/determ001/determinism001.stdout diff --git a/testsuite/tests/annotations/should_compile/Makefile b/testsuite/tests/determinism/determ004/Makefile similarity index 100% copy from testsuite/tests/annotations/should_compile/Makefile copy to testsuite/tests/determinism/determ004/Makefile diff --git a/testsuite/tests/determinism/should_compile/all.T b/testsuite/tests/determinism/determ004/all.T similarity index 100% rename from testsuite/tests/determinism/should_compile/all.T rename to testsuite/tests/determinism/determ004/all.T diff --git a/testsuite/tests/determinism/should_compile/determ004.hs b/testsuite/tests/determinism/determ004/determ004.hs similarity index 100% rename from testsuite/tests/determinism/should_compile/determ004.hs rename to testsuite/tests/determinism/determ004/determ004.hs diff --git a/testsuite/tests/determinism/typecheck/A.hs b/testsuite/tests/determinism/determ005/A.hs similarity index 100% rename from testsuite/tests/determinism/typecheck/A.hs rename to testsuite/tests/determinism/determ005/A.hs diff --git a/testsuite/tests/determinism/typecheck/Makefile b/testsuite/tests/determinism/determ005/Makefile similarity index 100% rename from testsuite/tests/determinism/typecheck/Makefile rename to testsuite/tests/determinism/determ005/Makefile diff --git a/testsuite/tests/determinism/typecheck/all.T b/testsuite/tests/determinism/determ005/all.T similarity index 100% rename from testsuite/tests/determinism/typecheck/all.T rename to testsuite/tests/determinism/determ005/all.T diff --git a/testsuite/tests/determinism/typecheck/determ005.stdout b/testsuite/tests/determinism/determ005/determ005.stdout similarity index 100% rename from testsuite/tests/determinism/typecheck/determ005.stdout rename to testsuite/tests/determinism/determ005/determ005.stdout diff --git a/testsuite/tests/determinism/simplCore/should_compile/Makefile b/testsuite/tests/determinism/determ006/Makefile similarity index 96% rename from testsuite/tests/determinism/simplCore/should_compile/Makefile rename to testsuite/tests/determinism/determ006/Makefile index 998e6ea..3e044cd 100644 --- a/testsuite/tests/determinism/simplCore/should_compile/Makefile +++ b/testsuite/tests/determinism/determ006/Makefile @@ -1,4 +1,4 @@ -TOP=../../../.. +TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk diff --git a/testsuite/tests/determinism/simplCore/should_compile/all.T b/testsuite/tests/determinism/determ006/all.T similarity index 100% rename from testsuite/tests/determinism/simplCore/should_compile/all.T rename to testsuite/tests/determinism/determ006/all.T diff --git a/testsuite/tests/determinism/simplCore/should_compile/determ006.stdout b/testsuite/tests/determinism/determ006/determ006.stdout similarity index 100% rename from testsuite/tests/determinism/simplCore/should_compile/determ006.stdout rename to testsuite/tests/determinism/determ006/determ006.stdout diff --git a/testsuite/tests/determinism/simplCore/should_compile/spec-inline-determ.hs b/testsuite/tests/determinism/determ006/spec-inline-determ.hs similarity index 100% rename from testsuite/tests/determinism/simplCore/should_compile/spec-inline-determ.hs rename to testsuite/tests/determinism/determ006/spec-inline-determ.hs From git at git.haskell.org Thu Jun 30 17:19:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 17:19:08 +0000 (UTC) Subject: [commit: ghc] master: Remove ufmToList (480e066) Message-ID: <20160630171908.171573A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/480e0661fb45395610d6b4a7c586a580d30d8df4/ghc >--------------------------------------------------------------- commit 480e0661fb45395610d6b4a7c586a580d30d8df4 Author: Bartosz Nitka Date: Thu Jun 30 08:20:41 2016 -0700 Remove ufmToList This documents nondeterminism in code generation and removes the nondeterministic ufmToList function. In the future someone will have to use nonDetUFMToList (with proper explanation) or pprUFMWithKeys. >--------------------------------------------------------------- 480e0661fb45395610d6b4a7c586a580d30d8df4 compiler/nativeGen/RegAlloc/Graph/Stats.hs | 4 +-- .../nativeGen/RegAlloc/Linear/JoinToTargets.hs | 15 ++++++++--- compiler/nativeGen/RegAlloc/Linear/Main.hs | 30 +++++++++++++++------- compiler/nativeGen/RegAlloc/Linear/Stats.hs | 3 +-- compiler/nativeGen/RegAlloc/Liveness.hs | 12 ++++++--- compiler/utils/UniqDFM.hs | 4 +-- compiler/utils/UniqFM.hs | 18 ++++++++++--- 7 files changed, 60 insertions(+), 26 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 480e0661fb45395610d6b4a7c586a580d30d8df4 From git at git.haskell.org Thu Jun 30 17:39:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 17:39:30 +0000 (UTC) Subject: [commit: ghc] master: Axe RecFlag on TyCons. (b8b3e30) Message-ID: <20160630173930.25F433A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b8b3e30a6eedf9f213b8a718573c4827cfa230ba/ghc >--------------------------------------------------------------- commit b8b3e30a6eedf9f213b8a718573c4827cfa230ba Author: Edward Z. Yang Date: Fri Jun 24 11:03:47 2016 -0700 Axe RecFlag on TyCons. Summary: This commit removes the information about whether or not a TyCon is "recursive", as well as the code responsible for calculating this information. The original trigger for this change was complexity regarding how we computed the RecFlag for hs-boot files. The problem is that in order to determine if a TyCon is recursive or not, we need to determine if it was defined in an hs-boot file (if so, we conservatively assume that it is recursive.) It turns that doing this is quite tricky. The "obvious" strategy is to typecheck the hi-boot file (since we are eventually going to need the typechecked types to check if we properly implemented the hi-boot file) and just extract the names of all defined TyCons from the ModDetails, but this actually does not work well if Names from the hi-boot file are being knot-tied via if_rec_types: the "extraction" process will force thunks, which will force the typechecking process earlier than we have actually defined the types locally. Rather than work around all this trickiness (it certainly can be worked around, either by making interface loading MORE lazy, or just reading of the set of defined TyCons directly from the ModIface), we instead opted to excise the source of the problem, the RecFlag. For one, it is not clear if the RecFlag even makes sense, in the presence of higher-orderness: data T f a = MkT (f a) T doesn't look recursive, but if we instantiate f with T, then it very well is! It was all very shaky. So we just don't bother anymore. This has two user-visible implications: 1. is_too_recursive now assumes that all TyCons are recursive and will bail out in a way that is still mysterious to me if there are too many TyCons. 2. checkRecTc, which is used when stripping newtypes to get to representation, also assumes all TyCons are recursive, and will stop running if we hit the limit. The biggest risk for this patch is that we specialize less than we used to; however, the codeGen tests still seem to be passing. Signed-off-by: Edward Z. Yang Reviewers: simonpj, austin, bgamari Subscribers: goldfire, thomie Differential Revision: https://phabricator.haskell.org/D2360 >--------------------------------------------------------------- b8b3e30a6eedf9f213b8a718573c4827cfa230ba compiler/basicTypes/DataCon.hs | 5 +- compiler/iface/BuildTyCl.hs | 5 +- compiler/iface/IfaceSyn.hs | 30 +--- compiler/iface/MkIface.hs | 5 +- compiler/iface/TcIface.hs | 8 +- compiler/prelude/TysWiredIn.hs | 49 +++--- compiler/specialise/SpecConstr.hs | 8 +- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 44 +++-- compiler/typecheck/TcTyDecls.hs | 234 +------------------------ compiler/types/TyCon.hs | 25 +-- compiler/vectorise/Vectorise/Generic/PData.hs | 3 - compiler/vectorise/Vectorise/Type/TyConDecl.hs | 11 +- 13 files changed, 79 insertions(+), 350 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 b8b3e30a6eedf9f213b8a718573c4827cfa230ba From git at git.haskell.org Thu Jun 30 17:58:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 17:58:27 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: Allow -fregs-graph to be used (6a5d13c) Message-ID: <20160630175827.D9BC03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6a5d13c4ade5bbb84873970065a1acd1546f6c31/ghc >--------------------------------------------------------------- commit 6a5d13c4ade5bbb84873970065a1acd1546f6c31 Author: Ben Gamari Date: Mon Jun 20 09:24:41 2016 +0200 nativeGen: Allow -fregs-graph to be used Previously the flag was silently ignored due the #7679 and #8657. This, however, seems unnecessarily brutal and makes experimentation unduly difficult for users. Test Plan: Validate Reviewers: austin, simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2335 GHC Trac Issues: #7679, #8657 >--------------------------------------------------------------- 6a5d13c4ade5bbb84873970065a1acd1546f6c31 compiler/nativeGen/AsmCodeGen.hs | 6 ++---- docs/users_guide/using-optimisation.rst | 28 +++++++++++++++++----------- 2 files changed, 19 insertions(+), 15 deletions(-) diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs index 2bf9e1c..094a908 100644 --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -535,10 +535,8 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count -- allocate registers (alloced, usAlloc, ppr_raStatsColor, ppr_raStatsLinear) <- - if False - -- Disabled, see #7679, #8657 - -- ( gopt Opt_RegsGraph dflags - -- || gopt Opt_RegsIterative dflags) + if ( gopt Opt_RegsGraph dflags + || gopt Opt_RegsIterative dflags ) then do -- the regs usable for allocation let (alloc_regs :: UniqFM (UniqSet RealReg)) diff --git a/docs/users_guide/using-optimisation.rst b/docs/users_guide/using-optimisation.rst index 9436510..6b58093 100644 --- a/docs/users_guide/using-optimisation.rst +++ b/docs/users_guide/using-optimisation.rst @@ -419,20 +419,26 @@ list. .. ghc-flag:: -fregs-graph - *Off by default due to a performance regression bug. Only applies in - combination with the native code generator.* Use the graph colouring - register allocator for register allocation in the native code - generator. By default, GHC uses a simpler, faster linear register - allocator. The downside being that the linear register allocator - usually generates worse code. + :default: off due to a performance regression bug (:ghc-ticket:`7679`) + + *Only applies in combination with the native code generator.* Use the graph + colouring register allocator for register allocation in the native code + generator. By default, GHC uses a simpler, faster linear register allocator. + The downside being that the linear register allocator usually generates + worse code. + + Note that the graph colouring allocator is a bit experimental and may fail + when faced with code with high register pressure :ghc-ticket:`8657`. .. ghc-flag:: -fregs-iterative - *Off by default, only applies in combination with the native code - generator.* Use the iterative coalescing graph colouring register - allocator for register allocation in the native code generator. This - is the same register allocator as the ``-fregs-graph`` one but also - enables iterative coalescing during register allocation. + :default: off + + *Only applies in combination with the native code generator.* Use the + iterative coalescing graph colouring register allocator for register + allocation in the native code generator. This is the same register allocator + as the :ghc-flag:`-fregs-graph` one but also enables iterative coalescing + during register allocation. .. ghc-flag:: -fsimplifier-phases= From git at git.haskell.org Thu Jun 30 17:58:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 17:58:31 +0000 (UTC) Subject: [commit: ghc] master: Trac #11554 fix loopy GADTs (430f5c8) Message-ID: <20160630175831.3063B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/430f5c84dac1eab550110d543831a70516b5cac8/ghc >--------------------------------------------------------------- commit 430f5c84dac1eab550110d543831a70516b5cac8 Author: Alexander Vieth Date: Mon Jun 20 09:22:18 2016 +0200 Trac #11554 fix loopy GADTs Summary: Fixes T11554 Reviewers: goldfire, thomie, simonpj, austin, bgamari Reviewed By: thomie, simonpj, bgamari Subscribers: simonpj, goldfire, thomie Differential Revision: https://phabricator.haskell.org/D2283 GHC Trac Issues: #11554 >--------------------------------------------------------------- 430f5c84dac1eab550110d543831a70516b5cac8 compiler/typecheck/TcHsType.hs | 26 +++++++++++++++++++++++++- docs/users_guide/bugs.rst | 7 ------- testsuite/tests/polykinds/T11554.hs | 10 ++++++++++ testsuite/tests/polykinds/T11554.stderr | 7 +++++++ testsuite/tests/polykinds/all.T | 1 + 5 files changed, 43 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 524e0b6..2d029b2 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -907,7 +907,11 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon ; case thing of ATyVar _ tv -> return (mkTyVarTy tv, tyVarKind tv) - ATcTyCon tc_tc -> do { check_tc tc_tc + ATcTyCon tc_tc -> do { -- See Note [GADT kind self-reference] + unless + (isTypeLevel (mode_level mode)) + (promotionErr name TyConPE) + ; check_tc tc_tc ; tc <- get_loopy_tc name tc_tc ; handle_tyfams tc tc_tc } -- mkNakedTyConApp: see Note [Type-checking inside the knot] @@ -1029,6 +1033,26 @@ look at the TyCon or Class involved. This is horribly delicate. I hate it. A good example of how delicate it is can be seen in Trac #7903. +Note [GADT kind self-reference] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +A promoted type cannot be used in the body of that type's declaration. +Trac #11554 shows this example, which made GHC loop: + + import Data.Kind + data P (x :: k) = Q + data A :: Type where + B :: forall (a :: A). P a -> A + +In order to check the constructor B, we need have the promoted type A, but in +order to get that promoted type, B must first be checked. To prevent looping, a +TyConPE promotion error is given when tcTyVar checks an ATcTyCon in kind mode. +Any ATcTyCon is a TyCon being defined in the current recursive group (see data +type decl for TcTyThing), and all such TyCons are illegal in kinds. + +Trac #11962 proposes checking the head of a data declaration separately from +its constructors. This would allow the example above to pass. + Note [Body kind of a HsForAllTy] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The body of a forall is usually a type, but in principle diff --git a/docs/users_guide/bugs.rst b/docs/users_guide/bugs.rst index ff83725..5b710aa 100644 --- a/docs/users_guide/bugs.rst +++ b/docs/users_guide/bugs.rst @@ -479,13 +479,6 @@ Bugs in GHC in the compiler's internal representation and can be unified producing unexpected results. See :ghc-ticket:`11715` for one example. -- :ghc-flag:`-XTypeInType` still has a few rough edges, especially where - it interacts with other advanced type-system features. For instance, - this definition causes the typechecker to loop (:ghc-ticket:`11559`), :: - - data A :: Type where - B :: forall (a :: A). A - .. _bugs-ghci: Bugs in GHCi (the interactive GHC) diff --git a/testsuite/tests/polykinds/T11554.hs b/testsuite/tests/polykinds/T11554.hs new file mode 100644 index 0000000..e7a35bd --- /dev/null +++ b/testsuite/tests/polykinds/T11554.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE GADTs, TypeInType, RankNTypes #-} + +module T11554 where + +import Data.Kind + +data P (x :: k) = Q + +data A :: Type where + B :: forall (a :: A). P a -> A diff --git a/testsuite/tests/polykinds/T11554.stderr b/testsuite/tests/polykinds/T11554.stderr new file mode 100644 index 0000000..e3045c8 --- /dev/null +++ b/testsuite/tests/polykinds/T11554.stderr @@ -0,0 +1,7 @@ + +T11554.hs:10:21: error: + • Type constructor ‘A’ cannot be used here + (it is defined and used in the same recursive group) + • In the kind ‘A’ + In the definition of data constructor ‘B’ + In the data declaration for ‘A’ diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index bcc8dc4..1c27dfd 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -148,5 +148,6 @@ test('T11648b', normal, compile_fail, ['']) test('KindVType', normal, compile_fail, ['']) test('T11821', normal, compile, ['']) test('T11640', normal, compile, ['']) +test('T11554', normal, compile_fail, ['']) test('T12055', normal, compile, ['']) test('T12055a', normal, compile_fail, ['']) From git at git.haskell.org Thu Jun 30 17:58:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 17:58:33 +0000 (UTC) Subject: [commit: ghc] master: Updates to handle new Cabal (0701db1) Message-ID: <20160630175834.002123A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0701db125eb32ed0a518d962c9e4ee279e3296fd/ghc >--------------------------------------------------------------- commit 0701db125eb32ed0a518d962c9e4ee279e3296fd Author: Edward Z. Yang Date: Mon Jun 20 09:02:34 2016 +0200 Updates to handle new Cabal Specifically per-component macros and multiple libraries. Contains Cabal submodule update. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: austin, bgamari Reviewed By: austin, bgamari Subscribers: hvr, thomie Differential Revision: https://phabricator.haskell.org/D2059 >--------------------------------------------------------------- 0701db125eb32ed0a518d962c9e4ee279e3296fd ghc/ghc.mk | 1 + iserv/ghc.mk | 1 + libraries/Cabal | 2 +- rules/build-package-data.mk | 2 +- rules/distdir-opts.mk | 6 +++--- rules/distdir-way-opts.mk | 17 ++++++++++++++--- rules/hs-sources.mk | 2 +- rules/hs-suffix-way-rules.mk | 4 ++-- utils/ghc-cabal/Main.hs | 19 +++++++++++-------- utils/ghc-pkg/Main.hs | 4 ++-- utils/ghctags/Main.hs | 13 +++++-------- 11 files changed, 42 insertions(+), 29 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 0701db125eb32ed0a518d962c9e4ee279e3296fd From git at git.haskell.org Thu Jun 30 17:58:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 17:58:36 +0000 (UTC) Subject: [commit: ghc] master: ghc-pkg: Drop trailing slashes in computing db paths (f68d40c) Message-ID: <20160630175836.A71E53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f68d40cbfc832a1dfc7742d02f76129ed80506e4/ghc >--------------------------------------------------------------- commit f68d40cbfc832a1dfc7742d02f76129ed80506e4 Author: Ben Gamari Date: Mon Jun 20 09:25:05 2016 +0200 ghc-pkg: Drop trailing slashes in computing db paths Test Plan: Validate, try tests in ticket Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2336 GHC Trac Issues: #12194 >--------------------------------------------------------------- f68d40cbfc832a1dfc7742d02f76129ed80506e4 utils/ghc-pkg/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 1b5f5e0..e0625fe 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -790,7 +790,7 @@ mungePackageDBPaths :: FilePath -> PackageDB -> PackageDB mungePackageDBPaths top_dir db at PackageDB { packages = pkgs } = db { packages = map (mungePackagePaths top_dir pkgroot) pkgs } where - pkgroot = takeDirectory (locationAbsolute db) + pkgroot = takeDirectory $ dropTrailingPathSeparator (locationAbsolute db) -- It so happens that for both styles of package db ("package.conf" -- files and "package.conf.d" dirs) the pkgroot is the parent directory -- ${pkgroot}/package.conf or ${pkgroot}/package.conf.d/ From git at git.haskell.org Thu Jun 30 17:58:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 17:58:39 +0000 (UTC) Subject: [commit: ghc] master: CmmExpr: remove unused `vgcFlag` function (f1e16e9) Message-ID: <20160630175839.52DAC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f1e16e92a97c61f89783274963a6bfe80bf9116c/ghc >--------------------------------------------------------------- commit f1e16e92a97c61f89783274963a6bfe80bf9116c Author: Michal Terepeta Date: Thu Jun 30 18:45:54 2016 +0200 CmmExpr: remove unused `vgcFlag` function Test Plan: validate Reviewers: austin, bgamari, simonmar Reviewed By: bgamari, simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2351 >--------------------------------------------------------------- f1e16e92a97c61f89783274963a6bfe80bf9116c compiler/cmm/CmmExpr.hs | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs index 7e4587e..de783aa 100644 --- a/compiler/cmm/CmmExpr.hs +++ b/compiler/cmm/CmmExpr.hs @@ -10,7 +10,7 @@ module CmmExpr , CmmLit(..), cmmLitType , LocalReg(..), localRegType , GlobalReg(..), isArgReg, globalRegType, spReg, hpReg, spLimReg, nodeReg, node, baseReg - , VGcPtr(..), vgcFlag -- Temporary! + , VGcPtr(..) , DefinerOfRegs, UserOfRegs , foldRegsDefd, foldRegsUsed, filterRegsUsed @@ -381,15 +381,10 @@ instance DefinerOfRegs r a => DefinerOfRegs r (Maybe a) where ----------------------------------------------------------------------------- data VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show ) - -- TEMPORARY!!! ----------------------------------------------------------------------------- -- Global STG registers ----------------------------------------------------------------------------- -vgcFlag :: CmmType -> VGcPtr -vgcFlag ty | isGcPtrType ty = VGcPtr - | otherwise = VNonGcPtr - {- Note [Overlapping global registers] From git at git.haskell.org Thu Jun 30 20:57:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 30 Jun 2016 20:57:35 +0000 (UTC) Subject: [commit: ghc] master: Fix check_uniques in non-unicode locale (b65363d) Message-ID: <20160630205735.BC7FF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b65363d3eaffd453ca0790b34a5a4dc4354e176a/ghc >--------------------------------------------------------------- commit b65363d3eaffd453ca0790b34a5a4dc4354e176a Author: Thomas Miedema Date: Thu Jun 30 10:32:00 2016 +0200 Fix check_uniques in non-unicode locale Testcase: `LC_ALL=C make -C utils/checkUniques`. Works with python2 and python3. Reviewed by: bgamari Differential Revision: https://phabricator.haskell.org/D2372 >--------------------------------------------------------------- b65363d3eaffd453ca0790b34a5a4dc4354e176a utils/checkUniques/check-uniques.py | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/utils/checkUniques/check-uniques.py b/utils/checkUniques/check-uniques.py index 42b375e..67322c2 100755 --- a/utils/checkUniques/check-uniques.py +++ b/utils/checkUniques/check-uniques.py @@ -5,6 +5,7 @@ import os.path import sys import re import glob +import io from collections import defaultdict # keyed on unique type, values are lists of (unique, name) pairs @@ -12,7 +13,7 @@ def find_uniques(source_files): uniques = defaultdict(lambda: defaultdict(lambda: set())) unique_re = re.compile(r"([\w\d]+)\s*=\s*mk([\w\d']+)Unique\s+(\d+)") for f in source_files: - ms = unique_re.findall(open(f).read()) + ms = unique_re.findall(io.open(f, encoding='utf8').read()) for m in ms: name = m[0] _type = m[1]