From git at git.haskell.org Fri Dec 1 11:40:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Dec 2017 11:40:54 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump (0f686df) Message-ID: <20171201114054.B0EBA3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/0f686df4303296dfe29bcab2b27368d08aa9c916/ghc >--------------------------------------------------------------- commit 0f686df4303296dfe29bcab2b27368d08aa9c916 Author: Moritz Angermann Date: Sat Nov 25 20:15:45 2017 +0800 bump >--------------------------------------------------------------- 0f686df4303296dfe29bcab2b27368d08aa9c916 hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index cf8934a..268696c 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit cf8934ab62dd58afb8da18c762e6b2d591010799 +Subproject commit 268696c282ceaa7093a8ab3fcf685f728ffaba07 From git at git.haskell.org Fri Dec 1 11:41:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Dec 2017 11:41:03 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump hadrian. (9328b88) Message-ID: <20171201114103.D96883A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/9328b88849172bb714b833f1b130e14b71c0f7a6/ghc >--------------------------------------------------------------- commit 9328b88849172bb714b833f1b130e14b71c0f7a6 Author: Moritz Angermann Date: Sun Nov 26 17:08:01 2017 +0800 bump hadrian. >--------------------------------------------------------------- 9328b88849172bb714b833f1b130e14b71c0f7a6 hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index 0f5c3ca..bbed8e3 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit 0f5c3ca0b95ed6504e54696e401b3df79f585bd2 +Subproject commit bbed8e3a33e50414242ca1a514005b20d804b02b From git at git.haskell.org Fri Dec 1 11:41:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Dec 2017 11:41:00 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump hadrian (7c584e9) Message-ID: <20171201114100.4CDAB3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/7c584e9ace2dca816419c223a7bb7bf5411bfd48/ghc >--------------------------------------------------------------- commit 7c584e9ace2dca816419c223a7bb7bf5411bfd48 Author: Moritz Angermann Date: Sat Nov 25 20:59:35 2017 +0800 bump hadrian >--------------------------------------------------------------- 7c584e9ace2dca816419c223a7bb7bf5411bfd48 hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index 268696c..0f5c3ca 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit 268696c282ceaa7093a8ab3fcf685f728ffaba07 +Subproject commit 0f5c3ca0b95ed6504e54696e401b3df79f585bd2 From git at git.haskell.org Fri Dec 1 11:40:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Dec 2017 11:40:57 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds `smp` flag to rts.cabal. (6e6e830) Message-ID: <20171201114057.85AF73A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/6e6e8300a5c139719408d32a3170371124bd4556/ghc >--------------------------------------------------------------- commit 6e6e8300a5c139719408d32a3170371124bd4556 Author: Moritz Angermann Date: Sat Nov 25 20:49:56 2017 +0800 Adds `smp` flag to rts.cabal. >--------------------------------------------------------------- 6e6e8300a5c139719408d32a3170371124bd4556 rts/rts.cabal.in | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in index 71aef3d..b33a5f4 100644 --- a/rts/rts.cabal.in +++ b/rts/rts.cabal.in @@ -24,6 +24,8 @@ flag 64bit default: @Cabal64bit@ flag leading-underscore default: @CabalLeadingUnderscore@ +flag smp + default: True library -- rts is a wired in package and @@ -72,6 +74,8 @@ library if flag(libdw) -- for backtraces extra-libraries: elf dw + if !flag(smp) + cpp-options: -DNOSMP include-dirs: build ../includes includes includes/dist-derivedconstants/header @FFIIncludeDir@ From git at git.haskell.org Fri Dec 1 11:41:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Dec 2017 11:41:07 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Update iserv-proxy (0f8665f) Message-ID: <20171201114107.0EDE13A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/0f8665f6c4b310f50419cefc6b3587491378ec40/ghc >--------------------------------------------------------------- commit 0f8665f6c4b310f50419cefc6b3587491378ec40 Author: Moritz Angermann Date: Sun Nov 26 17:08:08 2017 +0800 Update iserv-proxy >--------------------------------------------------------------- 0f8665f6c4b310f50419cefc6b3587491378ec40 utils/iserv-proxy/iserv-proxy.cabal | 2 +- utils/iserv-proxy/{proxy-src/Remote.hs => src/Main.hs} | 0 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/iserv-proxy/iserv-proxy.cabal b/utils/iserv-proxy/iserv-proxy.cabal index 8f13189..e028c99 100644 --- a/utils/iserv-proxy/iserv-proxy.cabal +++ b/utils/iserv-proxy/iserv-proxy.cabal @@ -63,7 +63,7 @@ cabal-version: >=1.10 Executable iserv-proxy Default-Language: Haskell2010 - Main-Is: Remote.hs + Main-Is: Main.hs Hs-Source-Dirs: src Build-Depends: array >= 0.5 && < 0.6, base >= 4 && < 5, diff --git a/utils/iserv-proxy/proxy-src/Remote.hs b/utils/iserv-proxy/src/Main.hs similarity index 100% rename from utils/iserv-proxy/proxy-src/Remote.hs rename to utils/iserv-proxy/src/Main.hs From git at git.haskell.org Fri Dec 1 11:41:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Dec 2017 11:41:10 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: more logging. (2cc2244) Message-ID: <20171201114110.3677D3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/2cc2244258766ef1bc73455dab5fd3744a0ac9c0/ghc >--------------------------------------------------------------- commit 2cc2244258766ef1bc73455dab5fd3744a0ac9c0 Author: Moritz Angermann Date: Mon Nov 27 11:42:58 2017 +0800 more logging. >--------------------------------------------------------------- 2cc2244258766ef1bc73455dab5fd3744a0ac9c0 libraries/ghci/GHCi/Message.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index de91c5b..282d535 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -538,7 +538,7 @@ getBin h get leftover = go leftover (runGetIncremental get) where go Nothing (Done leftover _ msg) = return (Just (msg, if B.null leftover then Nothing else Just leftover)) - go _ Done{} = throwIO (ErrorCall "getBin: Done with leftovers") + go (Just leftover) Done{} = throwIO (ErrorCall $ "getBin: Done with leftovers: " ++ show leftover) go (Just leftover) (Partial fun) = do go Nothing (fun (Just leftover)) go Nothing (Partial fun) = do From git at git.haskell.org Fri Dec 1 11:41:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Dec 2017 11:41:13 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Add network submodule. (c4a2f84) Message-ID: <20171201114113.1D27E3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/c4a2f84aef225775f45d59baf43b16b64a03a9b0/ghc >--------------------------------------------------------------- commit c4a2f84aef225775f45d59baf43b16b64a03a9b0 Author: Moritz Angermann Date: Mon Nov 27 11:44:46 2017 +0800 Add network submodule. >--------------------------------------------------------------- c4a2f84aef225775f45d59baf43b16b64a03a9b0 .gitmodules | 3 +++ libraries/network | 1 + 2 files changed, 4 insertions(+) diff --git a/.gitmodules b/.gitmodules index 3fbbecc..8a330d6 100644 --- a/.gitmodules +++ b/.gitmodules @@ -141,3 +141,6 @@ [submodule "hadrian"] path = hadrian url = https://github.com/snowleopard/hadrian.git +[submodule "libraries/network"] + path = libraries/network + url = https://github.com/haskell/network.git diff --git a/libraries/network b/libraries/network new file mode 160000 index 0000000..fe70032 --- /dev/null +++ b/libraries/network @@ -0,0 +1 @@ +Subproject commit fe7003293c9a08497a9df6cc18bb3868c96bda8f From git at git.haskell.org Fri Dec 1 13:38:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Dec 2017 13:38:31 +0000 (UTC) Subject: [commit: ghc] master: Handle CPP properly in Backpack (e1fb283) Message-ID: <20171201133831.303DE3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e1fb28384c44fcd29b0e60b9fd44767be22646af/ghc >--------------------------------------------------------------- commit e1fb28384c44fcd29b0e60b9fd44767be22646af Author: Edward Z. Yang Date: Sat Nov 25 10:12:05 2017 +0800 Handle CPP properly in Backpack Summary: Previously, we attempted to lookup 'hole' packages for include directories; this obviously is not going to work. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: ekmett, bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #14525 Differential Revision: https://phabricator.haskell.org/D4234 >--------------------------------------------------------------- e1fb28384c44fcd29b0e60b9fd44767be22646af compiler/main/Packages.hs | 10 ++++++++-- testsuite/tests/backpack/cabal/bkpcabal01/p/P.hs.in1 | 1 + 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index c49581b..14407be 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -1892,8 +1892,14 @@ listVisibleModuleNames dflags = getPreloadPackagesAnd :: DynFlags -> [PreloadUnitId] -> IO [PackageConfig] getPreloadPackagesAnd dflags pkgids0 = let - pkgids = pkgids0 ++ map (toInstalledUnitId . moduleUnitId . snd) - (thisUnitIdInsts dflags) + pkgids = pkgids0 ++ + -- An indefinite package will have insts to HOLE, + -- which is not a real package. Don't look it up. + -- Fixes #14525 + if isIndefinite dflags + then [] + else map (toInstalledUnitId . moduleUnitId . snd) + (thisUnitIdInsts dflags) state = pkgState dflags pkg_map = pkgIdMap state preload = preloadPackages state diff --git a/testsuite/tests/backpack/cabal/bkpcabal01/p/P.hs.in1 b/testsuite/tests/backpack/cabal/bkpcabal01/p/P.hs.in1 index 327a032..875c370 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal01/p/P.hs.in1 +++ b/testsuite/tests/backpack/cabal/bkpcabal01/p/P.hs.in1 @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module P where import H y = x From git at git.haskell.org Fri Dec 1 13:38:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Dec 2017 13:38:34 +0000 (UTC) Subject: [commit: ghc] master: Make use of boot TyThings during typechecking. (6998772) Message-ID: <20171201133834.DA96A3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6998772043a7f0b0360116eb5ffcbaa5630b21fb/ghc >--------------------------------------------------------------- commit 6998772043a7f0b0360116eb5ffcbaa5630b21fb Author: Edward Z. Yang Date: Sun Oct 29 20:15:07 2017 -0400 Make use of boot TyThings during typechecking. Summary: Suppose that you are typechecking A.hs, which transitively imports, via B.hs, A.hs-boot. When we poke on B.hs and discover that it has a reference to a type from A, what TyThing should we wire it up with? Clearly, if we have already typechecked A, we should use the most up-to-date TyThing: the one we freshly generated when we typechecked A. But what if we haven't typechecked it yet? For the longest time, GHC adopted the policy that this was *an error condition*; that you MUST NEVER poke on B.hs's reference to a thing defined in A.hs until A.hs has gotten around to checking this. However, actually ensuring this is the case has proven to be a bug farm. The problem was especially poignant with type family consistency checks, which eagerly happen before any typechecking takes place. This patch takes a different strategy: if we ever try to access an entity from A which doesn't exist, we just fall back on the definition of A from the hs-boot file. This means that you may end up with a mix of A.hs and A.hs-boot TyThings during the course of typechecking. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, bgamari, austin, goldfire Subscribers: thomie, rwbarton GHC Trac Issues: #14396 Differential Revision: https://phabricator.haskell.org/D4154 >--------------------------------------------------------------- 6998772043a7f0b0360116eb5ffcbaa5630b21fb compiler/iface/TcIface.hs | 65 +++++++---- compiler/rename/RnSource.hs | 120 --------------------- compiler/typecheck/FamInst.hs | 78 +++----------- compiler/typecheck/TcRnDriver.hs | 4 +- compiler/typecheck/TcRnMonad.hs | 1 - compiler/typecheck/TcRnTypes.hs | 7 -- compiler/typecheck/TcTyClsDecls.hs | 4 - testsuite/tests/typecheck/should_compile/T14396.hs | 4 + .../tests/typecheck/should_compile/T14396.hs-boot | 2 + .../tests/typecheck/should_compile/T14396a.hs | 5 + .../tests/typecheck/should_compile/T14396b.hs | 4 + .../A.hs => typecheck/should_compile/T14396f.hs} | 2 +- testsuite/tests/typecheck/should_compile/all.T | 1 + .../tests/typecheck/should_fail/T12042.stderr | 10 +- 14 files changed, 85 insertions(+), 222 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 6998772043a7f0b0360116eb5ffcbaa5630b21fb From git at git.haskell.org Fri Dec 1 21:00:29 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Dec 2017 21:00:29 +0000 (UTC) Subject: [commit: ghc] master: Add trace injection (12efb23) Message-ID: <20171201210029.6FBF43A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/12efb230de40f24e4828734dd46627ebe24416b4/ghc >--------------------------------------------------------------- commit 12efb230de40f24e4828734dd46627ebe24416b4 Author: David Feuer Date: Fri Dec 1 15:59:24 2017 -0500 Add trace injection Add support for injecting runtime calls to `trace` in `DsM`. This allows the desugarer to add compile-time information to a runtime trace. Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: carter, thomie, rwbarton Differential Revision: https://phabricator.haskell.org/D4162 >--------------------------------------------------------------- 12efb230de40f24e4828734dd46627ebe24416b4 compiler/deSugar/DsMonad.hs | 34 ++++++++++++++++- compiler/prelude/PrelNames.hs | 12 +++++- libraries/base/Debug/Trace.hs-boot | 76 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 119 insertions(+), 3 deletions(-) diff --git a/compiler/deSugar/DsMonad.hs b/compiler/deSugar/DsMonad.hs index 1eabf02..ae39e3d 100644 --- a/compiler/deSugar/DsMonad.hs +++ b/compiler/deSugar/DsMonad.hs @@ -49,7 +49,10 @@ module DsMonad ( CanItFail(..), orFail, -- Levity polymorphism - dsNoLevPoly, dsNoLevPolyExpr, dsWhenNoErrs + dsNoLevPoly, dsNoLevPolyExpr, dsWhenNoErrs, + + -- Trace injection + pprRuntimeTrace ) where import GhcPrelude @@ -87,6 +90,7 @@ import Maybes import Var (EvVar) import qualified GHC.LanguageExtensions as LangExt import UniqFM ( lookupWithDefaultUFM ) +import Literal ( mkMachString ) import Data.IORef import Control.Monad @@ -732,3 +736,31 @@ dsLookupDPHRdrEnv_maybe occ _ -> pprPanic multipleNames (ppr occ) } where multipleNames = "Multiple definitions in 'Data.Array.Parallel' and 'Data.Array.Parallel.Prim':" + +-- | Inject a trace message into the compiled program. Whereas +-- pprTrace prints out information *while compiling*, pprRuntimeTrace +-- captures that information and causes it to be printed *at runtime* +-- using Debug.Trace.trace. +-- +-- pprRuntimeTrace hdr doc expr +-- +-- will produce an expression that looks like +-- +-- trace (hdr + doc) expr +-- +-- When using this to debug a module that Debug.Trace depends on, +-- it is necessary to import {-# SOURCE #-} Debug.Trace () in that +-- module. We could avoid this inconvenience by wiring in Debug.Trace.trace, +-- but that doesn't seem worth the effort and maintenance cost. +pprRuntimeTrace :: String -- ^ header + -> SDoc -- ^ information to output + -> CoreExpr -- ^ expression + -> DsM CoreExpr +pprRuntimeTrace str doc expr = do + traceId <- dsLookupGlobalId traceName + unpackCStringId <- dsLookupGlobalId unpackCStringName + dflags <- getDynFlags + let message :: CoreExpr + message = App (Var unpackCStringId) $ + Lit $ mkMachString $ showSDoc dflags (hang (text str) 4 doc) + return $ mkApps (Var traceId) [Type (exprType expr), message, expr] diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index ae695d4..f418348 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -332,7 +332,7 @@ basicKnownKeyNames otherwiseIdName, inlineIdName, eqStringName, assertName, breakpointName, breakpointCondName, breakpointAutoName, opaqueTyConName, - assertErrorName, + assertErrorName, traceName, printName, fstName, sndName, -- Integer @@ -481,7 +481,7 @@ gHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_MAGIC, rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, mONAD_ZIP, mONAD_FAIL, aRROW, cONTROL_APPLICATIVE, gHC_DESUGAR, rANDOM, gHC_EXTS, cONTROL_EXCEPTION_BASE, gHC_TYPELITS, gHC_TYPENATS, dATA_TYPE_EQUALITY, - dATA_COERCE :: Module + dATA_COERCE, dEBUG_TRACE :: Module gHC_PRIM = mkPrimModule (fsLit "GHC.Prim") -- Primitive types and values gHC_TYPES = mkPrimModule (fsLit "GHC.Types") @@ -539,6 +539,7 @@ gHC_TYPELITS = mkBaseModule (fsLit "GHC.TypeLits") gHC_TYPENATS = mkBaseModule (fsLit "GHC.TypeNats") dATA_TYPE_EQUALITY = mkBaseModule (fsLit "Data.Type.Equality") dATA_COERCE = mkBaseModule (fsLit "Data.Coerce") +dEBUG_TRACE = mkBaseModule (fsLit "Debug.Trace") gHC_PARR' :: Module gHC_PARR' = mkBaseModule (fsLit "GHC.PArr") @@ -1320,6 +1321,10 @@ dataClassName = clsQual gENERICS (fsLit "Data") dataClassKey assertErrorName :: Name assertErrorName = varQual gHC_IO_Exception (fsLit "assertError") assertErrorIdKey +-- Debug.Trace +traceName :: Name +traceName = varQual dEBUG_TRACE (fsLit "trace") traceKey + -- Enum module (Enum, Bounded) enumClassName, enumFromName, enumFromToName, enumFromThenName, enumFromThenToName, boundedClassName :: Name @@ -2185,6 +2190,9 @@ assertErrorIdKey = mkPreludeMiscIdUnique 105 oneShotKey = mkPreludeMiscIdUnique 106 runRWKey = mkPreludeMiscIdUnique 107 +traceKey :: Unique +traceKey = mkPreludeMiscIdUnique 108 + breakpointIdKey, breakpointCondIdKey, breakpointAutoIdKey, breakpointJumpIdKey, breakpointCondJumpIdKey, breakpointAutoJumpIdKey :: Unique diff --git a/libraries/base/Debug/Trace.hs-boot b/libraries/base/Debug/Trace.hs-boot new file mode 100644 index 0000000..9dbbe2d --- /dev/null +++ b/libraries/base/Debug/Trace.hs-boot @@ -0,0 +1,76 @@ +{-# LANGUAGE Unsafe #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE UnboxedTuples #-} + +-- This boot file is necessary to allow GHC developers to +-- use trace facilities in those (relatively few) modules that Debug.Trace +-- itself depends on. It is also necessary to make DsMonad.pprRuntimeTrace +-- trace injections work in those modules. + +----------------------------------------------------------------------------- +-- | +-- Module : Debug.Trace +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries at haskell.org +-- Stability : provisional +-- Portability : portable +-- +-- Functions for tracing and monitoring execution. +-- +-- These can be useful for investigating bugs or performance problems. +-- They should /not/ be used in production code. +-- +----------------------------------------------------------------------------- + +module Debug.Trace ( + -- * Tracing + -- $tracing + trace, + traceId, + traceShow, + traceShowId, + traceStack, + traceIO, + traceM, + traceShowM, + + -- * Eventlog tracing + -- $eventlog_tracing + traceEvent, + traceEventIO, + + -- * Execution phase markers + -- $markers + traceMarker, + traceMarkerIO, + ) where + +import GHC.Base +import GHC.Show + +traceIO :: String -> IO () + +trace :: String -> a -> a + +traceId :: String -> String + +traceShow :: Show a => a -> b -> b + +traceShowId :: Show a => a -> a + +traceM :: Applicative f => String -> f () + +traceShowM :: (Show a, Applicative f) => a -> f () + +traceStack :: String -> a -> a + +traceEvent :: String -> a -> a + +traceEventIO :: String -> IO () + +traceMarker :: String -> a -> a + +traceMarkerIO :: String -> IO () From git at git.haskell.org Fri Dec 1 23:37:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Dec 2017 23:37:47 +0000 (UTC) Subject: [commit: ghc] master: Cache TypeRep kinds aggressively (bc761ad) Message-ID: <20171201233747.3CF7C3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bc761ad9c65c7aa62d38db39c59a6c0ae59c8ab8/ghc >--------------------------------------------------------------- commit bc761ad9c65c7aa62d38db39c59a6c0ae59c8ab8 Author: David Feuer Date: Fri Dec 1 17:00:24 2017 -0500 Cache TypeRep kinds aggressively Cache `TypeRep k` in each `TrApp` or `TrTyCon` constructor of `TypeRep (a :: k)`. This makes `typeRepKind` cheap. With this change, we won't need any special effort to deserialize typereps efficiently. The downside, of course, is that we make `TypeRep`s slightly larger. Reviewers: austin, hvr, bgamari, simonpj Reviewed By: bgamari, simonpj Subscribers: carter, simonpj, rwbarton, thomie GHC Trac Issues: #14254 Differential Revision: https://phabricator.haskell.org/D4085 >--------------------------------------------------------------- bc761ad9c65c7aa62d38db39c59a6c0ae59c8ab8 compiler/deSugar/DsBinds.hs | 17 +- compiler/prelude/PrelNames.hs | 25 +-- compiler/typecheck/TcTypeable.hs | 16 +- libraries/base/Data/Typeable/Internal.hs | 200 ++++++++++++++++----- libraries/base/GHC/Show.hs | 38 ++++ libraries/base/Type/Reflection/Unsafe.hs | 11 +- .../tests/ghci.debugger/scripts/break006.stderr | 4 +- .../tests/ghci.debugger/scripts/print019.stderr | 2 +- .../tests/indexed-types/should_fail/T12522a.stderr | 2 +- .../should_fail/overloadedlistsfail01.stderr | 2 +- .../tests/typecheck/should_compile/holes2.stderr | 2 +- .../tests/typecheck/should_fail/tcfail133.stderr | 2 +- 12 files changed, 251 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 bc761ad9c65c7aa62d38db39c59a6c0ae59c8ab8 From git at git.haskell.org Sat Dec 2 16:51:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Dec 2017 16:51:45 +0000 (UTC) Subject: [commit: ghc] wip/T14529: Make LHsQTyVars actually Located, and locate HsForAllTy.hst_bndrs (9a86345) Message-ID: <20171202165145.5959D3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14529 Link : http://ghc.haskell.org/trac/ghc/changeset/9a86345be9987b9610068c38a5e430393a5f7a81/ghc >--------------------------------------------------------------- commit 9a86345be9987b9610068c38a5e430393a5f7a81 Author: Alan Zimmerman Date: Sat Dec 2 18:48:48 2017 +0200 Make LHsQTyVars actually Located, and locate HsForAllTy.hst_bndrs So that AnnDot and AnnForAll can attach to the right places (API Annotations) >--------------------------------------------------------------- 9a86345be9987b9610068c38a5e430393a5f7a81 compiler/deSugar/DsMeta.hs | 12 ++--- compiler/hsSyn/Convert.hs | 14 +++--- compiler/hsSyn/HsDecls.hs | 4 +- compiler/hsSyn/HsTypes.hs | 56 +++++++++++++---------- compiler/hsSyn/HsUtils.hs | 2 +- compiler/parser/Parser.y | 23 ++++++---- compiler/parser/RdrHsSyn.hs | 26 +++++++---- compiler/rename/RnSource.hs | 6 +-- compiler/rename/RnTypes.hs | 20 ++++---- compiler/typecheck/TcHsType.hs | 6 +-- compiler/typecheck/TcRnDriver.hs | 5 +- compiler/typecheck/TcTyClsDecls.hs | 6 +-- testsuite/tests/ghc-api/annotations/T10278.stdout | 28 ++++++------ testsuite/tests/ghc-api/annotations/T10399.stdout | 10 ++-- testsuite/tests/ghc-api/annotations/T11018.stdout | 8 ++-- 15 files changed, 123 insertions(+), 103 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9a86345be9987b9610068c38a5e430393a5f7a81 From git at git.haskell.org Mon Dec 4 02:42:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 02:42:41 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump (5208f38) Message-ID: <20171204024241.EC3DA3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/5208f38d935275a56b85cb601890874b8be896ba/ghc >--------------------------------------------------------------- commit 5208f38d935275a56b85cb601890874b8be896ba Author: Moritz Angermann Date: Fri Dec 1 21:11:38 2017 +0800 bump >--------------------------------------------------------------- 5208f38d935275a56b85cb601890874b8be896ba hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index bbed8e3..d1e5501 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit bbed8e3a33e50414242ca1a514005b20d804b02b +Subproject commit d1e55017806223a82b5cee11c31d5e68cd7f94de From git at git.haskell.org Mon Dec 4 02:42:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 02:42:47 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump submodule. (7f106cd) Message-ID: <20171204024247.853CD3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/7f106cd9968bc69b0a335c176c497e98b607974f/ghc >--------------------------------------------------------------- commit 7f106cd9968bc69b0a335c176c497e98b607974f Author: Moritz Angermann Date: Sun Dec 3 20:28:13 2017 +0800 bump submodule. >--------------------------------------------------------------- 7f106cd9968bc69b0a335c176c497e98b607974f libraries/data-bitcode-edsl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/data-bitcode-edsl b/libraries/data-bitcode-edsl index ec6f7fc..3b11b02 160000 --- a/libraries/data-bitcode-edsl +++ b/libraries/data-bitcode-edsl @@ -1 +1 @@ -Subproject commit ec6f7fc639561b5d02cd07b8b1285d5b4b7d9590 +Subproject commit 3b11b02c138f672590a026c29af6f87432f17c11 From git at git.haskell.org Mon Dec 4 02:42:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 02:42:50 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Use packed structs. (9d5a742) Message-ID: <20171204024250.45EE93A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/9d5a74227153da84c9c06f72e8c746dd3e89c9e5/ghc >--------------------------------------------------------------- commit 9d5a74227153da84c9c06f72e8c746dd3e89c9e5 Author: Moritz Angermann Date: Sun Dec 3 20:28:55 2017 +0800 Use packed structs. GHC computes offsets into structs, and we do not use getElementPointer. If we had used gep, we could use unpacked structs as well. >--------------------------------------------------------------- 9d5a74227153da84c9c06f72e8c746dd3e89c9e5 compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs index fd439b0..0f02df2 100644 --- a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs +++ b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs @@ -299,7 +299,7 @@ llvmCodeGen' prc@(CmmProc{}) = Right $ do case mb_info of Nothing -> EDSL.ghcdefT (pure link) lbl sig body Just (Statics _ statics) - -> do prefixData <- EDSL.struct =<< mapM genData statics + -> do prefixData <- EDSL.packedStruct =<< mapM genData statics EDSL.ghcdefT (pure $ EDSL.withPrefixData prefixData . link) lbl sig body -- llvmCodeGen' _ = panic "LlvmCodeGen': unhandled raw cmm group" @@ -427,7 +427,7 @@ genStatics s@(Statics l statics) = do let link | externallyVisibleCLabel l = Val.external -- External | otherwise = Val.private -- Internal - struct <- EDSL.struct body + struct <- EDSL.packedStruct body -- make statics mutable. -- E.g. -- x :: T From git at git.haskell.org Mon Dec 4 02:42:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 02:42:44 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: no tbaa (3bf1ed5) Message-ID: <20171204024244.B16A03A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/3bf1ed59670bd6c94ad36062c848fbe9a1a0385b/ghc >--------------------------------------------------------------- commit 3bf1ed59670bd6c94ad36062c848fbe9a1a0385b Author: Moritz Angermann Date: Sat Dec 2 14:09:03 2017 +0800 no tbaa >--------------------------------------------------------------- 3bf1ed59670bd6c94ad36062c848fbe9a1a0385b compiler/main/DriverPipeline.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 180f362..af64874 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -812,8 +812,8 @@ fastLlvmPipeline dflags llvmOptions :: DynFlags -> [(String, String)] -- ^ pairs of (opt, llc) arguments llvmOptions dflags = - [("-enable-tbaa -tbaa", "-enable-tbaa") | gopt Opt_LlvmTBAA dflags ] - ++ [("-relocation-model=" ++ rmodel +-- [("-enable-tbaa -tbaa", "-enable-tbaa") | gopt Opt_LlvmTBAA dflags ] + [("-relocation-model=" ++ rmodel ,"-relocation-model=" ++ rmodel) | not (null rmodel)] ++ [("-stack-alignment=" ++ (show align) ,"-stack-alignment=" ++ (show align)) | align > 0 ] From git at git.haskell.org Mon Dec 4 02:42:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 02:42:53 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump (e6a070b) Message-ID: <20171204024253.0B7E83A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/e6a070b38d1f703cc95ffc8d286000d8e91a1cb3/ghc >--------------------------------------------------------------- commit e6a070b38d1f703cc95ffc8d286000d8e91a1cb3 Author: Moritz Angermann Date: Mon Dec 4 10:09:20 2017 +0800 bump >--------------------------------------------------------------- e6a070b38d1f703cc95ffc8d286000d8e91a1cb3 hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index d1e5501..940822b 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit d1e55017806223a82b5cee11c31d5e68cd7f94de +Subproject commit 940822b18353d09349ee44d3205cb24a1edb8d4b From git at git.haskell.org Mon Dec 4 08:54:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 08:54:03 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: adds -latomic to. ghc-prim (c93b5bb) Message-ID: <20171204085403.07A713A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/c93b5bbf1cf726d74722db68fee67e86dd095fa3/ghc >--------------------------------------------------------------- commit c93b5bbf1cf726d74722db68fee67e86dd095fa3 Author: Moritz Angermann Date: Mon Dec 4 10:56:13 2017 +0800 adds -latomic to. ghc-prim >--------------------------------------------------------------- c93b5bbf1cf726d74722db68fee67e86dd095fa3 libraries/ghc-prim/ghc-prim.cabal | 3 +++ 1 file changed, 3 insertions(+) diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal index 9b8c1ac..fc49857 100644 --- a/libraries/ghc-prim/ghc-prim.cabal +++ b/libraries/ghc-prim/ghc-prim.cabal @@ -66,6 +66,9 @@ Library -- on Windows. Required because of mingw32. extra-libraries: user32, mingw32, mingwex + if os(linux) + extra-libraries: atomic + c-sources: cbits/atomic.c cbits/bswap.c From git at git.haskell.org Mon Dec 4 08:54:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 08:54:05 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump (4c67cdf) Message-ID: <20171204085405.E8F2F3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/4c67cdf1fe17e2d5b76656d7e74cd4e442379e7b/ghc >--------------------------------------------------------------- commit 4c67cdf1fe17e2d5b76656d7e74cd4e442379e7b Author: Moritz Angermann Date: Mon Dec 4 14:46:30 2017 +0800 bump >--------------------------------------------------------------- 4c67cdf1fe17e2d5b76656d7e74cd4e442379e7b hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index 940822b..5cdc9fb 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit 940822b18353d09349ee44d3205cb24a1edb8d4b +Subproject commit 5cdc9fb10125d658e7216f10e06d42c8de3f3d94 From git at git.haskell.org Mon Dec 4 08:54:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 08:54:08 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump (733e4ad) Message-ID: <20171204085408.B85E03A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/733e4ada25d33d971b58fb2d22acfdc5eefb36c1/ghc >--------------------------------------------------------------- commit 733e4ada25d33d971b58fb2d22acfdc5eefb36c1 Author: Moritz Angermann Date: Mon Dec 4 15:37:25 2017 +0800 bump >--------------------------------------------------------------- 733e4ada25d33d971b58fb2d22acfdc5eefb36c1 hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index 5cdc9fb..0d20aa0 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit 5cdc9fb10125d658e7216f10e06d42c8de3f3d94 +Subproject commit 0d20aa05b80e6981760e29f886cf1fad12a29042 From git at git.haskell.org Mon Dec 4 08:54:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 08:54:12 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump (115f80a) Message-ID: <20171204085412.1720E3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/115f80a7fc5ec28f698ecec0f8f3ab73811f5b34/ghc >--------------------------------------------------------------- commit 115f80a7fc5ec28f698ecec0f8f3ab73811f5b34 Author: Moritz Angermann Date: Mon Dec 4 16:00:18 2017 +0800 bump >--------------------------------------------------------------- 115f80a7fc5ec28f698ecec0f8f3ab73811f5b34 _arm-raspberrypi/generated/DerivedConstants.h | 569 +++++++++++++++++++++ .../generated/GHCConstantsHaskellExports.hs | 125 +++++ .../generated/GHCConstantsHaskellType.hs | 134 +++++ .../generated/GHCConstantsHaskellWrappers.hs | 250 +++++++++ _arm-raspberrypi/generated/ghcautoconf.h | 539 +++++++++++++++++++ _arm-raspberrypi/generated/ghcplatform.h | 34 ++ _arm-raspberrypi/generated/ghcversion.h | 18 + _arm-raspberrypi/generated/platformConstants | 134 +++++ _armv7-android/generated/DerivedConstants.h | 569 +++++++++++++++++++++ .../generated/GHCConstantsHaskellExports.hs | 125 +++++ .../generated/GHCConstantsHaskellType.hs | 134 +++++ .../generated/GHCConstantsHaskellWrappers.hs | 250 +++++++++ _armv7-android/generated/ghcautoconf.h | 539 +++++++++++++++++++ _armv7-android/generated/ghcplatform.h | 34 ++ _armv7-android/generated/ghcversion.h | 18 + _armv7-android/generated/platformConstants | 134 +++++ _host/generated/DerivedConstants.h | 569 +++++++++++++++++++++ _host/generated/GHCConstantsHaskellExports.hs | 125 +++++ _host/generated/GHCConstantsHaskellType.hs | 134 +++++ _host/generated/GHCConstantsHaskellWrappers.hs | 250 +++++++++ _host/generated/ghcautoconf.h | 539 +++++++++++++++++++ _host/generated/ghcplatform.h | 34 ++ _host/generated/ghcversion.h | 18 + _host/generated/platformConstants | 134 +++++ .../integer-gmp/gmp => _host/include}/ghc-gmp.h | 0 hadrian | 2 +- 26 files changed, 5410 insertions(+), 1 deletion(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 115f80a7fc5ec28f698ecec0f8f3ab73811f5b34 From git at git.haskell.org Mon Dec 4 08:54:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 08:54:14 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump (7134467) Message-ID: <20171204085414.E0EC23A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/7134467cb6db2330525c5ec3795ceb88f73c159c/ghc >--------------------------------------------------------------- commit 7134467cb6db2330525c5ec3795ceb88f73c159c Author: Moritz Angermann Date: Mon Dec 4 16:53:47 2017 +0800 bump >--------------------------------------------------------------- 7134467cb6db2330525c5ec3795ceb88f73c159c hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index d403356..d1faf55 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit d403356f6c447fc0c672a98fec77d87ef3736512 +Subproject commit d1faf55a4bbc5b138e80308299606ad44d565120 From git at git.haskell.org Mon Dec 4 08:54:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 08:54:46 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Drop (af7bb12) Message-ID: <20171204085447.001C73A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/af7bb123c48e3404cb28b34973582864958f5013/ghc >--------------------------------------------------------------- commit af7bb123c48e3404cb28b34973582864958f5013 Author: Moritz Angermann Date: Mon Dec 4 16:54:34 2017 +0800 Drop >--------------------------------------------------------------- af7bb123c48e3404cb28b34973582864958f5013 _arm-raspberrypi/generated/DerivedConstants.h | 569 --------------------- .../generated/GHCConstantsHaskellExports.hs | 125 ----- .../generated/GHCConstantsHaskellType.hs | 134 ----- .../generated/GHCConstantsHaskellWrappers.hs | 250 --------- _arm-raspberrypi/generated/ghcautoconf.h | 539 ------------------- _arm-raspberrypi/generated/ghcplatform.h | 34 -- _arm-raspberrypi/generated/ghcversion.h | 18 - _arm-raspberrypi/generated/platformConstants | 134 ----- _armv7-android/generated/DerivedConstants.h | 569 --------------------- .../generated/GHCConstantsHaskellExports.hs | 125 ----- .../generated/GHCConstantsHaskellType.hs | 134 ----- .../generated/GHCConstantsHaskellWrappers.hs | 250 --------- _armv7-android/generated/ghcautoconf.h | 539 ------------------- _armv7-android/generated/ghcplatform.h | 34 -- _armv7-android/generated/ghcversion.h | 18 - _armv7-android/generated/platformConstants | 134 ----- _host/generated/DerivedConstants.h | 569 --------------------- _host/generated/GHCConstantsHaskellExports.hs | 125 ----- _host/generated/GHCConstantsHaskellType.hs | 134 ----- _host/generated/GHCConstantsHaskellWrappers.hs | 250 --------- _host/generated/ghcautoconf.h | 539 ------------------- _host/generated/ghcplatform.h | 34 -- _host/generated/ghcversion.h | 18 - _host/generated/platformConstants | 134 ----- _host/include/ghc-gmp.h | 1 - 25 files changed, 5410 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 af7bb123c48e3404cb28b34973582864958f5013 From git at git.haskell.org Mon Dec 4 13:30:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 13:30:35 +0000 (UTC) Subject: [commit: ghc] master: Make the Con and Con' patterns produce evidence (1acb922) Message-ID: <20171204133035.384193A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1acb922bb1186662919c1dbc0af596584e5db3ac/ghc >--------------------------------------------------------------- commit 1acb922bb1186662919c1dbc0af596584e5db3ac Author: David Feuer Date: Mon Dec 4 08:27:18 2017 -0500 Make the Con and Con' patterns produce evidence Matching with the `Con` and `Con'` patterns can reveal evidence that the type in question is *not* an application. This can help the pattern checker. Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: carter, rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4139 >--------------------------------------------------------------- 1acb922bb1186662919c1dbc0af596584e5db3ac libraries/base/Data/Typeable/Internal.hs | 69 ++++++++++++++++++++++++++------ 1 file changed, 56 insertions(+), 13 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index d2ed9d1..a01a9ff 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -18,6 +18,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} ----------------------------------------------------------------------------- -- | @@ -87,7 +88,7 @@ import Data.Type.Equality import GHC.List ( splitAt, foldl' ) import GHC.Word import GHC.Show -import GHC.TypeLits ( KnownSymbol, symbolVal' ) +import GHC.TypeLits ( KnownSymbol, symbolVal', AppendSymbol ) import GHC.TypeNats ( KnownNat, natVal' ) import Unsafe.Coerce ( unsafeCoerce ) @@ -448,21 +449,32 @@ mkTrAppChecked a b = mkTrApp a b pattern App :: forall k2 (t :: k2). () => forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b) => TypeRep a -> TypeRep b -> TypeRep t -pattern App f x <- (splitApp -> Just (IsApp f x)) +pattern App f x <- (splitApp -> IsApp f x) where App f x = mkTrAppChecked f x -data IsApp (a :: k) where +data AppOrCon (a :: k) where IsApp :: forall k k' (f :: k' -> k) (x :: k'). () - => TypeRep f -> TypeRep x -> IsApp (f x) + => TypeRep f -> TypeRep x -> AppOrCon (f x) + -- See Note [Con evidence] + IsCon :: IsApplication a ~ "" => TyCon -> [SomeTypeRep] -> AppOrCon a + +type family IsApplication (x :: k) :: Symbol where + IsApplication (_ _) = "An error message about this unifying with \"\" " + `AppendSymbol` "means that you tried to match a TypeRep with Con or " + `AppendSymbol` "Con' when the represented type was known to be an " + `AppendSymbol` "application." + IsApplication _ = "" splitApp :: forall k (a :: k). () => TypeRep a - -> Maybe (IsApp a) -splitApp TrType = Just (IsApp trTYPE trLiftedRep) -splitApp (TrApp {trAppFun = f, trAppArg = x}) = Just (IsApp f x) -splitApp rep@(TrFun {trFunArg=a, trFunRes=b}) = Just (IsApp (mkTrApp arr a) b) + -> AppOrCon a +splitApp TrType = IsApp trTYPE trLiftedRep +splitApp (TrApp {trAppFun = f, trAppArg = x}) = IsApp f x +splitApp rep@(TrFun {trFunArg=a, trFunRes=b}) = IsApp (mkTrApp arr a) b where arr = bareArrow rep -splitApp (TrTyCon{}) = Nothing +splitApp (TrTyCon{trTyCon = con, trKindVars = kinds}) + = case unsafeCoerce Refl :: IsApplication a :~: "" of + Refl -> IsCon con kinds -- | Use a 'TypeRep' as 'Typeable' evidence. withTypeable :: forall (a :: k) (r :: TYPE rep). () @@ -475,8 +487,10 @@ withTypeable rep k = unsafeCoerce k' rep newtype Gift a (r :: TYPE rep) = Gift (Typeable a => r) -- | Pattern match on a type constructor -pattern Con :: forall k (a :: k). TyCon -> TypeRep a -pattern Con con <- TrTyCon {trTyCon = con} +pattern Con :: forall k (a :: k). () + => IsApplication a ~ "" -- See Note [Con evidence] + => TyCon -> TypeRep a +pattern Con con <- (splitApp -> IsCon con _) -- | Pattern match on a type constructor including its instantiated kind -- variables. @@ -495,13 +509,42 @@ pattern Con con <- TrTyCon {trTyCon = con} -- intRep == typeRep @Int -- @ -- -pattern Con' :: forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a -pattern Con' con ks <- TrTyCon {trTyCon = con, trKindVars = ks} +pattern Con' :: forall k (a :: k). () + => IsApplication a ~ "" -- See Note [Con evidence] + => TyCon -> [SomeTypeRep] -> TypeRep a +pattern Con' con ks <- (splitApp -> IsCon con ks) -- TODO: Remove Fun when #14253 is fixed {-# COMPLETE Fun, App, Con #-} {-# COMPLETE Fun, App, Con' #-} +{- Note [Con evidence] + ~~~~~~~~~~~~~~~~~~~ + +Matching TypeRep t on Con or Con' fakes up evidence that + + IsApplication t ~ "". + +Why should anyone care about the value of strange internal type family? +Well, almost nobody cares about it, but the pattern checker does! +For example, suppose we have TypeRep (f x) and we want to get +TypeRep f and TypeRep x. There is no chance that the Con constructor +will match, because (f x) is not a constructor, but without the +IsApplication evidence, omitting it will lead to an incomplete pattern +warning. With the evidence, the pattern checker will see that +Con wouldn't typecheck, so everything works out as it should. + +Why do we use Symbols? We would really like to use something like + + type family NotApplication (t :: k) :: Constraint where + NotApplication (f a) = TypeError ... + NotApplication _ = () + +Unfortunately, #11503 means that the pattern checker and type checker +will fail to actually reject the mistaken patterns. So we describe the +error in the result type. It's a horrible hack. +-} + ----------------- Observation --------------------- -- | Observe the type constructor of a quantified type representation. From git at git.haskell.org Mon Dec 4 14:23:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 14:23:38 +0000 (UTC) Subject: [commit: ghc] wip/T14373: Implement pointer tagging for 'big' families #14373 (72056b3) Message-ID: <20171204142338.219DD3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/72056b3142d0fc364264d46a6c985789c9411bad/ghc >--------------------------------------------------------------- commit 72056b3142d0fc364264d46a6c985789c9411bad Author: Gabor Greif Date: Fri Oct 20 15:45:37 2017 +0200 Implement pointer tagging for 'big' families #14373 Formerly we punted on these and evaluated constructors always got a tag of 1. We now cascade switches because we have to check the tag first and when it is MAX_PTR_TAG then get the precise tag from the info table and switch on that. The only technically tricky part is that the default case needs (logical) duplication. To do this we emit an extra label for it and branch to that from the second switch. This avoids duplicated codegen. >--------------------------------------------------------------- 72056b3142d0fc364264d46a6c985789c9411bad compiler/codeGen/StgCmmClosure.hs | 11 +++++-- compiler/codeGen/StgCmmExpr.hs | 67 ++++++++++++++++++++++++++++++--------- 2 files changed, 60 insertions(+), 18 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 2501ec9..ce0f623 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -354,9 +354,12 @@ type DynTag = Int -- The tag on a *pointer* -- * big, otherwise. -- -- Small families can have the constructor tag in the tag bits. --- Big families only use the tag value 1 to represent evaluatedness. +-- Big families always use the tag values 1..mAX_PTR_TAG to represent +-- evaluatedness, the last one lumping together all overflowing ones. -- We don't have very many tag bits: for example, we have 2 bits on -- x86-32 and 3 bits on x86-64. +-- +-- Also see Note [tagging big families] isSmallFamily :: DynFlags -> Int -> Bool isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags @@ -369,10 +372,12 @@ isSmallFamilyTyCon dflags tycon = tagForCon :: DynFlags -> DataCon -> DynTag tagForCon dflags con | isSmallFamilyTyCon dflags tycon = con_tag - | otherwise = 1 + | con_tag <= max_tag = con_tag + | otherwise = max_tag where - con_tag = dataConTag con -- NB: 1-indexed + con_tag = dataConTag con -- NB: 1-indexed tycon = dataConTyCon con + max_tag = mAX_PTR_TAG dflags tagForArity :: DynFlags -> RepArity -> DynTag tagForArity dflags arity diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 3fcc935..6c00cef 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -37,6 +37,7 @@ import Cmm import CmmInfo import CoreSyn import DataCon +import DynFlags ( mAX_PTR_TAG ) import ForeignCall import Id import PrimOp @@ -49,9 +50,10 @@ import Util import FastString import Outputable -import Control.Monad (unless,void) -import Control.Arrow (first) +import Control.Monad ( unless, void ) +import Control.Arrow ( first ) import Data.Function ( on ) +import Data.List ( partition ) ------------------------------------------------------------------------ -- cgExpr: the main function @@ -607,21 +609,36 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts ; let fam_sz = tyConFamilySize tycon bndr_reg = CmmLocal (idToReg dflags bndr) + tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg) + branches' = [(tag+1,branch) | (tag,branch) <- branches] + maxpt = mAX_PTR_TAG dflags + (ptr, info) = partition ((< maxpt) . fst) branches' + small = isSmallFamily dflags fam_sz -- Is the constructor tag in the node reg? - ; if isSmallFamily dflags fam_sz - then do - let -- Yes, bndr_reg has constr. tag in ls bits - tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg) - branches' = [(tag+1,branch) | (tag,branch) <- branches] - emitSwitch tag_expr branches' mb_deflt 1 fam_sz - - else -- No, get tag from info table - let -- Note that ptr _always_ has tag 1 - -- when the family size is big enough - untagged_ptr = cmmRegOffB bndr_reg (-1) - tag_expr = getConstrTag dflags (untagged_ptr) - in emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1) + -- See Note [tagging big families] + ; if small || null info + then -- Yes, bndr_reg has constr. tag in ls bits + emitSwitch tag_expr branches' mb_deflt 1 (if small then fam_sz else maxpt) + + else -- No, get exact tag from info table when mAX_PTR_TAG + do + infos_lbl <- newBlockId -- branch destination for info pointer lookup + infos_scp <- getTickScope + + let catchall = (maxpt, (mkBranch infos_lbl, infos_scp)) + prelabel (Just (stmts, scp)) = + do lbl <- newBlockId + return (Just (mkLabel lbl scp <*> stmts, scp), Just (mkBranch lbl, scp)) + prelabel _ = return (Nothing, Nothing) + + (mb_deflt, mb_branch) <- prelabel mb_deflt + emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt + emitLabel infos_lbl + let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) + tag_expr = getConstrTag dflags untagged_ptr + info0 = (\(tag,branch)->(tag-1,branch)) <$> info + emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1) ; return AssignedDirectly } @@ -649,6 +666,26 @@ cgAlts _ _ _ _ = panic "cgAlts" -- x = R1 -- goto L1 + +-- Note [tagging big families] +-- +-- Previousy, only the small constructor families were tagged. +-- This penalized greater unions which overflow the tag space +-- of TAG_BITS (i.e. 3 on 32 resp. 7 constructors on 64 bit). +-- But there is a clever way of combining pointer and info-table +-- tagging. We now use 1..{2,6} as pointer-resident tags while +-- {3,7} signifies we have to fall back and get the tag from the +-- info-table. +-- Conseqently we now cascade switches because we have to check +-- the tag first and when it is MAX_PTR_TAG then get the precise +-- tag from the info table and switch on that. The only technically +-- tricky part is that the default case needs (logical) duplication. +-- To do this we emit an extra label for it and branch to that from +-- the second switch. This avoids duplicated codegen. +-- +-- Also see Note [Data constructor dynamic tags] + + ------------------- cgAlgAltRhss :: (GcPlan,ReturnKind) -> NonVoid Id -> [StgAlt] -> FCode ( Maybe CmmAGraphScoped From git at git.haskell.org Mon Dec 4 14:23:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 14:23:41 +0000 (UTC) Subject: [commit: ghc] wip/T14373's head updated: Implement pointer tagging for 'big' families #14373 (72056b3) Message-ID: <20171204142341.BBE433A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T14373' now includes: af0aea9 core-spec: Add join points to formalism 29ae833 Tidy up IfaceEqualityTyCon 1317ba6 Implement the EmptyDataDeriving proposal 1130c67 PPC NCG: Impl branch prediction, atomic ops. b0b80e9 Implement the basics of hex floating point literals e0df569 Use proper Unique for Name b938576 Add custom exception for fixIO 36f0cb7 TcRnDriver: Bracket family instance consistency output in -ddump-rn-trace cbd6a4d Introduce -dsuppress-stg-free-vars flag bd765f4 Fix atomicread/write operations d9b6015 Revert "Move check-ppr and check-api-annotations to testsuite/utils" 51321cf rts/PrimOps.cmm: add declaration for heapOverflow closure 4353756 CmmSink: Use a IntSet instead of a list 15f788f llvmGen: Pass vector arguments in vector registers by default eb37132 Bump haddock submodule 3c8e55c Name TypeRep constructor fields 19ca2ca Deserialize all function TypeReps 5d48f7c Fix documentation and comment issues df479f7 change example from msum to mfilter 436b3ef Clean up comments about match algorithm a bit. f6521e6 testsuite: Bump metrics of haddock.Cabal 4dfb790 rts/win32: Emit exception handler output to stderr 6f990c5 cmm/CBE: Fix comparison between blocks of different lengths a27056f cmm/CBE: Fix a few more zip uses 2ded536 Typo in glasgow_exts.rst 35642f4 Update ErrorCall documentation for the location argument 8613e61 DynFlags: Introduce -show-mods-loaded flag 59de290 Update autoconf test for gcc to require 4.7 and up 66b5b3e Specialise lcm :: Word -> Word -> Word (trac#14424) 275ac8e base: Add examples to Bifunctor documentation 7b0b9f6 Squashed 'hadrian/' content from commit 438dc57 5cee480 Merge commit '7b0b9f603bb1215e2b7af23c2404d637b95a4988' as 'hadrian' 0ff152c WIP on combining Step 1 and 3 of Trees That Grow 7d6fa32 Set up Linux, OSX and FreeBSD on CircleCI. b0cabc9 Set up AppVeyor, Windows CI. 6f665cc Sdist -> bindist -> tests 07e0d0d Revert "Sdist -> bindist -> tests" ed18f47 Factor out builds into steps. Address ghc/ghc#83 comments. ae7c33f testsuite: Bump haddock.compiler allocations 7d34f69 relnotes: Clarify a few things c1bc923 relnotes: Note enabling of -fllvm-pass-vectorse-in-regs 93b4820 Revert "WIP on combining Step 1 and 3 of Trees That Grow" 9f8dde0 Update link to Haskeline user preferences bf9ba7b base: Escape \ in CallStack example 14d885e Merge remote-tracking branch 'github/pr/83' 21970de Imrpove comments about equality types 30058b0 Fix another dark corner in the shortcut solver 2c2f3ce Minimise provided dictionaries in pattern synonyms fe6848f Fix in-scope set in simplifier 438dd1c WIP on Doing a combined Step 1 and 3 for Trees That Grow 803ed03 Invoke lintUnfolding only on top-level unfoldings (#14430) 6bd352a Remove left-overs from compareByteArray# inline conversion 10ff3e3 testsuite: Fix output of T14394 bdd2d28 Update Win32 version for GHC 8.4. 9773053 Merge initial Hadrian snapshot ce9a677 base: Add test for #14425 c59d6da base: Normalize style of approxRational 5834da4 base: Fix #14425 0656cb4 Update comment in GHC.Real (trac#14432) 6b52b4c Remove unreliable Core Lint empty case checks e6b13c9 testsuite: Add test for #5889 75291ab Change `OPTIONS_GHC -O` to `OPTIONS_GHC -O2` f8e7fec Fix PPC NCG after blockID patch 5229c43 Squashed 'hadrian/' changes from 438dc576e7..5ebb69ae1e 506ba62 Merge commit '5229c43ccf77bcbffeced01dccb27398d017fa34' f11f252 Windows: Bump to GCC 7.2 for GHC 8.4 ba2ae2c Adds cmm-sources to base 426af53 Use LICENSE instead of ../LICENSE in the compiler.cabal file 5f158bc circleci: Bump down thread count 86c50a1 Declare proper spec version in `base.cabal` e3ec2e7 WIP on combined Step 1 and 3 for Trees That Grow, HsExpr 0a85190 Fix a TyVar bug in the flattener f570000 A bit more tc-tracing 47ad657 TTG3 Combined Step 1 and 3 for Trees That Grow f5dc8cc Add new mbmi and mbmi2 compiler flags 6dfe982 StaticPointers: Clarify documentation 5dea62f Adds rts/rts.cabal.in file 8b1020e RTS: Disable warnings in ffi.h ea26162 CLabel: Clean up unused label types 1aba27a CLabels: Remove CaseLabel 383016b Add dump flag for timing output d9f0c24 rts: Fix gc timing d0a641a Allow the rts lib to be called rts-1.0 3bed4aa Cabalify all the things e14945c Adjust AltCon Ord instance to match Core linter requirements. ec080ea users_guide: Fix "CancelSynchronousIo" casing c1fcd9b Squashed 'hadrian/' changes from 5ebb69a..fa3771f 07ac921 Pull recent Hadrian changes from upstream 2f46387 Detect overly long GC sync 2da7813 Document -ddump-timings c729734 configure: Fix incorrect quoting 12a7444 Adds -ghc-version flag to ghc. 835d8dd GHC.Prim use virtual-modules bb11a2d Relocatable GHC 74070bb Fix rts.cabal.in 912a72d Fix T4437 b8e324a base: Make documentation of atomically more accurate 7d16d8a Fix #elfi -> #elif; unbreak -Werror. ca3700a Rename ghc-version -> ghcversion-file 606bbc3 Stop generating make files when using hadrian. e66913d Bump hsc2hs submodule 25f36bd Bump haddock submodule ddded7e ghc-pkg: Add missing newlines to usage message 1b1ba9d rel-notes: Fix up formatting in release notes d213ee8 CircleCI: Disable artifact collection on OS X 66d1799 configure: Fix ar probed flags 0b20d9c base: Document GHC.Stack.CCS internals 314bc31 Revert "trees that grow" work 90a819b CircleCI: Add webhook for Harbormaster builds 2ca2259 Update ANNOUNCE 763ecac rts: Move libdwPrintBacktrace to public interface f376eba rts: Fix inconsistencies in how retainer and heap censuses are timed. 63e4ac3 Add warn-missing-export-lists 8a8a79a Update leftover reference to refer to [FunBind vs PatBind] dad9864 Remove hadrian sub-dir from .gitignore 0db4627 Test Trac #14488 bb2a08e testsuite: Add test for #14257 23116df cmm: Optimise remainders by powers of two eb5a40c base: Remove redundant subtraction in (^) and stimes 7a73a1c Bump stm submodule 2d1c671 ErrUtils: Refactor dump file logic c11f145 ErrUtils: Ensure timing dumps are always output on one line 360d740 Squashed 'hadrian/' changes from fa3771fe6b..4499b294e4 abdb555 Update Hadrian 341013e Revert "Add new mbmi and mbmi2 compiler flags" 5fdb858 Fix README 33cbc9f CircleCI: Perform nightly validation of unregisterised build 866f669 CircleCI: Try validating LLVM as well e2cc106 circleci: Build with Hadrian ad57e28 CircleCI: Install lbzip2 and patch 5e35627 rts/Printer: add closure name entries for small arrays (Fixes #14513) 30aa643 SysTools: Expand occurrences of $topdir anywhere in a Settings path 69cd1e9 SysTools: Split up TopDir logic into new module 599243e DynFlags: Expand $topdir in --info output 99089fc users-guide: Fix :default: placement f209e66 base: fdReady(): Fix timeouts > ~49 days overflowing. Fixes #14262. a1950e6 CircleCI: Reenable artifact collection on Darwin 471d677 Don't complain about UNPACK in -fno-code. 6282366 Follow symlinks in the Win32 code for System.Environment.getExecutablePath b241d6d Add obvious Outputable Integer instance. f713be7 RtsFlags: allow +RTS -K0 00b96b2 boot: Eliminate superfluous output 4efe5fe Check quantification for partial type signatues df1a0c0 typecheck: Consistently use pretty quotes in error messages eb86e86 Don't call alex for Cabal lib during GHC build e4dc2cd relnotes: Rework treatment of included package list 54fda25 base: Rip out old RTS statistics interface 17e71c1 CLabel.labelType: Make catch-all case explicit 048a913 cmm: Use LocalBlockLabel instead of AsmTempLabel to represent blocks 16dd532 CLabel: Refactor pprDynamicLinkerAsmLabel 55e621c nativeGen: Use plusUFMList instead of foldr 7dc82d6 nativeGen: Use foldl' instead of foldl 66c1c8e CLabel: More specific debug output from CLabel d3b80c7 Cmm: Add missing cases for BlockInfoTable 030d9d4 CLabel: A bit of documentation 4c65867 CircleCI: Disallow hscolour 1.24.3 3c0ffd1 CircleCI: Freeze all packages at fixed index state 5b3f33b Minor tweaks to codegens.rst b6428af Comments only: Trac #14511 b6a2691 Bump unix submodule f246d35 Darwin: Set deployment target d672b7f Darwin: Use gmp from homebrew 6998772 Make use of boot TyThings during typechecking. e1fb283 Handle CPP properly in Backpack 12efb23 Add trace injection bc761ad Cache TypeRep kinds aggressively 72056b3 Implement pointer tagging for 'big' families #14373 From git at git.haskell.org Mon Dec 4 21:14:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 21:14:31 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: template-haskell: Rip out FamFlavour (cd4d830) Message-ID: <20171204211431.C342D3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/cd4d83049143e01ff576b1691765aa71ff7c43cf/ghc >--------------------------------------------------------------- commit cd4d83049143e01ff576b1691765aa71ff7c43cf Author: Ben Gamari Date: Mon Dec 4 13:50:36 2017 -0500 template-haskell: Rip out FamFlavour >--------------------------------------------------------------- cd4d83049143e01ff576b1691765aa71ff7c43cf compiler/prelude/THNames.hs | 12 ------ libraries/ghci/GHCi/TH/Binary.hs | 1 - libraries/template-haskell/Language/Haskell/TH.hs | 2 +- .../template-haskell/Language/Haskell/TH/Lib.hs | 3 +- .../Language/Haskell/TH/Lib/Internal.hs | 48 ---------------------- .../template-haskell/Language/Haskell/TH/Ppr.hs | 5 --- .../template-haskell/Language/Haskell/TH/Syntax.hs | 3 -- 7 files changed, 2 insertions(+), 72 deletions(-) diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs index 068f01f..f45b3b5 100644 --- a/compiler/prelude/THNames.hs +++ b/compiler/prelude/THNames.hs @@ -137,8 +137,6 @@ templateHaskellNames = [ ruleVarName, typedRuleVarName, -- FunDep funDepName, - -- FamFlavour - typeFamName, dataFamName, -- TySynEqn tySynEqnName, -- AnnTarget @@ -517,11 +515,6 @@ typedRuleVarName = libFun (fsLit ("typedRuleVar")) typedRuleVarIdKey funDepName :: Name funDepName = libFun (fsLit "funDep") funDepIdKey --- data FamFlavour = ... -typeFamName, dataFamName :: Name -typeFamName = libFun (fsLit "typeFam") typeFamIdKey -dataFamName = libFun (fsLit "dataFam") dataFamIdKey - -- data TySynEqn = ... tySynEqnName :: Name tySynEqnName = libFun (fsLit "tySynEqn") tySynEqnIdKey @@ -1031,11 +1024,6 @@ interruptibleIdKey = mkPreludeMiscIdUnique 432 funDepIdKey :: Unique funDepIdKey = mkPreludeMiscIdUnique 440 --- data FamFlavour = ... -typeFamIdKey, dataFamIdKey :: Unique -typeFamIdKey = mkPreludeMiscIdUnique 450 -dataFamIdKey = mkPreludeMiscIdUnique 451 - -- data TySynEqn = ... tySynEqnIdKey :: Unique tySynEqnIdKey = mkPreludeMiscIdUnique 460 diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index ae6bc9f..58e626c 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -44,7 +44,6 @@ instance Binary TH.Body instance Binary TH.Match instance Binary TH.Fixity instance Binary TH.TySynEqn -instance Binary TH.FamFlavour instance Binary TH.FunDep instance Binary TH.AnnTarget instance Binary TH.RuleBndr diff --git a/libraries/template-haskell/Language/Haskell/TH.hs b/libraries/template-haskell/Language/Haskell/TH.hs index fd5c06f..213c70e 100644 --- a/libraries/template-haskell/Language/Haskell/TH.hs +++ b/libraries/template-haskell/Language/Haskell/TH.hs @@ -73,7 +73,7 @@ module Language.Haskell.TH( SourceUnpackedness(..), SourceStrictness(..), DecidedStrictness(..), Bang(..), Strict, Foreign(..), Callconv(..), Safety(..), Pragma(..), Inline(..), RuleMatch(..), Phases(..), RuleBndr(..), AnnTarget(..), - FunDep(..), FamFlavour(..), TySynEqn(..), TypeFamilyHead(..), + FunDep(..), TySynEqn(..), TypeFamilyHead(..), Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence, PatSynDir(..), PatSynArgs(..), -- ** Expressions diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs index 9ad36f8..dbf01f1 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs @@ -88,9 +88,8 @@ module Language.Haskell.TH.Lib ( roleAnnotD, -- **** Type Family / Data Family dataFamilyD, openTypeFamilyD, closedTypeFamilyD, dataInstD, - familyNoKindD, familyKindD, closedTypeFamilyNoKindD, closedTypeFamilyKindD, newtypeInstD, tySynInstD, - typeFam, dataFam, tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig, + tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig, -- **** Fixity infixLD, infixRD, infixND, diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs index d58ce84..4496ecd 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs @@ -12,8 +12,6 @@ -- relegate as many changes as we can to just the Internal module, where it -- is safe to break things. -{-# LANGUAGE CPP #-} - module Language.Haskell.TH.Lib.Internal where import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn) @@ -529,45 +527,6 @@ closedTypeFamilyD tc tvs result injectivity eqns = eqns1 <- sequenceA eqns return (ClosedTypeFamilyD (TypeFamilyHead tc tvs1 result1 injectivity) eqns1) --- These were deprecated in GHC 8.0 with a plan to remove them in 8.2. If you --- remove this check please also: --- 1. remove deprecated functions --- 2. remove CPP language extension from top of this module --- 3. remove the FamFlavour data type from Syntax module --- 4. make sure that all references to FamFlavour are gone from DsMeta, --- Convert, TcSplice (follows from 3) -#if __GLASGOW_HASKELL__ >= 804 -#error Remove deprecated familyNoKindD, familyKindD, closedTypeFamilyNoKindD and closedTypeFamilyKindD -#endif - -{-# DEPRECATED familyNoKindD, familyKindD - "This function will be removed in the next stable release. Use openTypeFamilyD/dataFamilyD instead." #-} -familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ -familyNoKindD flav tc tvs = - case flav of - TypeFam -> return $ OpenTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing) - DataFam -> return $ DataFamilyD tc tvs Nothing - -familyKindD :: FamFlavour -> Name -> [TyVarBndr] -> Kind -> DecQ -familyKindD flav tc tvs k = - case flav of - TypeFam -> - return $ OpenTypeFamilyD (TypeFamilyHead tc tvs (KindSig k) Nothing) - DataFam -> return $ DataFamilyD tc tvs (Just k) - -{-# DEPRECATED closedTypeFamilyNoKindD, closedTypeFamilyKindD - "This function will be removed in the next stable release. Use closedTypeFamilyD instead." #-} -closedTypeFamilyNoKindD :: Name -> [TyVarBndr] -> [TySynEqnQ] -> DecQ -closedTypeFamilyNoKindD tc tvs eqns = - do eqns1 <- sequence eqns - return (ClosedTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing) eqns1) - -closedTypeFamilyKindD :: Name -> [TyVarBndr] -> Kind -> [TySynEqnQ] -> DecQ -closedTypeFamilyKindD tc tvs kind eqns = - do eqns1 <- sequence eqns - return (ClosedTypeFamilyD (TypeFamilyHead tc tvs (KindSig kind) Nothing) - eqns1) - roleAnnotD :: Name -> [Role] -> DecQ roleAnnotD name roles = return $ RoleAnnotD name roles @@ -874,13 +833,6 @@ funDep :: [Name] -> [Name] -> FunDep funDep = FunDep ------------------------------------------------------------------------------- --- * FamFlavour - -typeFam, dataFam :: FamFlavour -typeFam = TypeFam -dataFam = DataFam - -------------------------------------------------------------------------------- -- * RuleBndr ruleVar :: Name -> RuleBndrQ ruleVar = return . RuleVar diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs index bbb73b0..278b45e 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs @@ -466,11 +466,6 @@ instance Ppr FunDep where ppr_list xs = bar <+> commaSep xs ------------------------------ -instance Ppr FamFlavour where - ppr DataFam = text "data" - ppr TypeFam = text "type" - ------------------------------- instance Ppr FamilyResultSig where ppr NoSig = empty ppr (KindSig k) = dcolon <+> ppr k diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 0541a08..7589619 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -1776,9 +1776,6 @@ data TySynEqn = TySynEqn [Type] Type data FunDep = FunDep [Name] [Name] deriving( Show, Eq, Ord, Data, Generic ) -data FamFlavour = TypeFam | DataFam - deriving( Show, Eq, Ord, Data, Generic ) - data Foreign = ImportF Callconv Safety String Name Type | ExportF Callconv String Name Type deriving( Show, Eq, Ord, Data, Generic ) From git at git.haskell.org Mon Dec 4 21:14:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 21:14:35 +0000 (UTC) Subject: [commit: ghc] ghc-8.4's head updated: template-haskell: Rip out FamFlavour (cd4d830) Message-ID: <20171204211435.1F97F3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'ghc-8.4' now includes: b6428af Comments only: Trac #14511 b6a2691 Bump unix submodule f246d35 Darwin: Set deployment target d672b7f Darwin: Use gmp from homebrew 6998772 Make use of boot TyThings during typechecking. e1fb283 Handle CPP properly in Backpack 12efb23 Add trace injection bc761ad Cache TypeRep kinds aggressively 1acb922 Make the Con and Con' patterns produce evidence cd4d830 template-haskell: Rip out FamFlavour From git at git.haskell.org Mon Dec 4 21:40:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 21:40:00 +0000 (UTC) Subject: [commit: ghc] master: Fix ghc_packages (595f60f) Message-ID: <20171204214000.941A13A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/595f60fd55cc0305883c8a0b382a4b9718a0e0d8/ghc >--------------------------------------------------------------- commit 595f60fd55cc0305883c8a0b382a4b9718a0e0d8 Author: Ben Gamari Date: Mon Dec 4 16:15:52 2017 -0500 Fix ghc_packages The LaTeX produced by this previously failed to compile. Changing the first cell of the row from an inline to a paragraph fixes this. Then I noticed that the table overflowed the page. This is fixed by applying the longtable class. >--------------------------------------------------------------- 595f60fd55cc0305883c8a0b382a4b9718a0e0d8 docs/users_guide/ghc_packages.py | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/ghc_packages.py b/docs/users_guide/ghc_packages.py index c91a7f2..d4a688b 100644 --- a/docs/users_guide/ghc_packages.py +++ b/docs/users_guide/ghc_packages.py @@ -49,12 +49,13 @@ class PackageListDirective(Directive): for (pkg_path, reason) in sorted(packages): (pkg_name, pkg_version) = read_cabal_file(pkg_path) - cells = [ nodes.inline(text=pkg_name), + cells = [ nodes.paragraph(text=pkg_name), nodes.inline(text=pkg_version), reason ] package_list.append(cells) table = build_table_from_list(package_list, [20, 20, 40]) + table['classes'].append('longtable') return [table] ### Initialization From git at git.haskell.org Mon Dec 4 21:40:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 21:40:03 +0000 (UTC) Subject: [commit: ghc] master: template-haskell: Rip out FamFlavour (cfea745) Message-ID: <20171204214003.E07153A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cfea745097c619be8f9746d5a0d346eb06779129/ghc >--------------------------------------------------------------- commit cfea745097c619be8f9746d5a0d346eb06779129 Author: Ben Gamari Date: Mon Dec 4 13:50:36 2017 -0500 template-haskell: Rip out FamFlavour This was scheduled to happen for 8.2, it looks like it will actually happen in 8.4. >--------------------------------------------------------------- cfea745097c619be8f9746d5a0d346eb06779129 compiler/prelude/THNames.hs | 12 ------ docs/users_guide/8.4.1-notes.rst | 4 ++ libraries/ghci/GHCi/TH/Binary.hs | 1 - libraries/template-haskell/Language/Haskell/TH.hs | 2 +- .../template-haskell/Language/Haskell/TH/Lib.hs | 3 +- .../Language/Haskell/TH/Lib/Internal.hs | 48 ---------------------- .../template-haskell/Language/Haskell/TH/Ppr.hs | 5 --- .../template-haskell/Language/Haskell/TH/Syntax.hs | 3 -- libraries/template-haskell/changelog.md | 7 +++- 9 files changed, 11 insertions(+), 74 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 cfea745097c619be8f9746d5a0d346eb06779129 From git at git.haskell.org Mon Dec 4 21:40:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 21:40:07 +0000 (UTC) Subject: [commit: ghc] master: Bump version to 8.5 (d6fccfb) Message-ID: <20171204214007.4B94A3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d6fccfb2ba087abfdd4a68b13165e1312f9af022/ghc >--------------------------------------------------------------- commit d6fccfb2ba087abfdd4a68b13165e1312f9af022 Author: Ben Gamari Date: Wed Nov 29 09:54:14 2017 -0500 Bump version to 8.5 The ghc-8.4 branch has now been cut. Updates the haddock submodule. >--------------------------------------------------------------- d6fccfb2ba087abfdd4a68b13165e1312f9af022 configure.ac | 2 +- iserv/iserv-bin.cabal | 6 +++--- libraries/template-haskell/template-haskell.cabal | 2 +- utils/haddock | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/configure.ac b/configure.ac index d67e5bd..6733385 100644 --- a/configure.ac +++ b/configure.ac @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.3], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.5], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO : ${RELEASE=NO} diff --git a/iserv/iserv-bin.cabal b/iserv/iserv-bin.cabal index 846a111..a713e6f 100644 --- a/iserv/iserv-bin.cabal +++ b/iserv/iserv-bin.cabal @@ -85,7 +85,7 @@ Library bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.6, deepseq >= 1.4 && < 1.5, - ghci == 8.3, + ghci == 8.5, network >= 2.6 && < 2.7, directory >= 1.3 && < 1.4, filepath >= 1.4 && < 1.5 @@ -112,7 +112,7 @@ Executable iserv bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.6, deepseq >= 1.4 && < 1.5, - ghci == 8.3 + ghci == 8.5 if os(windows) Cpp-Options: -DWINDOWS @@ -133,7 +133,7 @@ Executable iserv-proxy bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.6, deepseq >= 1.4 && < 1.5, - ghci == 8.3, + ghci == 8.5, directory >= 1.3 && < 1.4, network >= 2.6, filepath >= 1.4 && < 1.5, diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal index 887865d..7770a38 100644 --- a/libraries/template-haskell/template-haskell.cabal +++ b/libraries/template-haskell/template-haskell.cabal @@ -52,7 +52,7 @@ Library build-depends: base >= 4.9 && < 4.12, - ghc-boot-th == 8.3, + ghc-boot-th == 8.5, pretty == 1.1.* ghc-options: -Wall diff --git a/utils/haddock b/utils/haddock index ae0d140..aaf0733 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit ae0d140334fff57f2737dbd7c5804b4868d9c3ab +Subproject commit aaf07338cbfec7df69532a4d1e8a0f21c9a1cfde From git at git.haskell.org Mon Dec 4 21:44:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Dec 2017 21:44:27 +0000 (UTC) Subject: [commit: ghc] ghc-8.4's head updated: Fix ghc_packages (595f60f) Message-ID: <20171204214427.56CAD3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'ghc-8.4' now includes: cfea745 template-haskell: Rip out FamFlavour 595f60f Fix ghc_packages From git at git.haskell.org Tue Dec 5 01:14:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Dec 2017 01:14:38 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump (e26511a) Message-ID: <20171205011438.0709D3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/e26511a7d213d70fd9a4dc367dd776d5622f6c90/ghc >--------------------------------------------------------------- commit e26511a7d213d70fd9a4dc367dd776d5622f6c90 Author: Moritz Angermann Date: Tue Dec 5 09:14:19 2017 +0800 bump >--------------------------------------------------------------- e26511a7d213d70fd9a4dc367dd776d5622f6c90 hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index ef6f26c..1a6d1f9 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit ef6f26cbd27ce1696eeb8f08ed3c093b9cbe2872 +Subproject commit 1a6d1f98dbbbd3bae9cd76f6e5042a82a0687b82 From git at git.haskell.org Tue Dec 5 01:14:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Dec 2017 01:14:35 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump (03df9d7) Message-ID: <20171205011435.26DE83A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/03df9d75111d0c38bbb0e46dc4622139996eee56/ghc >--------------------------------------------------------------- commit 03df9d75111d0c38bbb0e46dc4622139996eee56 Author: Moritz Angermann Date: Tue Dec 5 07:55:51 2017 +0800 bump >--------------------------------------------------------------- 03df9d75111d0c38bbb0e46dc4622139996eee56 hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index d1faf55..ef6f26c 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit d1faf55a4bbc5b138e80308299606ad44d565120 +Subproject commit ef6f26cbd27ce1696eeb8f08ed3c093b9cbe2872 From git at git.haskell.org Tue Dec 5 07:50:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Dec 2017 07:50:54 +0000 (UTC) Subject: [commit: ghc] master: rts: fix filename case for mingw32 target (30d6373) Message-ID: <20171205075054.DE09F3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/30d6373e6715a05c02775b336e832341a6fc0524/ghc >--------------------------------------------------------------- commit 30d6373e6715a05c02775b336e832341a6fc0524 Author: Sergei Trofimovich Date: Tue Dec 5 07:49:24 2017 +0000 rts: fix filename case for mingw32 target The failure is visible when we build a cross-compiler from linux to mingw32 as: ``` $ ./configure --host=x86_64-pc-linux-gnu \ --target=x86_64-w64-mingw32 $ make rts/linker/PEi386.c:159:10: error: fatal error: Psapi.h: No such file or directory #include ^~~~~~~~~ | 159 | #include | ^ ``` The problem here is case-sensitive linux filesystem. On windows it does not matter what case is used for includes and libraries. mingw32 provides all libraries and headers lowercase. This change fixes case for , , -ldbghelp, -lpsapi. Signed-off-by: Sergei Trofimovich Reviewers: bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4247 >--------------------------------------------------------------- 30d6373e6715a05c02775b336e832341a6fc0524 rts/linker/PEi386.c | 2 +- rts/package.conf.in | 4 ++-- rts/rts.cabal.in | 4 ++-- rts/win32/veh_excn.c | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c index 3dcf8c4..364f778 100644 --- a/rts/linker/PEi386.c +++ b/rts/linker/PEi386.c @@ -156,7 +156,7 @@ static uint8_t* cstring_from_COFF_symbol_name( #include #include #include -#include +#include #if defined(x86_64_HOST_ARCH) static size_t makeSymbolExtra_PEi386( diff --git a/rts/package.conf.in b/rts/package.conf.in index 52d7ef8..1746af5 100644 --- a/rts/package.conf.in +++ b/rts/package.conf.in @@ -45,8 +45,8 @@ extra-libraries: ,"wsock32" /* for the linker */ ,"gdi32" /* for the linker */ ,"winmm" /* for the linker */ - ,"Dbghelp" /* for crash dump */ - ,"Psapi" /* for process information. */ + ,"dbghelp" /* for crash dump */ + ,"psapi" /* for process information. */ #endif #if NEED_PTHREAD_LIB , "pthread" /* for pthread_getthreadid_np, pthread_create, etc. */ diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in index 71aef3d..53b6271 100644 --- a/rts/rts.cabal.in +++ b/rts/rts.cabal.in @@ -58,9 +58,9 @@ library -- for the linker wsock32 gdi32 winmm -- for crash dump - Dbghelp + dbghelp -- for process information - Psapi + psapi if flag(need-pthread) -- for pthread_getthreadid_np, pthread_create, ... extra-libraries: pthread diff --git a/rts/win32/veh_excn.c b/rts/win32/veh_excn.c index fd50562..4b7d29a 100644 --- a/rts/win32/veh_excn.c +++ b/rts/win32/veh_excn.c @@ -20,7 +20,7 @@ #include #include #include -#include +#include ///////////////////////////////// // Exception / signal handlers. From git at git.haskell.org Tue Dec 5 07:52:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Dec 2017 07:52:17 +0000 (UTC) Subject: [commit: ghc] master: utils/hsc2hs: update submodule (1ecbe9c) Message-ID: <20171205075217.D8D073A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1ecbe9ccb10f42dc5b133ffb2c7b1e9247b1ba52/ghc >--------------------------------------------------------------- commit 1ecbe9ccb10f42dc5b133ffb2c7b1e9247b1ba52 Author: Sergei Trofimovich Date: Tue Dec 5 07:51:16 2017 +0000 utils/hsc2hs: update submodule This pulls single change to fix building of cross-compilers: * ghc.mk: Use the same conditional install logic from unlit Signed-off-by: Sergei Trofimovich Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4248 >--------------------------------------------------------------- 1ecbe9ccb10f42dc5b133ffb2c7b1e9247b1ba52 utils/hsc2hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/hsc2hs b/utils/hsc2hs index 9483ad1..738f366 160000 --- a/utils/hsc2hs +++ b/utils/hsc2hs @@ -1 +1 @@ -Subproject commit 9483ad10064fbbb97ab525280623826b1ef63959 +Subproject commit 738f3666c878ee9e79c3d5e819ef8b3460288edf From git at git.haskell.org Thu Dec 7 09:40:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Dec 2017 09:40:51 +0000 (UTC) Subject: [commit: ghc] master: Forward-port changes from GHC 8.2 branch (5f332e1) Message-ID: <20171207094051.B43803A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5f332e1dab000e1f79c127d441f618280d14d2bd/ghc >--------------------------------------------------------------- commit 5f332e1dab000e1f79c127d441f618280d14d2bd Author: Herbert Valerio Riedel Date: Thu Dec 7 09:58:00 2017 +0100 Forward-port changes from GHC 8.2 branch (cherry picked from commit 3fa061a647d2fdc182eff9296eea02d6a7d516cd) >--------------------------------------------------------------- 5f332e1dab000e1f79c127d441f618280d14d2bd libraries/base/base.cabal | 10 +++++----- libraries/base/changelog.md | 8 ++++++++ libraries/ghci/changelog.md | 4 ++++ libraries/integer-gmp/integer-gmp.cabal | 13 +++++++++++-- 4 files changed, 28 insertions(+), 7 deletions(-) diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index 8817f69..4252cdc 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -9,11 +9,11 @@ maintainer: libraries at haskell.org bug-reports: http://ghc.haskell.org/trac/ghc/newticket?component=libraries/base synopsis: Basic libraries category: Prelude +build-type: Configure description: - This package contains the "Prelude" and its support libraries, + This package contains the Standard Haskell "Prelude" and its support libraries, and a large collection of useful libraries ranging from data structures to parsing combinators and debugging utilities. -build-type: Configure extra-tmp-files: autom4te.cache @@ -94,17 +94,17 @@ Library UnliftedFFITypes Unsafe - build-depends: rts == 1.0.*, ghc-prim == 0.5.* + build-depends: rts == 1.0, ghc-prim ^>= 0.5.1.0 -- sanity-check to ensure exactly one flag is set if !((flag(integer-gmp) && !flag(integer-simple)) || (!flag(integer-gmp) && flag(integer-simple))) build-depends: invalid-cabal-flag-settings<0 if flag(integer-simple) - build-depends: integer-simple >= 0.1.1 && < 0.2 + build-depends: integer-simple ^>= 0.1.1 if flag(integer-gmp) - build-depends: integer-gmp >= 1.0 && < 1.1 + build-depends: integer-gmp ^>= 1.0.1 cpp-options: -DOPTIMISE_INTEGER_GCD_LCM exposed-modules: diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 7e3c1b0..e908475 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -73,6 +73,14 @@ * `getExecutablePath` now resolves symlinks on Windows (#14483) +## 4.10.1.0 *November 2017* + * Bundled with GHC 8.2.2 + + * The file locking primitives provided by `GHC.IO.Handle` now use + Linux open file descriptor locking if available. + + * Fixed bottoming definition of `clearBit` for `Natural` + ## 4.10.0.0 *July 2017* * Bundled with GHC 8.2.1 diff --git a/libraries/ghci/changelog.md b/libraries/ghci/changelog.md index 3775eda..9ced829 100644 --- a/libraries/ghci/changelog.md +++ b/libraries/ghci/changelog.md @@ -1,3 +1,7 @@ +## 8.2.2 Nov 2017 + + * Bundled with GHC 8.2.2 + ## 8.0.1 *Feb 2016* * Bundled with GHC 8.0.1 diff --git a/libraries/integer-gmp/integer-gmp.cabal b/libraries/integer-gmp/integer-gmp.cabal index 2f32b34..6edacea 100644 --- a/libraries/integer-gmp/integer-gmp.cabal +++ b/libraries/integer-gmp/integer-gmp.cabal @@ -1,5 +1,7 @@ +cabal-version: 2.0 name: integer-gmp version: 1.0.1.0 + synopsis: Integer library based on GMP license: BSD3 license-file: LICENSE @@ -7,7 +9,14 @@ author: Herbert Valerio Riedel maintainer: hvr at gnu.org category: Numeric, Algebra build-type: Configure -cabal-version: >=1.10 +description: + This package provides the low-level implementation of the standard + 'Integer' type based on the + . + . + This package provides access to the internal representation of + 'Integer' as well as primitive operations with no proper error + handling, and should only be used directly with the utmost care. extra-source-files: aclocal.m4 @@ -46,7 +55,7 @@ library StandaloneDeriving UnboxedTuples UnliftedFFITypes - build-depends: ghc-prim + build-depends: ghc-prim ^>= 0.5.1.0 hs-source-dirs: src/ ghc-options: -this-unit-id integer-gmp -Wall cc-options: -std=c99 -Wall From git at git.haskell.org Thu Dec 7 17:50:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Dec 2017 17:50:19 +0000 (UTC) Subject: [commit: ghc] master: Refactor ConDecl: Trac #14529 (fa29df0) Message-ID: <20171207175019.C7BEF3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fa29df02a1b0b926afb2525a258172dcbf0ea460/ghc >--------------------------------------------------------------- commit fa29df02a1b0b926afb2525a258172dcbf0ea460 Author: Simon Peyton Jones Date: Tue Nov 28 11:33:37 2017 +0000 Refactor ConDecl: Trac #14529 This patch refactors HsDecls.ConDecl. Specifically * ConDeclGADT was horrible, with all the information hidden inside con_res_ty. Now it's kept separate, as it should be. * ConDeclH98: use [LHsTyVarBndr] instead of LHsQTyVars for the existentials. There is no implicit binding here. * Add a field con_forall to both ConDeclGADT and ConDeclH98 which says if there is an explicit user-written forall. * Field renamings in ConDecl con_cxt to con_mb_cxt con_details to con_args There is an accompanying submodule update to Haddock. Also the following change turned out to remove a lot of clutter: * add a smart constructor for HsAppsTy, namely mkHsAppsTy, and use it consistently. This avoids a lot of painful pattern matching for the common singleton case. Two api-annotation tests (T10278, and T10399) are broken, hence marking them as expect_broken(14529). Alan is going to fix them, probably by changing the con_forall field to con_forall :: Maybe SrcSpan instead of Bool >--------------------------------------------------------------- fa29df02a1b0b926afb2525a258172dcbf0ea460 compiler/deSugar/DsMeta.hs | 119 ++++++++---------- compiler/hsSyn/Convert.hs | 56 ++++----- compiler/hsSyn/HsDecls.hs | 140 +++++++++++++-------- compiler/hsSyn/HsTypes.hs | 45 +++---- compiler/hsSyn/HsUtils.hs | 90 ++++++------- compiler/parser/Parser.y | 12 +- compiler/parser/RdrHsSyn.hs | 70 +++++------ compiler/rename/RnNames.hs | 25 ++-- compiler/rename/RnSource.hs | 116 +++++++++++------ compiler/rename/RnTypes.hs | 95 +++++++------- compiler/typecheck/TcHsType.hs | 6 +- compiler/typecheck/TcTyClsDecls.hs | 137 +++++++++----------- compiler/utils/ListSetOps.hs | 7 +- testsuite/tests/ghc-api/annotations/all.T | 6 +- .../parser/should_compile/DumpParsedAst.stderr | 60 ++++----- .../parser/should_compile/DumpRenamedAst.stderr | 127 +++++++++---------- .../tests/parser/should_compile/T14189.stderr | 15 +-- testsuite/tests/patsyn/should_fail/T11039.stderr | 3 +- testsuite/tests/patsyn/should_fail/T11667.stderr | 3 +- testsuite/tests/rename/should_compile/T5331.stderr | 2 +- testsuite/tests/th/T13123.hs | 2 + .../tests/typecheck/should_compile/T2494.stderr | 12 +- utils/haddock | 2 +- utils/hsc2hs | 2 +- 24 files changed, 590 insertions(+), 562 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 fa29df02a1b0b926afb2525a258172dcbf0ea460 From git at git.haskell.org Thu Dec 7 17:50:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Dec 2017 17:50:16 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: More post-release wibbles (3fa061a) Message-ID: <20171207175016.E3D7F3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/3fa061a647d2fdc182eff9296eea02d6a7d516cd/ghc >--------------------------------------------------------------- commit 3fa061a647d2fdc182eff9296eea02d6a7d516cd Author: Herbert Valerio Riedel Date: Mon Dec 4 20:30:17 2017 +0100 More post-release wibbles >--------------------------------------------------------------- 3fa061a647d2fdc182eff9296eea02d6a7d516cd libraries/base/base.cabal | 12 ++++++------ libraries/ghci/changelog.md | 4 ++++ libraries/integer-gmp/integer-gmp.cabal | 13 +++++++++++-- 3 files changed, 21 insertions(+), 8 deletions(-) diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index 968b607..bd4b1f9 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -1,3 +1,4 @@ +cabal-version: 2.0 name: base version: 4.10.1.0 -- NOTE: Don't forget to update ./changelog.md @@ -7,12 +8,11 @@ maintainer: libraries at haskell.org bug-reports: http://ghc.haskell.org/trac/ghc/newticket?component=libraries/base synopsis: Basic libraries category: Prelude +build-type: Configure description: - This package contains the "Prelude" and its support libraries, + This package contains the Standard Haskell "Prelude" and its support libraries, and a large collection of useful libraries ranging from data structures to parsing combinators and debugging utilities. -cabal-version: >=1.10 -build-type: Configure extra-tmp-files: autom4te.cache @@ -93,17 +93,17 @@ Library UnliftedFFITypes Unsafe - build-depends: rts == 1.0.*, ghc-prim == 0.5.* + build-depends: rts == 1.0, ghc-prim ^>= 0.5.1.0 -- sanity-check to ensure exactly one flag is set if !((flag(integer-gmp) && !flag(integer-simple)) || (!flag(integer-gmp) && flag(integer-simple))) build-depends: invalid-cabal-flag-settings<0 if flag(integer-simple) - build-depends: integer-simple >= 0.1.1 && < 0.2 + build-depends: integer-simple ^>= 0.1.1 if flag(integer-gmp) - build-depends: integer-gmp >= 1.0 && < 1.1 + build-depends: integer-gmp ^>= 1.0.1 cpp-options: -DOPTIMISE_INTEGER_GCD_LCM exposed-modules: diff --git a/libraries/ghci/changelog.md b/libraries/ghci/changelog.md index 5ba7dd1..eed4bb3 100644 --- a/libraries/ghci/changelog.md +++ b/libraries/ghci/changelog.md @@ -1,3 +1,7 @@ +## 8.2.2 Nov 2017 + + * Bundled with GHC 8.2.2 + ## 8.2.1 Jul 2017 * Bundled with GHC 8.2.1 diff --git a/libraries/integer-gmp/integer-gmp.cabal b/libraries/integer-gmp/integer-gmp.cabal index 2f32b34..6edacea 100644 --- a/libraries/integer-gmp/integer-gmp.cabal +++ b/libraries/integer-gmp/integer-gmp.cabal @@ -1,5 +1,7 @@ +cabal-version: 2.0 name: integer-gmp version: 1.0.1.0 + synopsis: Integer library based on GMP license: BSD3 license-file: LICENSE @@ -7,7 +9,14 @@ author: Herbert Valerio Riedel maintainer: hvr at gnu.org category: Numeric, Algebra build-type: Configure -cabal-version: >=1.10 +description: + This package provides the low-level implementation of the standard + 'Integer' type based on the + . + . + This package provides access to the internal representation of + 'Integer' as well as primitive operations with no proper error + handling, and should only be used directly with the utmost care. extra-source-files: aclocal.m4 @@ -46,7 +55,7 @@ library StandaloneDeriving UnboxedTuples UnliftedFFITypes - build-depends: ghc-prim + build-depends: ghc-prim ^>= 0.5.1.0 hs-source-dirs: src/ ghc-options: -this-unit-id integer-gmp -Wall cc-options: -std=c99 -Wall From git at git.haskell.org Thu Dec 7 21:49:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Dec 2017 21:49:17 +0000 (UTC) Subject: [commit: ghc] master: Revert accidental hsc2hs submodule downgrade (e4a1f03) Message-ID: <20171207214917.3E9AB3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e4a1f032da39d8ee58498962cdc9bf5fed7b376e/ghc >--------------------------------------------------------------- commit e4a1f032da39d8ee58498962cdc9bf5fed7b376e Author: Herbert Valerio Riedel Date: Thu Dec 7 20:05:56 2017 +0100 Revert accidental hsc2hs submodule downgrade This submodule update was committed unintentionally in fa29df02a1b0b926afb2525a258172dcbf0ea460 >--------------------------------------------------------------- e4a1f032da39d8ee58498962cdc9bf5fed7b376e utils/hsc2hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/hsc2hs b/utils/hsc2hs index 9483ad1..738f366 160000 --- a/utils/hsc2hs +++ b/utils/hsc2hs @@ -1 +1 @@ -Subproject commit 9483ad10064fbbb97ab525280623826b1ef63959 +Subproject commit 738f3666c878ee9e79c3d5e819ef8b3460288edf From git at git.haskell.org Fri Dec 8 05:22:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:22:27 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: no tbaa (72a3b94) Message-ID: <20171208052227.ED0DB3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/72a3b9468eefe3db60ce8a7050f230a8a1bf0151/ghc >--------------------------------------------------------------- commit 72a3b9468eefe3db60ce8a7050f230a8a1bf0151 Author: Moritz Angermann Date: Sat Dec 2 14:09:03 2017 +0800 no tbaa >--------------------------------------------------------------- 72a3b9468eefe3db60ce8a7050f230a8a1bf0151 compiler/main/DriverPipeline.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 269017c..035fb17 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -812,8 +812,8 @@ fastLlvmPipeline dflags llvmOptions :: DynFlags -> [(String, String)] -- ^ pairs of (opt, llc) arguments llvmOptions dflags = - [("-enable-tbaa -tbaa", "-enable-tbaa") | gopt Opt_LlvmTBAA dflags ] - ++ [("-relocation-model=" ++ rmodel +-- [("-enable-tbaa -tbaa", "-enable-tbaa") | gopt Opt_LlvmTBAA dflags ] + [("-relocation-model=" ++ rmodel ,"-relocation-model=" ++ rmodel) | not (null rmodel)] ++ [("-stack-alignment=" ++ (show align) ,"-stack-alignment=" ++ (show align)) | align > 0 ] From git at git.haskell.org Fri Dec 8 05:22:37 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:22:37 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds test (3a90775) Message-ID: <20171208052237.3B4033A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/3a9077575c1d3e08563da4635ffebaed843de376/ghc >--------------------------------------------------------------- commit 3a9077575c1d3e08563da4635ffebaed843de376 Author: Moritz Angermann Date: Thu Sep 21 22:07:44 2017 +0800 Adds test >--------------------------------------------------------------- 3a9077575c1d3e08563da4635ffebaed843de376 testsuite/tests/codeGen/should_run/T14251.hs | 22 ++++++++++++++++++++++ testsuite/tests/codeGen/should_run/T14251.stdout | 1 + testsuite/tests/codeGen/should_run/all.T | 1 + 3 files changed, 24 insertions(+) diff --git a/testsuite/tests/codeGen/should_run/T14251.hs b/testsuite/tests/codeGen/should_run/T14251.hs new file mode 100644 index 0000000..6f552e1 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14251.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE MagicHash, BangPatterns #-} +module Main where + +-- A minor modification from T8064.hs. +-- +-- The key here is that we ensure that +-- subsequently passed floats do not +-- accidentally end up in previous +-- registers. +-- + +import GHC.Exts + +{-# NOINLINE f #-} +f :: (Int# -> Float# -> Double# -> Float# -> Double# -> String) -> String +f g = g 3# 4.0# 5.0## 6.0# 6.9## ++ " World!" + +{-# NOINLINE q #-} +q :: Int# -> Float# -> Double# -> Float# -> Double# -> String +q i j k l m = "Hello " ++ show (F# l) ++ " " ++ show (D# m) + +main = putStrLn (f $ q) diff --git a/testsuite/tests/codeGen/should_run/T14251.stdout b/testsuite/tests/codeGen/should_run/T14251.stdout new file mode 100644 index 0000000..8ec577b --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14251.stdout @@ -0,0 +1 @@ +Hello 6.0 6.9 World! diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 42d8a2f..8a76863 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -165,3 +165,4 @@ test('T13825-unit', extra_run_opts('"' + config.libdir + '"'), compile_and_run, ['-package ghc']) +test('T14251', normal, compile_and_run, ['-O2']) From git at git.haskell.org Fri Dec 8 05:22:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:22:33 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Add Pdep and Pext primops. (8702bae) Message-ID: <20171208052233.C7F833A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/8702bae688341baae371a00c369ff70edc0aae83/ghc >--------------------------------------------------------------- commit 8702bae688341baae371a00c369ff70edc0aae83 Author: Moritz Angermann Date: Sat Nov 18 17:45:26 2017 +0800 Add Pdep and Pext primops. Were introduced in f5dc8ccc [bmi] only if enabled. Adds +bmi/bmi2 as needed. pdep/pext signature fix. >--------------------------------------------------------------- 8702bae688341baae371a00c369ff70edc0aae83 compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs | 38 ++++++++++++++++++++++++++++ compiler/main/DriverPipeline.hs | 2 ++ libraries/ghc-prim/cbits/pdep.c | 3 +-- libraries/ghc-prim/cbits/pext.c | 3 +-- 4 files changed, 42 insertions(+), 4 deletions(-) diff --git a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs index 09ffd99..0f02df2 100644 --- a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs +++ b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs @@ -888,6 +888,44 @@ genCall blockMap regMap target dsts args = case target of ty <- EDSL.deptr (EDSL.ty slot) EDSL.store slot =<< cast ty ret | otherwise -> panic "genCall: PopCnt not implemented." + (PrimTarget (MO_Pdep w)) + | ([dst], [src, mask]) <- (dsts, args) -> do + slot <- lookupLocalReg dst regMap + + src' <- bind2 cast (EDSL.i (widthInBits w)) (exprToVar blockMap regMap src) + mask' <- bind2 cast (EDSL.i (widthInBits w)) (exprToVar blockMap regMap mask) + + hasBmi <- isBmiEnabled <$> getDynFlags + f <- let w' = widthInBits w + fn = if hasBmi + then "llvm.x86.bmi.pdep." + else "hs_pdep" + in EDSL.fun (fn ++ show w') =<< [ EDSL.i w', EDSL.i w' ] --> EDSL.i w' + + Just ret <- EDSL.ccall f [ src', mask' ] + ty <- EDSL.deptr (EDSL.ty slot) + EDSL.store slot =<< cast ty ret + | otherwise -> panic "genCall: Pdep not implemented." + (PrimTarget (MO_Pext w)) + | ([dst], [src, mask]) <- (dsts, args) -> do + slot <- lookupLocalReg dst regMap + + src' <- bind2 cast (EDSL.i (widthInBits w)) (exprToVar blockMap regMap src) + mask' <- bind2 cast (EDSL.i (widthInBits w)) (exprToVar blockMap regMap mask) + + arch <- platformArch . targetPlatform <$> getDynFlags + + hasBmi <- isBmiEnabled <$> getDynFlags + f <- let w' = widthInBits w + fn = if hasBmi + then "llvm.x86.bmi.pext." + else "hs_pext" + in EDSL.fun (fn ++ show w') =<< [ EDSL.i w', EDSL.i w' ] --> EDSL.i w' + + Just ret <- EDSL.ccall f [ src', mask' ] + ty <- EDSL.deptr (EDSL.ty slot) + EDSL.store slot =<< cast ty ret + | otherwise -> panic "genCall: Pext not implemented." (PrimTarget (MO_Clz w)) | ([dst], [e]) <- (dsts, args) -> do slot <- lookupLocalReg dst regMap diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 035fb17..af64874 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -848,6 +848,8 @@ llvmOptions dflags = ++ ["+avx512cd"| isAvx512cdEnabled dflags ] ++ ["+avx512er"| isAvx512erEnabled dflags ] ++ ["+avx512pf"| isAvx512pfEnabled dflags ] + ++ ["+bmi" | isBmiEnabled dflags ] + ++ ["+bmi2" | isBmi2Enabled dflags ] -- ----------------------------------------------------------------------------- -- | Each phase in the pipeline returns the next phase to execute, and the diff --git a/libraries/ghc-prim/cbits/pdep.c b/libraries/ghc-prim/cbits/pdep.c index a3b7da3..9a2b014 100644 --- a/libraries/ghc-prim/cbits/pdep.c +++ b/libraries/ghc-prim/cbits/pdep.c @@ -1,9 +1,8 @@ #include "Rts.h" #include "MachDeps.h" -extern StgWord hs_pdep64(StgWord64 src, StgWord mask); StgWord -hs_pdep64(StgWord src, StgWord mask) +hs_pdep64(StgWord64 src, StgWord64 mask) { uint64_t result = 0; diff --git a/libraries/ghc-prim/cbits/pext.c b/libraries/ghc-prim/cbits/pext.c index d08fb94..db9fddf 100644 --- a/libraries/ghc-prim/cbits/pext.c +++ b/libraries/ghc-prim/cbits/pext.c @@ -1,9 +1,8 @@ #include "Rts.h" #include "MachDeps.h" -extern StgWord hs_pext64(StgWord src, StgWord mask); StgWord -hs_pext64(StgWord src, StgWord mask) +hs_pext64(StgWord64 src, StgWord64 mask) { uint64_t result = 0; int offset = 0; From git at git.haskell.org Fri Dec 8 05:22:30 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:22:30 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Use packed structs. (ce8c529) Message-ID: <20171208052230.D96A63A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/ce8c529a89565d37ff7364552ae6311371eac745/ghc >--------------------------------------------------------------- commit ce8c529a89565d37ff7364552ae6311371eac745 Author: Moritz Angermann Date: Sun Dec 3 20:28:55 2017 +0800 Use packed structs. GHC computes offsets into structs, and we do not use getElementPointer. If we had used gep, we could use unpacked structs as well. >--------------------------------------------------------------- ce8c529a89565d37ff7364552ae6311371eac745 compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs index c1c9e8c..09ffd99 100644 --- a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs +++ b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs @@ -299,7 +299,7 @@ llvmCodeGen' prc@(CmmProc{}) = Right $ do case mb_info of Nothing -> EDSL.ghcdefT (pure link) lbl sig body Just (Statics _ statics) - -> do prefixData <- EDSL.struct =<< mapM genData statics + -> do prefixData <- EDSL.packedStruct =<< mapM genData statics EDSL.ghcdefT (pure $ EDSL.withPrefixData prefixData . link) lbl sig body -- llvmCodeGen' _ = panic "LlvmCodeGen': unhandled raw cmm group" @@ -427,7 +427,7 @@ genStatics s@(Statics l statics) = do let link | externallyVisibleCLabel l = Val.external -- External | otherwise = Val.private -- Internal - struct <- EDSL.struct body + struct <- EDSL.packedStruct body -- make statics mutable. -- E.g. -- x :: T From git at git.haskell.org Fri Dec 8 05:22:40 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:22:40 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Update iserv-proxy (dd3688b) Message-ID: <20171208052240.0A5FC3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/dd3688bd3bb1867ce12fb67cddaaf74e3532b998/ghc >--------------------------------------------------------------- commit dd3688bd3bb1867ce12fb67cddaaf74e3532b998 Author: Moritz Angermann Date: Sun Nov 26 17:08:08 2017 +0800 Update iserv-proxy >--------------------------------------------------------------- dd3688bd3bb1867ce12fb67cddaaf74e3532b998 utils/iserv-proxy/iserv-proxy.cabal | 2 +- utils/iserv-proxy/{proxy-src/Remote.hs => src/Main.hs} | 0 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/iserv-proxy/iserv-proxy.cabal b/utils/iserv-proxy/iserv-proxy.cabal index 8f13189..e028c99 100644 --- a/utils/iserv-proxy/iserv-proxy.cabal +++ b/utils/iserv-proxy/iserv-proxy.cabal @@ -63,7 +63,7 @@ cabal-version: >=1.10 Executable iserv-proxy Default-Language: Haskell2010 - Main-Is: Remote.hs + Main-Is: Main.hs Hs-Source-Dirs: src Build-Depends: array >= 0.5 && < 0.6, base >= 4 && < 5, diff --git a/utils/iserv-proxy/proxy-src/Remote.hs b/utils/iserv-proxy/src/Main.hs similarity index 100% rename from utils/iserv-proxy/proxy-src/Remote.hs rename to utils/iserv-proxy/src/Main.hs From git at git.haskell.org Fri Dec 8 05:22:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:22:44 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Move `iserv` into `utils` and change package name from `iserv-bin` to `iserv` (9100879) Message-ID: <20171208052244.21ABE3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/9100879749707da95095055f16f653fa77b20cb6/ghc >--------------------------------------------------------------- commit 9100879749707da95095055f16f653fa77b20cb6 Author: Moritz Angermann Date: Sat Nov 25 15:10:52 2017 +0800 Move `iserv` into `utils` and change package name from `iserv-bin` to `iserv` This is done for consistency. We usually call the package file the same name the folder has. The move into `utils` is done so that we can move the library into `libraries/iserv` and the proxy into `utils/iserv-proxy` and then break the `iserv.cabal` apart. This will make building the cross compiler with TH simpler, because we can build the library and proxy as separate packages. >--------------------------------------------------------------- 9100879749707da95095055f16f653fa77b20cb6 ghc.mk | 13 +-- {iserv => libraries/libiserv}/Makefile | 0 {iserv => libraries/libiserv}/cbits/iservmain.c | 0 libraries/libiserv/ghc.mk | 5 + libraries/libiserv/libiserv.cabal | 39 +++++++ {iserv => libraries/libiserv}/proxy-src/Remote.hs | 0 {iserv => libraries/libiserv}/src/GHCi/Utils.hsc | 0 {iserv => libraries/libiserv}/src/Lib.hs | 0 {iserv => libraries/libiserv}/src/Main.hs | 0 .../libiserv}/src/Remote/Message.hs | 0 {iserv => libraries/libiserv}/src/Remote/Slave.hs | 0 {iserv => utils/iserv-proxy}/Makefile | 0 utils/iserv-proxy/ghc.mk | 113 +++++++++++++++++++++ .../iserv-proxy/iserv-proxy.cabal | 70 +------------ {iserv => utils/iserv-proxy}/proxy-src/Remote.hs | 0 {iserv => utils/iserv}/Makefile | 0 {iserv => utils/iserv}/cbits/iservmain.c | 0 {iserv => utils/iserv}/ghc.mk | 66 ++++++------ utils/iserv/iserv.cabal | 44 ++++++++ {iserv => utils/iserv}/src/Main.hs | 0 20 files changed, 245 insertions(+), 105 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 9100879749707da95095055f16f653fa77b20cb6 From git at git.haskell.org Fri Dec 8 05:22:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:22:46 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds `smp` flag to rts.cabal. (c4483b5) Message-ID: <20171208052246.DF7B53A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/c4483b5b8fefd2dcb176e1cd2c3455d9167e7b6c/ghc >--------------------------------------------------------------- commit c4483b5b8fefd2dcb176e1cd2c3455d9167e7b6c Author: Moritz Angermann Date: Sat Nov 25 20:49:56 2017 +0800 Adds `smp` flag to rts.cabal. >--------------------------------------------------------------- c4483b5b8fefd2dcb176e1cd2c3455d9167e7b6c rts/rts.cabal.in | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in index 71aef3d..b33a5f4 100644 --- a/rts/rts.cabal.in +++ b/rts/rts.cabal.in @@ -24,6 +24,8 @@ flag 64bit default: @Cabal64bit@ flag leading-underscore default: @CabalLeadingUnderscore@ +flag smp + default: True library -- rts is a wired in package and @@ -72,6 +74,8 @@ library if flag(libdw) -- for backtraces extra-libraries: elf dw + if !flag(smp) + cpp-options: -DNOSMP include-dirs: build ../includes includes includes/dist-derivedconstants/header @FFIIncludeDir@ From git at git.haskell.org Fri Dec 8 05:22:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:22:49 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: adds -latomic to. ghc-prim (2477a06) Message-ID: <20171208052249.A93A73A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/2477a0635cb4871e68b035917838b3713f0490ea/ghc >--------------------------------------------------------------- commit 2477a0635cb4871e68b035917838b3713f0490ea Author: Moritz Angermann Date: Mon Dec 4 10:56:13 2017 +0800 adds -latomic to. ghc-prim >--------------------------------------------------------------- 2477a0635cb4871e68b035917838b3713f0490ea libraries/ghc-prim/ghc-prim.cabal | 3 +++ 1 file changed, 3 insertions(+) diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal index 9b8c1ac..fc49857 100644 --- a/libraries/ghc-prim/ghc-prim.cabal +++ b/libraries/ghc-prim/ghc-prim.cabal @@ -66,6 +66,9 @@ Library -- on Windows. Required because of mingw32. extra-libraries: user32, mingw32, mingwex + if os(linux) + extra-libraries: atomic + c-sources: cbits/atomic.c cbits/bswap.c From git at git.haskell.org Fri Dec 8 05:22:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:22:52 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds distrib/Makefile from @alpmestan (8cad12b) Message-ID: <20171208052252.D65F53A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/8cad12bb5778627b31a7d7d8794c04e6de7993a8/ghc >--------------------------------------------------------------- commit 8cad12bb5778627b31a7d7d8794c04e6de7993a8 Author: Moritz Angermann Date: Fri Dec 8 12:58:53 2017 +0800 Adds distrib/Makefile from @alpmestan >--------------------------------------------------------------- 8cad12bb5778627b31a7d7d8794c04e6de7993a8 distrib/Makefile | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/distrib/Makefile b/distrib/Makefile new file mode 100644 index 0000000..e806ff8 --- /dev/null +++ b/distrib/Makefile @@ -0,0 +1,34 @@ +MAKEFLAGS += --no-builtin-rules +.SUFFIXES: + +ProjectVersion:=$(shell bin/ghc --numeric-version) + +include mk/install.mk + +define GHC_WRAPPER +#!/bin/sh +exec "$(libdir)/bin/ghc" -B"$(libdir)" $${1+"$$@"} +endef + +export GHC_WRAPPER + +.PHONY: default +default: + @echo 'Run "make install" to install' + @false + +.PHONY: install +install: + @cp settings lib/ + @echo $(prefix) $(bindir) $(libdir) + @mkdir -p $(prefix) $(libdir) $(bindir) + @cp -R lib/* $(libdir)/ + # cp the rest to $(prefix) ? or maybe handle $(datadir) etc too? + @if [ "$(bindir)" = "$(prefix)/bin" ] || [ "$(libdir)" != "$(prefix)/lib" ]; then \ + echo "custom bindir or libdir"; \ + mkdir -p $(libdir)/bin; \ + cp bin/* $(libdir)/bin/; \ + echo "$$GHC_WRAPPER" > $(bindir)/ghc; \ + fi + @echo "ghc available at $(bindir)/ghc" + @echo done From git at git.haskell.org Fri Dec 8 05:22:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:22:58 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Add network submodule. (8a0fbdd) Message-ID: <20171208052258.833FE3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/8a0fbdd96b6df9a7af602bcb428a7e059a8ea4a1/ghc >--------------------------------------------------------------- commit 8a0fbdd96b6df9a7af602bcb428a7e059a8ea4a1 Author: Moritz Angermann Date: Mon Nov 27 11:44:46 2017 +0800 Add network submodule. >--------------------------------------------------------------- 8a0fbdd96b6df9a7af602bcb428a7e059a8ea4a1 .gitmodules | 3 +++ libraries/network | 1 + 2 files changed, 4 insertions(+) diff --git a/.gitmodules b/.gitmodules index 3fbbecc..8a330d6 100644 --- a/.gitmodules +++ b/.gitmodules @@ -141,3 +141,6 @@ [submodule "hadrian"] path = hadrian url = https://github.com/snowleopard/hadrian.git +[submodule "libraries/network"] + path = libraries/network + url = https://github.com/haskell/network.git diff --git a/libraries/network b/libraries/network new file mode 160000 index 0000000..fe70032 --- /dev/null +++ b/libraries/network @@ -0,0 +1 @@ +Subproject commit fe7003293c9a08497a9df6cc18bb3868c96bda8f From git at git.haskell.org Fri Dec 8 05:22:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:22:55 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: replace git subtree with submodule. (035ee1b) Message-ID: <20171208052255.B803B3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/035ee1be4cea6fbdf2473d952623f362159696e8/ghc >--------------------------------------------------------------- commit 035ee1be4cea6fbdf2473d952623f362159696e8 Author: Moritz Angermann Date: Fri Dec 8 13:12:09 2017 +0800 replace git subtree with submodule. >--------------------------------------------------------------- 035ee1be4cea6fbdf2473d952623f362159696e8 .gitmodules | 3 + hadrian | 1 + hadrian/.ghci | 11 - hadrian/.gitignore | 26 -- hadrian/.travis.yml | 92 ----- hadrian/LICENSE | 21 - hadrian/README.md | 194 --------- hadrian/appveyor.yml | 41 -- hadrian/build.bat | 6 - hadrian/build.cabal.sh | 74 ---- hadrian/build.global-db.bat | 32 -- hadrian/build.global-db.sh | 52 --- hadrian/build.sh | 35 -- hadrian/build.stack.bat | 11 - hadrian/build.stack.nix.sh | 33 -- hadrian/build.stack.sh | 39 -- hadrian/cabal.project | 6 - hadrian/cfg/system.config.in | 138 ------- hadrian/circle.yml | 42 -- hadrian/doc/cross-compile.md | 57 --- hadrian/doc/flavours.md | 176 --------- hadrian/doc/user-settings.md | 212 ---------- hadrian/doc/windows.md | 69 ---- hadrian/hadrian.cabal | 142 ------- hadrian/src/Base.hs | 121 ------ hadrian/src/Builder.hs | 296 -------------- hadrian/src/CommandLine.hs | 137 ------- hadrian/src/Context.hs | 158 -------- hadrian/src/Environment.hs | 16 - hadrian/src/Expression.hs | 123 ------ hadrian/src/Flavour.hs | 34 -- hadrian/src/GHC.hs | 289 -------------- hadrian/src/Hadrian/Builder.hs | 125 ------ hadrian/src/Hadrian/Builder/Ar.hs | 68 ---- hadrian/src/Hadrian/Builder/Sphinx.hs | 39 -- hadrian/src/Hadrian/Builder/Tar.hs | 40 -- hadrian/src/Hadrian/Expression.hs | 153 ------- hadrian/src/Hadrian/Haskell/Cabal.hs | 44 --- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs | 63 --- hadrian/src/Hadrian/Oracles/ArgsHash.hs | 51 --- hadrian/src/Hadrian/Oracles/DirectoryContents.hs | 64 --- hadrian/src/Hadrian/Oracles/Path.hs | 62 --- hadrian/src/Hadrian/Oracles/TextFile.hs | 123 ------ hadrian/src/Hadrian/Package.hs | 120 ------ hadrian/src/Hadrian/Target.hs | 29 -- hadrian/src/Hadrian/Utilities.hs | 406 ------------------- hadrian/src/Main.hs | 59 --- hadrian/src/Oracles/Flag.hs | 74 ---- hadrian/src/Oracles/ModuleFiles.hs | 160 -------- hadrian/src/Oracles/PackageData.hs | 66 ---- hadrian/src/Oracles/Setting.hs | 236 ----------- hadrian/src/Rules.hs | 123 ------ hadrian/src/Rules/Clean.hs | 23 -- hadrian/src/Rules/Compile.hs | 83 ---- hadrian/src/Rules/Configure.hs | 43 -- hadrian/src/Rules/Dependencies.hs | 33 -- hadrian/src/Rules/Documentation.hs | 197 --------- hadrian/src/Rules/Generate.hs | 482 ----------------------- hadrian/src/Rules/Gmp.hs | 119 ------ hadrian/src/Rules/Install.hs | 336 ---------------- hadrian/src/Rules/Libffi.hs | 108 ----- hadrian/src/Rules/Library.hs | 103 ----- hadrian/src/Rules/PackageData.hs | 119 ------ hadrian/src/Rules/Program.hs | 116 ------ hadrian/src/Rules/Register.hs | 44 --- hadrian/src/Rules/Selftest.hs | 92 ----- hadrian/src/Rules/SourceDist.hs | 113 ------ hadrian/src/Rules/Test.hs | 72 ---- hadrian/src/Rules/Wrappers.hs | 162 -------- hadrian/src/Settings.hs | 68 ---- hadrian/src/Settings/Builders/Alex.hs | 8 - hadrian/src/Settings/Builders/Cc.hs | 26 -- hadrian/src/Settings/Builders/Common.hs | 58 --- hadrian/src/Settings/Builders/Configure.hs | 25 -- hadrian/src/Settings/Builders/DeriveConstants.hs | 39 -- hadrian/src/Settings/Builders/GenPrimopCode.hs | 24 -- hadrian/src/Settings/Builders/Ghc.hs | 149 ------- hadrian/src/Settings/Builders/GhcCabal.hs | 118 ------ hadrian/src/Settings/Builders/GhcPkg.hs | 17 - hadrian/src/Settings/Builders/Haddock.hs | 63 --- hadrian/src/Settings/Builders/Happy.hs | 9 - hadrian/src/Settings/Builders/HsCpp.hs | 16 - hadrian/src/Settings/Builders/Hsc2Hs.hs | 56 --- hadrian/src/Settings/Builders/Ld.hs | 9 - hadrian/src/Settings/Builders/Make.hs | 16 - hadrian/src/Settings/Builders/Xelatex.hs | 7 - hadrian/src/Settings/Default.hs | 173 -------- hadrian/src/Settings/Default.hs-boot | 20 - hadrian/src/Settings/Flavours/Development.hs | 20 - hadrian/src/Settings/Flavours/Performance.hs | 18 - hadrian/src/Settings/Flavours/Profiled.hs | 19 - hadrian/src/Settings/Flavours/Quick.hs | 22 -- hadrian/src/Settings/Flavours/QuickCross.hs | 24 -- hadrian/src/Settings/Flavours/Quickest.hs | 23 -- hadrian/src/Settings/Packages/Base.hs | 12 - hadrian/src/Settings/Packages/Cabal.hs | 10 - hadrian/src/Settings/Packages/Compiler.hs | 45 --- hadrian/src/Settings/Packages/Ghc.hs | 13 - hadrian/src/Settings/Packages/GhcCabal.hs | 31 -- hadrian/src/Settings/Packages/GhcPkg.hs | 7 - hadrian/src/Settings/Packages/GhcPrim.hs | 12 - hadrian/src/Settings/Packages/Ghci.hs | 6 - hadrian/src/Settings/Packages/Haddock.hs | 7 - hadrian/src/Settings/Packages/Haskeline.hs | 8 - hadrian/src/Settings/Packages/IntegerGmp.hs | 24 -- hadrian/src/Settings/Packages/Rts.hs | 224 ----------- hadrian/src/Settings/Packages/RunGhc.hs | 9 - hadrian/src/Settings/Warnings.hs | 56 --- hadrian/src/Stage.hs | 31 -- hadrian/src/Target.hs | 26 -- hadrian/src/UserSettings.hs | 64 --- hadrian/src/Utilities.hs | 80 ---- hadrian/src/Way.hs | 162 -------- hadrian/stack.yaml | 26 -- 114 files changed, 4 insertions(+), 8913 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 035ee1be4cea6fbdf2473d952623f362159696e8 From git at git.haskell.org Fri Dec 8 05:23:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:23:01 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump submodules (6e7d781) Message-ID: <20171208052301.5FCD03A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/6e7d7814c7b56b6087149cda5d9ff0042c1a5f82/ghc >--------------------------------------------------------------- commit 6e7d7814c7b56b6087149cda5d9ff0042c1a5f82 Author: Moritz Angermann Date: Fri Dec 8 13:16:48 2017 +0800 bump submodules >--------------------------------------------------------------- 6e7d7814c7b56b6087149cda5d9ff0042c1a5f82 libraries/Cabal | 2 +- libraries/data-bitcode | 2 +- libraries/data-bitcode-edsl | 2 +- libraries/data-bitcode-llvm | 2 +- utils/haddock | 2 +- utils/hsc2hs | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 97c66f2..652289a 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 97c66f2c7698f0aea4277acb66b918b7341b3d01 +Subproject commit 652289ad9d9fb53a96cf227c1d47bdfd248103fe diff --git a/libraries/data-bitcode b/libraries/data-bitcode index c9818de..b4cdbc1 160000 --- a/libraries/data-bitcode +++ b/libraries/data-bitcode @@ -1 +1 @@ -Subproject commit c9818debd3dae774967c0507882b6b3bec7f0ee4 +Subproject commit b4cdbc17e77771c1c3c833625b92776aa5bc854b diff --git a/libraries/data-bitcode-edsl b/libraries/data-bitcode-edsl index bc2e3e0..3b11b02 160000 --- a/libraries/data-bitcode-edsl +++ b/libraries/data-bitcode-edsl @@ -1 +1 @@ -Subproject commit bc2e3e0a8bfc438ae3ee6ebe5feaa37920e78e43 +Subproject commit 3b11b02c138f672590a026c29af6f87432f17c11 diff --git a/libraries/data-bitcode-llvm b/libraries/data-bitcode-llvm index d03a9b5..b717895 160000 --- a/libraries/data-bitcode-llvm +++ b/libraries/data-bitcode-llvm @@ -1 +1 @@ -Subproject commit d03a9b5c90787910242e8a295f6201d71c6d3a9a +Subproject commit b717895d5e1add7f908fe09b528c7524511ec6f5 diff --git a/utils/haddock b/utils/haddock index 134a7bb..04fd3e0 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 134a7bb054ea730b13c8629a76232d73e3ace049 +Subproject commit 04fd3e021cfe04eaaa470be4ae8408a417821864 diff --git a/utils/hsc2hs b/utils/hsc2hs index 936b088..738f366 160000 --- a/utils/hsc2hs +++ b/utils/hsc2hs @@ -1 +1 @@ -Subproject commit 936b0885ee794db83dc8473e17e153936e56d62f +Subproject commit 738f3666c878ee9e79c3d5e819ef8b3460288edf From git at git.haskell.org Fri Dec 8 05:31:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:31:27 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Use packed structs. (773d410) Message-ID: <20171208053127.B06CE3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/773d410caa17d3982a8270e1bf4d7ba49bedf9cc/ghc >--------------------------------------------------------------- commit 773d410caa17d3982a8270e1bf4d7ba49bedf9cc Author: Moritz Angermann Date: Sun Dec 3 20:28:55 2017 +0800 Use packed structs. GHC computes offsets into structs, and we do not use getElementPointer. If we had used gep, we could use unpacked structs as well. >--------------------------------------------------------------- 773d410caa17d3982a8270e1bf4d7ba49bedf9cc compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs index c1c9e8c..09ffd99 100644 --- a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs +++ b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs @@ -299,7 +299,7 @@ llvmCodeGen' prc@(CmmProc{}) = Right $ do case mb_info of Nothing -> EDSL.ghcdefT (pure link) lbl sig body Just (Statics _ statics) - -> do prefixData <- EDSL.struct =<< mapM genData statics + -> do prefixData <- EDSL.packedStruct =<< mapM genData statics EDSL.ghcdefT (pure $ EDSL.withPrefixData prefixData . link) lbl sig body -- llvmCodeGen' _ = panic "LlvmCodeGen': unhandled raw cmm group" @@ -427,7 +427,7 @@ genStatics s@(Statics l statics) = do let link | externallyVisibleCLabel l = Val.external -- External | otherwise = Val.private -- Internal - struct <- EDSL.struct body + struct <- EDSL.packedStruct body -- make statics mutable. -- E.g. -- x :: T From git at git.haskell.org Fri Dec 8 05:31:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:31:33 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds `-llvmng` (cacbfe2) Message-ID: <20171208053133.D0B7B3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/cacbfe2a9f1c2b0df01d2bec4636a6d8d5238cd1/ghc >--------------------------------------------------------------- commit cacbfe2a9f1c2b0df01d2bec4636a6d8d5238cd1 Author: Moritz Angermann Date: Mon Jul 31 15:18:49 2017 +0800 Adds `-llvmng` >--------------------------------------------------------------- cacbfe2a9f1c2b0df01d2bec4636a6d8d5238cd1 .gitmodules | 9 + compiler/cmm/CmmSwitch.hs | 1 + compiler/codeGen/StgCmmPrim.hs | 3 +- compiler/ghc.cabal.in | 8 +- compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs | 1788 ++++++++++++++++++++ compiler/llvmGen-ng/Data/BitCode/LLVM/Gen/Monad.hs | 83 + compiler/main/CodeOutput.hs | 10 + compiler/main/DriverPipeline.hs | 5 +- compiler/main/DynFlags.hs | 12 +- compiler/typecheck/TcForeign.hs | 4 +- ghc.mk | 8 + libraries/base/tests/all.T | 2 +- libraries/data-bitcode | 1 + libraries/data-bitcode-edsl | 1 + libraries/data-bitcode-llvm | 1 + mk/build.mk.sample | 13 +- mk/flavours/{prof.mk => prof-llvmng.mk} | 6 +- mk/flavours/{quick-cross.mk => quick-cross-ng.mk} | 4 +- mk/flavours/{quick.mk => quick-llvmng.mk} | 4 +- packages | 3 + testsuite/config/ghc | 16 +- 21 files changed, 1963 insertions(+), 19 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 cacbfe2a9f1c2b0df01d2bec4636a6d8d5238cd1 From git at git.haskell.org Fri Dec 8 05:31:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:31:36 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: no tbaa (d02741d) Message-ID: <20171208053136.AB6903A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/d02741d0c6b3aabbc6c00b225d9b8f6a37287d8f/ghc >--------------------------------------------------------------- commit d02741d0c6b3aabbc6c00b225d9b8f6a37287d8f Author: Moritz Angermann Date: Sat Dec 2 14:09:03 2017 +0800 no tbaa >--------------------------------------------------------------- d02741d0c6b3aabbc6c00b225d9b8f6a37287d8f compiler/main/DriverPipeline.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 269017c..035fb17 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -812,8 +812,8 @@ fastLlvmPipeline dflags llvmOptions :: DynFlags -> [(String, String)] -- ^ pairs of (opt, llc) arguments llvmOptions dflags = - [("-enable-tbaa -tbaa", "-enable-tbaa") | gopt Opt_LlvmTBAA dflags ] - ++ [("-relocation-model=" ++ rmodel +-- [("-enable-tbaa -tbaa", "-enable-tbaa") | gopt Opt_LlvmTBAA dflags ] + [("-relocation-model=" ++ rmodel ,"-relocation-model=" ++ rmodel) | not (null rmodel)] ++ [("-stack-alignment=" ++ (show align) ,"-stack-alignment=" ++ (show align)) | align > 0 ] From git at git.haskell.org Fri Dec 8 05:31:40 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:31:40 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds test (a039af6) Message-ID: <20171208053140.1BFF23A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/a039af69a03625724b430fa9466b42c10b810f82/ghc >--------------------------------------------------------------- commit a039af69a03625724b430fa9466b42c10b810f82 Author: Moritz Angermann Date: Thu Sep 21 22:07:44 2017 +0800 Adds test >--------------------------------------------------------------- a039af69a03625724b430fa9466b42c10b810f82 testsuite/tests/codeGen/should_run/T14251.hs | 22 ++++++++++++++++++++++ testsuite/tests/codeGen/should_run/T14251.stdout | 1 + testsuite/tests/codeGen/should_run/all.T | 1 + 3 files changed, 24 insertions(+) diff --git a/testsuite/tests/codeGen/should_run/T14251.hs b/testsuite/tests/codeGen/should_run/T14251.hs new file mode 100644 index 0000000..6f552e1 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14251.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE MagicHash, BangPatterns #-} +module Main where + +-- A minor modification from T8064.hs. +-- +-- The key here is that we ensure that +-- subsequently passed floats do not +-- accidentally end up in previous +-- registers. +-- + +import GHC.Exts + +{-# NOINLINE f #-} +f :: (Int# -> Float# -> Double# -> Float# -> Double# -> String) -> String +f g = g 3# 4.0# 5.0## 6.0# 6.9## ++ " World!" + +{-# NOINLINE q #-} +q :: Int# -> Float# -> Double# -> Float# -> Double# -> String +q i j k l m = "Hello " ++ show (F# l) ++ " " ++ show (D# m) + +main = putStrLn (f $ q) diff --git a/testsuite/tests/codeGen/should_run/T14251.stdout b/testsuite/tests/codeGen/should_run/T14251.stdout new file mode 100644 index 0000000..8ec577b --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14251.stdout @@ -0,0 +1 @@ +Hello 6.0 6.9 World! diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 214a9d5..8f33044 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -163,3 +163,4 @@ test('T13825-unit', extra_run_opts('"' + config.libdir + '"'), compile_and_run, ['-package ghc']) +test('T14251', normal, compile_and_run, ['-O2']) From git at git.haskell.org Fri Dec 8 05:31:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:31:47 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Update iserv-proxy (533d52c) Message-ID: <20171208053147.B2EC53A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/533d52c554f9da312447310056539d65bb394602/ghc >--------------------------------------------------------------- commit 533d52c554f9da312447310056539d65bb394602 Author: Moritz Angermann Date: Sun Nov 26 17:08:08 2017 +0800 Update iserv-proxy >--------------------------------------------------------------- 533d52c554f9da312447310056539d65bb394602 utils/iserv-proxy/iserv-proxy.cabal | 2 +- utils/iserv-proxy/{proxy-src/Remote.hs => src/Main.hs} | 0 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/iserv-proxy/iserv-proxy.cabal b/utils/iserv-proxy/iserv-proxy.cabal index 8f13189..e028c99 100644 --- a/utils/iserv-proxy/iserv-proxy.cabal +++ b/utils/iserv-proxy/iserv-proxy.cabal @@ -63,7 +63,7 @@ cabal-version: >=1.10 Executable iserv-proxy Default-Language: Haskell2010 - Main-Is: Remote.hs + Main-Is: Main.hs Hs-Source-Dirs: src Build-Depends: array >= 0.5 && < 0.6, base >= 4 && < 5, diff --git a/utils/iserv-proxy/proxy-src/Remote.hs b/utils/iserv-proxy/src/Main.hs similarity index 100% rename from utils/iserv-proxy/proxy-src/Remote.hs rename to utils/iserv-proxy/src/Main.hs From git at git.haskell.org Fri Dec 8 05:31:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:31:44 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Move `iserv` into `utils` and change package name from `iserv-bin` to `iserv` (e24edad) Message-ID: <20171208053144.919B73A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/e24edad5c6d5f74d88d477d42508e2ff735c9f53/ghc >--------------------------------------------------------------- commit e24edad5c6d5f74d88d477d42508e2ff735c9f53 Author: Moritz Angermann Date: Sat Nov 25 15:10:52 2017 +0800 Move `iserv` into `utils` and change package name from `iserv-bin` to `iserv` This is done for consistency. We usually call the package file the same name the folder has. The move into `utils` is done so that we can move the library into `libraries/iserv` and the proxy into `utils/iserv-proxy` and then break the `iserv.cabal` apart. This will make building the cross compiler with TH simpler, because we can build the library and proxy as separate packages. >--------------------------------------------------------------- e24edad5c6d5f74d88d477d42508e2ff735c9f53 ghc.mk | 13 +-- {iserv => libraries/libiserv}/Makefile | 0 {iserv => libraries/libiserv}/cbits/iservmain.c | 0 libraries/libiserv/ghc.mk | 5 + libraries/libiserv/libiserv.cabal | 39 +++++++ {iserv => libraries/libiserv}/proxy-src/Remote.hs | 0 {iserv => libraries/libiserv}/src/GHCi/Utils.hsc | 0 {iserv => libraries/libiserv}/src/Lib.hs | 0 {iserv => libraries/libiserv}/src/Main.hs | 0 .../libiserv}/src/Remote/Message.hs | 0 {iserv => libraries/libiserv}/src/Remote/Slave.hs | 0 {iserv => utils/iserv-proxy}/Makefile | 0 utils/iserv-proxy/ghc.mk | 113 +++++++++++++++++++++ .../iserv-proxy/iserv-proxy.cabal | 70 +------------ {iserv => utils/iserv-proxy}/proxy-src/Remote.hs | 0 {iserv => utils/iserv}/Makefile | 0 {iserv => utils/iserv}/cbits/iservmain.c | 0 {iserv => utils/iserv}/ghc.mk | 66 ++++++------ utils/iserv/iserv.cabal | 44 ++++++++ {iserv => utils/iserv}/src/Main.hs | 0 20 files changed, 245 insertions(+), 105 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 e24edad5c6d5f74d88d477d42508e2ff735c9f53 From git at git.haskell.org Fri Dec 8 05:31:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:31:50 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds `smp` flag to rts.cabal. (8e146f1) Message-ID: <20171208053150.7EB613A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/8e146f189edf41de08202c667a590e63fe4af51d/ghc >--------------------------------------------------------------- commit 8e146f189edf41de08202c667a590e63fe4af51d Author: Moritz Angermann Date: Sat Nov 25 20:49:56 2017 +0800 Adds `smp` flag to rts.cabal. >--------------------------------------------------------------- 8e146f189edf41de08202c667a590e63fe4af51d rts/rts.cabal.in | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in index 71aef3d..b33a5f4 100644 --- a/rts/rts.cabal.in +++ b/rts/rts.cabal.in @@ -24,6 +24,8 @@ flag 64bit default: @Cabal64bit@ flag leading-underscore default: @CabalLeadingUnderscore@ +flag smp + default: True library -- rts is a wired in package and @@ -72,6 +74,8 @@ library if flag(libdw) -- for backtraces extra-libraries: elf dw + if !flag(smp) + cpp-options: -DNOSMP include-dirs: build ../includes includes includes/dist-derivedconstants/header @FFIIncludeDir@ From git at git.haskell.org Fri Dec 8 05:31:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:31:53 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: adds -latomic to. ghc-prim (c7aa614) Message-ID: <20171208053153.720F63A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/c7aa614bc9c342497748e2e997c892d1b736ea0b/ghc >--------------------------------------------------------------- commit c7aa614bc9c342497748e2e997c892d1b736ea0b Author: Moritz Angermann Date: Mon Dec 4 10:56:13 2017 +0800 adds -latomic to. ghc-prim >--------------------------------------------------------------- c7aa614bc9c342497748e2e997c892d1b736ea0b libraries/ghc-prim/ghc-prim.cabal | 3 +++ 1 file changed, 3 insertions(+) diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal index e99686a..bad1889 100644 --- a/libraries/ghc-prim/ghc-prim.cabal +++ b/libraries/ghc-prim/ghc-prim.cabal @@ -66,6 +66,9 @@ Library -- on Windows. Required because of mingw32. extra-libraries: user32, mingw32, mingwex + if os(linux) + extra-libraries: atomic + c-sources: cbits/atomic.c cbits/bswap.c From git at git.haskell.org Fri Dec 8 05:31:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:31:57 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds distrib/Makefile from @alpmestan (833e689) Message-ID: <20171208053157.384273A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/833e6890c515a2fd2668b87efbcec10d8762ed1e/ghc >--------------------------------------------------------------- commit 833e6890c515a2fd2668b87efbcec10d8762ed1e Author: Moritz Angermann Date: Fri Dec 8 12:58:53 2017 +0800 Adds distrib/Makefile from @alpmestan >--------------------------------------------------------------- 833e6890c515a2fd2668b87efbcec10d8762ed1e distrib/Makefile | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/distrib/Makefile b/distrib/Makefile new file mode 100644 index 0000000..e806ff8 --- /dev/null +++ b/distrib/Makefile @@ -0,0 +1,34 @@ +MAKEFLAGS += --no-builtin-rules +.SUFFIXES: + +ProjectVersion:=$(shell bin/ghc --numeric-version) + +include mk/install.mk + +define GHC_WRAPPER +#!/bin/sh +exec "$(libdir)/bin/ghc" -B"$(libdir)" $${1+"$$@"} +endef + +export GHC_WRAPPER + +.PHONY: default +default: + @echo 'Run "make install" to install' + @false + +.PHONY: install +install: + @cp settings lib/ + @echo $(prefix) $(bindir) $(libdir) + @mkdir -p $(prefix) $(libdir) $(bindir) + @cp -R lib/* $(libdir)/ + # cp the rest to $(prefix) ? or maybe handle $(datadir) etc too? + @if [ "$(bindir)" = "$(prefix)/bin" ] || [ "$(libdir)" != "$(prefix)/lib" ]; then \ + echo "custom bindir or libdir"; \ + mkdir -p $(libdir)/bin; \ + cp bin/* $(libdir)/bin/; \ + echo "$$GHC_WRAPPER" > $(bindir)/ghc; \ + fi + @echo "ghc available at $(bindir)/ghc" + @echo done From git at git.haskell.org Fri Dec 8 05:32:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:32:00 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Add network submodule. (07c68d9) Message-ID: <20171208053200.0E6823A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/07c68d980c7939730c342fe1a265183f1f48eb9d/ghc >--------------------------------------------------------------- commit 07c68d980c7939730c342fe1a265183f1f48eb9d Author: Moritz Angermann Date: Mon Nov 27 11:44:46 2017 +0800 Add network submodule. >--------------------------------------------------------------- 07c68d980c7939730c342fe1a265183f1f48eb9d .gitmodules | 3 +++ libraries/network | 1 + 2 files changed, 4 insertions(+) diff --git a/.gitmodules b/.gitmodules index 3fbbecc..8a330d6 100644 --- a/.gitmodules +++ b/.gitmodules @@ -141,3 +141,6 @@ [submodule "hadrian"] path = hadrian url = https://github.com/snowleopard/hadrian.git +[submodule "libraries/network"] + path = libraries/network + url = https://github.com/haskell/network.git diff --git a/libraries/network b/libraries/network new file mode 160000 index 0000000..fe70032 --- /dev/null +++ b/libraries/network @@ -0,0 +1 @@ +Subproject commit fe7003293c9a08497a9df6cc18bb3868c96bda8f From git at git.haskell.org Fri Dec 8 05:32:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:32:05 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump submodules (cf723a7) Message-ID: <20171208053205.C7CB73A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/cf723a7ae3572b0966c5185935ec77a2a3750ae6/ghc >--------------------------------------------------------------- commit cf723a7ae3572b0966c5185935ec77a2a3750ae6 Author: Moritz Angermann Date: Fri Dec 8 13:16:48 2017 +0800 bump submodules >--------------------------------------------------------------- cf723a7ae3572b0966c5185935ec77a2a3750ae6 libraries/Cabal | 2 +- libraries/data-bitcode | 2 +- libraries/data-bitcode-edsl | 2 +- libraries/data-bitcode-llvm | 2 +- utils/hsc2hs | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 97c66f2..652289a 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 97c66f2c7698f0aea4277acb66b918b7341b3d01 +Subproject commit 652289ad9d9fb53a96cf227c1d47bdfd248103fe diff --git a/libraries/data-bitcode b/libraries/data-bitcode index c9818de..b4cdbc1 160000 --- a/libraries/data-bitcode +++ b/libraries/data-bitcode @@ -1 +1 @@ -Subproject commit c9818debd3dae774967c0507882b6b3bec7f0ee4 +Subproject commit b4cdbc17e77771c1c3c833625b92776aa5bc854b diff --git a/libraries/data-bitcode-edsl b/libraries/data-bitcode-edsl index bc2e3e0..3b11b02 160000 --- a/libraries/data-bitcode-edsl +++ b/libraries/data-bitcode-edsl @@ -1 +1 @@ -Subproject commit bc2e3e0a8bfc438ae3ee6ebe5feaa37920e78e43 +Subproject commit 3b11b02c138f672590a026c29af6f87432f17c11 diff --git a/libraries/data-bitcode-llvm b/libraries/data-bitcode-llvm index d03a9b5..b717895 160000 --- a/libraries/data-bitcode-llvm +++ b/libraries/data-bitcode-llvm @@ -1 +1 @@ -Subproject commit d03a9b5c90787910242e8a295f6201d71c6d3a9a +Subproject commit b717895d5e1add7f908fe09b528c7524511ec6f5 diff --git a/utils/hsc2hs b/utils/hsc2hs index 9483ad1..738f366 160000 --- a/utils/hsc2hs +++ b/utils/hsc2hs @@ -1 +1 @@ -Subproject commit 9483ad10064fbbb97ab525280623826b1ef63959 +Subproject commit 738f3666c878ee9e79c3d5e819ef8b3460288edf From git at git.haskell.org Fri Dec 8 05:32:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:32:09 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng's head updated: bump submodules (cf723a7) Message-ID: <20171208053209.3AD8C3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/angerman/llvmng' now includes: e66913d Bump hsc2hs submodule 25f36bd Bump haddock submodule ddded7e ghc-pkg: Add missing newlines to usage message 1b1ba9d rel-notes: Fix up formatting in release notes d213ee8 CircleCI: Disable artifact collection on OS X 66d1799 configure: Fix ar probed flags 0b20d9c base: Document GHC.Stack.CCS internals 314bc31 Revert "trees that grow" work 90a819b CircleCI: Add webhook for Harbormaster builds 2ca2259 Update ANNOUNCE 763ecac rts: Move libdwPrintBacktrace to public interface f376eba rts: Fix inconsistencies in how retainer and heap censuses are timed. 63e4ac3 Add warn-missing-export-lists 8a8a79a Update leftover reference to refer to [FunBind vs PatBind] dad9864 Remove hadrian sub-dir from .gitignore 0db4627 Test Trac #14488 bb2a08e testsuite: Add test for #14257 23116df cmm: Optimise remainders by powers of two eb5a40c base: Remove redundant subtraction in (^) and stimes 7a73a1c Bump stm submodule 2d1c671 ErrUtils: Refactor dump file logic c11f145 ErrUtils: Ensure timing dumps are always output on one line 360d740 Squashed 'hadrian/' changes from fa3771fe6b..4499b294e4 abdb555 Update Hadrian 341013e Revert "Add new mbmi and mbmi2 compiler flags" 5fdb858 Fix README 33cbc9f CircleCI: Perform nightly validation of unregisterised build 866f669 CircleCI: Try validating LLVM as well e2cc106 circleci: Build with Hadrian ad57e28 CircleCI: Install lbzip2 and patch 5e35627 rts/Printer: add closure name entries for small arrays (Fixes #14513) 30aa643 SysTools: Expand occurrences of $topdir anywhere in a Settings path 69cd1e9 SysTools: Split up TopDir logic into new module 599243e DynFlags: Expand $topdir in --info output 99089fc users-guide: Fix :default: placement f209e66 base: fdReady(): Fix timeouts > ~49 days overflowing. Fixes #14262. a1950e6 CircleCI: Reenable artifact collection on Darwin 471d677 Don't complain about UNPACK in -fno-code. 6282366 Follow symlinks in the Win32 code for System.Environment.getExecutablePath b241d6d Add obvious Outputable Integer instance. f713be7 RtsFlags: allow +RTS -K0 00b96b2 boot: Eliminate superfluous output 4efe5fe Check quantification for partial type signatues df1a0c0 typecheck: Consistently use pretty quotes in error messages eb86e86 Don't call alex for Cabal lib during GHC build e4dc2cd relnotes: Rework treatment of included package list 54fda25 base: Rip out old RTS statistics interface 17e71c1 CLabel.labelType: Make catch-all case explicit 048a913 cmm: Use LocalBlockLabel instead of AsmTempLabel to represent blocks 16dd532 CLabel: Refactor pprDynamicLinkerAsmLabel 55e621c nativeGen: Use plusUFMList instead of foldr 7dc82d6 nativeGen: Use foldl' instead of foldl 66c1c8e CLabel: More specific debug output from CLabel d3b80c7 Cmm: Add missing cases for BlockInfoTable 030d9d4 CLabel: A bit of documentation 4c65867 CircleCI: Disallow hscolour 1.24.3 3c0ffd1 CircleCI: Freeze all packages at fixed index state 5b3f33b Minor tweaks to codegens.rst b6428af Comments only: Trac #14511 b6a2691 Bump unix submodule f246d35 Darwin: Set deployment target d672b7f Darwin: Use gmp from homebrew 6998772 Make use of boot TyThings during typechecking. e1fb283 Handle CPP properly in Backpack 12efb23 Add trace injection bc761ad Cache TypeRep kinds aggressively 1acb922 Make the Con and Con' patterns produce evidence cfea745 template-haskell: Rip out FamFlavour 595f60f Fix ghc_packages cacbfe2 Adds `-llvmng` 773d410 Use packed structs. d02741d no tbaa a039af6 Adds test 8e146f1 Adds `smp` flag to rts.cabal. e24edad Move `iserv` into `utils` and change package name from `iserv-bin` to `iserv` 533d52c Update iserv-proxy c7aa614 adds -latomic to. ghc-prim 833e689 Adds distrib/Makefile from @alpmestan 7b97883 replace git subtree with submodule. 07c68d9 Add network submodule. cf723a7 bump submodules From git at git.haskell.org Fri Dec 8 05:32:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 05:32:02 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: replace git subtree with submodule. (7b97883) Message-ID: <20171208053202.ED8D23A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/7b978836955dcb281b00d4d07e359f6aa4ef2acf/ghc >--------------------------------------------------------------- commit 7b978836955dcb281b00d4d07e359f6aa4ef2acf Author: Moritz Angermann Date: Fri Dec 8 13:12:09 2017 +0800 replace git subtree with submodule. >--------------------------------------------------------------- 7b978836955dcb281b00d4d07e359f6aa4ef2acf .gitmodules | 3 + hadrian | 1 + hadrian/.ghci | 11 - hadrian/.gitignore | 26 -- hadrian/.travis.yml | 92 ----- hadrian/LICENSE | 21 - hadrian/README.md | 194 --------- hadrian/appveyor.yml | 41 -- hadrian/build.bat | 6 - hadrian/build.cabal.sh | 74 ---- hadrian/build.global-db.bat | 32 -- hadrian/build.global-db.sh | 52 --- hadrian/build.sh | 35 -- hadrian/build.stack.bat | 11 - hadrian/build.stack.nix.sh | 33 -- hadrian/build.stack.sh | 39 -- hadrian/cabal.project | 5 - hadrian/cfg/system.config.in | 138 ------- hadrian/circle.yml | 42 -- hadrian/doc/cross-compile.md | 57 --- hadrian/doc/flavours.md | 176 --------- hadrian/doc/user-settings.md | 212 ---------- hadrian/doc/windows.md | 69 ---- hadrian/hadrian.cabal | 142 ------- hadrian/src/Base.hs | 121 ------ hadrian/src/Builder.hs | 296 -------------- hadrian/src/CommandLine.hs | 137 ------- hadrian/src/Context.hs | 158 -------- hadrian/src/Environment.hs | 16 - hadrian/src/Expression.hs | 123 ------ hadrian/src/Flavour.hs | 34 -- hadrian/src/GHC.hs | 289 -------------- hadrian/src/Hadrian/Builder.hs | 125 ------ hadrian/src/Hadrian/Builder/Ar.hs | 68 ---- hadrian/src/Hadrian/Builder/Sphinx.hs | 39 -- hadrian/src/Hadrian/Builder/Tar.hs | 40 -- hadrian/src/Hadrian/Expression.hs | 153 ------- hadrian/src/Hadrian/Haskell/Cabal.hs | 44 --- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs | 63 --- hadrian/src/Hadrian/Oracles/ArgsHash.hs | 51 --- hadrian/src/Hadrian/Oracles/DirectoryContents.hs | 64 --- hadrian/src/Hadrian/Oracles/Path.hs | 62 --- hadrian/src/Hadrian/Oracles/TextFile.hs | 123 ------ hadrian/src/Hadrian/Package.hs | 120 ------ hadrian/src/Hadrian/Target.hs | 29 -- hadrian/src/Hadrian/Utilities.hs | 406 ------------------- hadrian/src/Main.hs | 59 --- hadrian/src/Oracles/Flag.hs | 74 ---- hadrian/src/Oracles/ModuleFiles.hs | 160 -------- hadrian/src/Oracles/PackageData.hs | 66 ---- hadrian/src/Oracles/Setting.hs | 236 ----------- hadrian/src/Rules.hs | 123 ------ hadrian/src/Rules/Clean.hs | 23 -- hadrian/src/Rules/Compile.hs | 81 ---- hadrian/src/Rules/Configure.hs | 43 -- hadrian/src/Rules/Dependencies.hs | 33 -- hadrian/src/Rules/Documentation.hs | 197 --------- hadrian/src/Rules/Generate.hs | 482 ----------------------- hadrian/src/Rules/Gmp.hs | 119 ------ hadrian/src/Rules/Install.hs | 336 ---------------- hadrian/src/Rules/Libffi.hs | 108 ----- hadrian/src/Rules/Library.hs | 103 ----- hadrian/src/Rules/PackageData.hs | 119 ------ hadrian/src/Rules/Program.hs | 113 ------ hadrian/src/Rules/Register.hs | 44 --- hadrian/src/Rules/Selftest.hs | 92 ----- hadrian/src/Rules/SourceDist.hs | 113 ------ hadrian/src/Rules/Test.hs | 72 ---- hadrian/src/Rules/Wrappers.hs | 162 -------- hadrian/src/Settings.hs | 68 ---- hadrian/src/Settings/Builders/Alex.hs | 8 - hadrian/src/Settings/Builders/Cc.hs | 26 -- hadrian/src/Settings/Builders/Common.hs | 58 --- hadrian/src/Settings/Builders/Configure.hs | 25 -- hadrian/src/Settings/Builders/DeriveConstants.hs | 39 -- hadrian/src/Settings/Builders/GenPrimopCode.hs | 24 -- hadrian/src/Settings/Builders/Ghc.hs | 149 ------- hadrian/src/Settings/Builders/GhcCabal.hs | 118 ------ hadrian/src/Settings/Builders/GhcPkg.hs | 17 - hadrian/src/Settings/Builders/Haddock.hs | 63 --- hadrian/src/Settings/Builders/Happy.hs | 9 - hadrian/src/Settings/Builders/HsCpp.hs | 16 - hadrian/src/Settings/Builders/Hsc2Hs.hs | 56 --- hadrian/src/Settings/Builders/Ld.hs | 9 - hadrian/src/Settings/Builders/Make.hs | 16 - hadrian/src/Settings/Builders/Xelatex.hs | 7 - hadrian/src/Settings/Default.hs | 173 -------- hadrian/src/Settings/Default.hs-boot | 20 - hadrian/src/Settings/Flavours/Development.hs | 20 - hadrian/src/Settings/Flavours/Performance.hs | 18 - hadrian/src/Settings/Flavours/Profiled.hs | 19 - hadrian/src/Settings/Flavours/Quick.hs | 22 -- hadrian/src/Settings/Flavours/QuickCross.hs | 24 -- hadrian/src/Settings/Flavours/Quickest.hs | 23 -- hadrian/src/Settings/Packages/Base.hs | 12 - hadrian/src/Settings/Packages/Cabal.hs | 10 - hadrian/src/Settings/Packages/Compiler.hs | 45 --- hadrian/src/Settings/Packages/Ghc.hs | 13 - hadrian/src/Settings/Packages/GhcCabal.hs | 32 -- hadrian/src/Settings/Packages/GhcPkg.hs | 7 - hadrian/src/Settings/Packages/GhcPrim.hs | 12 - hadrian/src/Settings/Packages/Ghci.hs | 6 - hadrian/src/Settings/Packages/Haddock.hs | 7 - hadrian/src/Settings/Packages/Haskeline.hs | 8 - hadrian/src/Settings/Packages/IntegerGmp.hs | 24 -- hadrian/src/Settings/Packages/Rts.hs | 224 ----------- hadrian/src/Settings/Packages/RunGhc.hs | 9 - hadrian/src/Settings/Warnings.hs | 56 --- hadrian/src/Stage.hs | 31 -- hadrian/src/Target.hs | 26 -- hadrian/src/UserSettings.hs | 64 --- hadrian/src/Utilities.hs | 88 ----- hadrian/src/Way.hs | 162 -------- hadrian/stack.yaml | 25 -- 114 files changed, 4 insertions(+), 8915 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 7b978836955dcb281b00d4d07e359f6aa4ef2acf From git at git.haskell.org Fri Dec 8 17:21:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 17:21:05 +0000 (UTC) Subject: [commit: ghc] master: Refactor kcHsTyVarBndrs (de20440) Message-ID: <20171208172105.04A6B3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/de2044098ae96245aa741fe1b47a06a996a1c725/ghc >--------------------------------------------------------------- commit de2044098ae96245aa741fe1b47a06a996a1c725 Author: Simon Peyton Jones Date: Thu Dec 7 14:31:53 2017 +0000 Refactor kcHsTyVarBndrs This refactoring * Renames kcHsTyVarBndrs to kcLHsQTyVars, which is more truthful. It is only used in getInitialKind. * Pulls out bind_telescope from that function, and calls it kcLHsTyVarBndrs, again to reflect its argument * Uses the new kcLHsTyVarBndrs in kcConDecl, where the old function was wild overkill. There should not be any change in behaviour >--------------------------------------------------------------- de2044098ae96245aa741fe1b47a06a996a1c725 compiler/typecheck/TcHsType.hs | 146 ++++++++++++++++++++----------------- compiler/typecheck/TcTyClsDecls.hs | 8 +- 2 files changed, 83 insertions(+), 71 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 de2044098ae96245aa741fe1b47a06a996a1c725 From git at git.haskell.org Fri Dec 8 17:21:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 17:21:10 +0000 (UTC) Subject: [commit: ghc] master: Occurrrence analysis improvements for NOINLINE functions (5695f46) Message-ID: <20171208172110.F22B23A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5695f462f604fc63cbb45a7f3073bc114f9b475f/ghc >--------------------------------------------------------------- commit 5695f462f604fc63cbb45a7f3073bc114f9b475f Author: Simon Peyton Jones Date: Fri Dec 8 15:39:05 2017 +0000 Occurrrence analysis improvements for NOINLINE functions This patch fixes #14567. The idea is simple: if a function is marked NOINLINE then it makes a great candidate for a loop breaker. Implementation is easy too, but it needs a little extra plubming, notably the occ_unf_act field in OccEnv >--------------------------------------------------------------- 5695f462f604fc63cbb45a7f3073bc114f9b475f compiler/coreSyn/CoreOpt.hs | 6 +++-- compiler/simplCore/OccurAnal.hs | 54 ++++++++++++++++++++++++---------------- compiler/simplCore/SimplCore.hs | 7 +++--- compiler/simplCore/SimplUtils.hs | 12 +++------ compiler/simplCore/Simplify.hs | 4 +-- 5 files changed, 47 insertions(+), 36 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 5695f462f604fc63cbb45a7f3073bc114f9b475f From git at git.haskell.org Fri Dec 8 17:21:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 17:21:08 +0000 (UTC) Subject: [commit: ghc] master: Improve LiberateCase (800009d) Message-ID: <20171208172108.090193A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/800009d9b78a9b2877e7efc889e8a0b21873990d/ghc >--------------------------------------------------------------- commit 800009d9b78a9b2877e7efc889e8a0b21873990d Author: Simon Peyton Jones Date: Fri Dec 8 15:31:36 2017 +0000 Improve LiberateCase This patch, which fixes Trac #14566, makes LiberateCase a little more conservative. In particular: * In libCaseBind, treat a recursive group as a whole, rather than binding-by-binding, allowing the group to be duplicated only if - the bindings /considered together/ are smaller than the liberate-case threshold (which is large by default) - none of them are thunks - none of them are guaranteed-diverging The latter condidtion is new, and happens to apply in the case of Data/Typeable/Internal.mkTrApp >--------------------------------------------------------------- 800009d9b78a9b2877e7efc889e8a0b21873990d compiler/simplCore/LiberateCase.hs | 90 +++++++++++++++++++++++--------------- 1 file changed, 54 insertions(+), 36 deletions(-) diff --git a/compiler/simplCore/LiberateCase.hs b/compiler/simplCore/LiberateCase.hs index 8cee064..342ad73 100644 --- a/compiler/simplCore/LiberateCase.hs +++ b/compiler/simplCore/LiberateCase.hs @@ -14,6 +14,7 @@ import GhcPrelude import DynFlags import CoreSyn import CoreUnfold ( couldBeSmallEnoughToInline ) +import TysWiredIn ( unitDataConId ) import Id import VarEnv import Util ( notNull ) @@ -68,24 +69,6 @@ Exactly the same optimisation (unrolling one call to f) will work here, despite the cast. See mk_alt_env in the Case branch of libCase. -Note [Only functions!] -~~~~~~~~~~~~~~~~~~~~~~ -Consider the following code - - f = g (case v of V a b -> a : t f) - -where g is expensive. If we aren't careful, liberate case will turn this into - - f = g (case v of - V a b -> a : t (letrec f = g (case v of V a b -> a : f t) - in f) - ) - -Yikes! We evaluate g twice. This leads to a O(2^n) explosion -if g calls back to the same code recursively. - -Solution: make sure that we only do the liberate-case thing on *functions* - To think about (Apr 94) ~~~~~~~~~~~~~~ Main worry: duplicating code excessively. At the moment we duplicate @@ -156,18 +139,63 @@ libCaseBind env (Rec pairs) -- We extend the rec-env by binding each Id to its rhs, first -- processing the rhs with an *un-extended* environment, so -- that the same process doesn't occur for ever! - env_rhs = addRecBinds env [ (localiseId binder, libCase env_body rhs) - | (binder, rhs) <- pairs - , rhs_small_enough binder rhs ] + env_rhs | is_dupable_bind = addRecBinds env dup_pairs + | otherwise = env + + dup_pairs = [ (localiseId binder, libCase env_body rhs) + | (binder, rhs) <- pairs ] -- localiseID : see Note [Need to localiseId in libCaseBind] + is_dupable_bind = small_enough && all ok_pair pairs - rhs_small_enough id rhs -- Note [Small enough] - = idArity id > 0 -- Note [Only functions!] - && maybe True (\size -> couldBeSmallEnoughToInline (lc_dflags env) size rhs) - (bombOutSize env) + -- Size: we are going to duplicate dup_pairs; to find their + -- size, build a fake binding (let { dup_pairs } in (), + -- and find the size of that + -- See Note [Small enough] + small_enough = case bombOutSize env of + Nothing -> True -- Infinity + Just size -> couldBeSmallEnoughToInline (lc_dflags env) size $ + Let (Rec dup_pairs) (Var unitDataConId) + + ok_pair (id,_) + = idArity id > 0 -- Note [Only functions!] + && not (isBottomingId id) -- Note [Not bottoming ids] + +{- Note [Not bottoming Ids] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Do not specialise error-functions (this is unusual, but I once saw it, +(acually in Data.Typable.Internal) + +Note [Only functions!] +~~~~~~~~~~~~~~~~~~~~~~ +Consider the following code + + f = g (case v of V a b -> a : t f) + +where g is expensive. If we aren't careful, liberate case will turn this into + + f = g (case v of + V a b -> a : t (letrec f = g (case v of V a b -> a : f t) + in f) + ) + +Yikes! We evaluate g twice. This leads to a O(2^n) explosion +if g calls back to the same code recursively. + +Solution: make sure that we only do the liberate-case thing on *functions* + +Note [Small enough] +~~~~~~~~~~~~~~~~~~~ +Consider + \fv. letrec + f = \x. BIG...(case fv of { (a,b) -> ...g.. })... + g = \y. SMALL...f... + +Then we *can* in principle do liberate-case on 'g' (small RHS) but not +for 'f' (too big). But doing so is not profitable, becuase duplicating +'g' at its call site in 'f' doesn't get rid of any cases. So we just +ask for the whole group to be small enough. -{- Note [Need to localiseId in libCaseBind] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The call to localiseId is needed for two subtle reasons @@ -181,16 +209,6 @@ The call to localiseId is needed for two subtle reasons nested; if it were floated to the top level, we'd get a name clash at code generation time. -Note [Small enough] -~~~~~~~~~~~~~~~~~~~ -Consider - \fv. letrec - f = \x. BIG...(case fv of { (a,b) -> ...g.. })... - g = \y. SMALL...f... -Then we *can* do liberate-case on g (small RHS) but not for f (too big). -But we can choose on a item-by-item basis, and that's what the -rhs_small_enough call in the comprehension for env_rhs does. - Expressions ~~~~~~~~~~~ -} From git at git.haskell.org Fri Dec 8 18:50:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 18:50:16 +0000 (UTC) Subject: [commit: ghc] master: Rip out hadrian subtree (7733e44) Message-ID: <20171208185016.092863A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7733e44dd4ba7e7a0a9f3456e6ddc32decbcf5a3/ghc >--------------------------------------------------------------- commit 7733e44dd4ba7e7a0a9f3456e6ddc32decbcf5a3 Author: Ben Gamari Date: Fri Dec 8 12:42:35 2017 -0500 Rip out hadrian subtree Sadly subtrees haven't worked quite as well as we would have liked for developers. See Hadrian #440. >--------------------------------------------------------------- 7733e44dd4ba7e7a0a9f3456e6ddc32decbcf5a3 hadrian/.ghci | 11 - hadrian/.gitignore | 26 -- hadrian/.travis.yml | 92 ----- hadrian/LICENSE | 21 - hadrian/README.md | 194 --------- hadrian/appveyor.yml | 41 -- hadrian/build.bat | 6 - hadrian/build.cabal.sh | 74 ---- hadrian/build.global-db.bat | 32 -- hadrian/build.global-db.sh | 52 --- hadrian/build.sh | 35 -- hadrian/build.stack.bat | 11 - hadrian/build.stack.nix.sh | 33 -- hadrian/build.stack.sh | 39 -- hadrian/cabal.project | 5 - hadrian/cfg/system.config.in | 138 ------- hadrian/circle.yml | 42 -- hadrian/doc/cross-compile.md | 57 --- hadrian/doc/flavours.md | 176 --------- hadrian/doc/user-settings.md | 212 ---------- hadrian/doc/windows.md | 69 ---- hadrian/hadrian.cabal | 142 ------- hadrian/src/Base.hs | 121 ------ hadrian/src/Builder.hs | 296 -------------- hadrian/src/CommandLine.hs | 137 ------- hadrian/src/Context.hs | 158 -------- hadrian/src/Environment.hs | 16 - hadrian/src/Expression.hs | 123 ------ hadrian/src/Flavour.hs | 34 -- hadrian/src/GHC.hs | 289 -------------- hadrian/src/Hadrian/Builder.hs | 125 ------ hadrian/src/Hadrian/Builder/Ar.hs | 68 ---- hadrian/src/Hadrian/Builder/Sphinx.hs | 39 -- hadrian/src/Hadrian/Builder/Tar.hs | 40 -- hadrian/src/Hadrian/Expression.hs | 153 ------- hadrian/src/Hadrian/Haskell/Cabal.hs | 44 --- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs | 63 --- hadrian/src/Hadrian/Oracles/ArgsHash.hs | 51 --- hadrian/src/Hadrian/Oracles/DirectoryContents.hs | 64 --- hadrian/src/Hadrian/Oracles/Path.hs | 62 --- hadrian/src/Hadrian/Oracles/TextFile.hs | 123 ------ hadrian/src/Hadrian/Package.hs | 120 ------ hadrian/src/Hadrian/Target.hs | 29 -- hadrian/src/Hadrian/Utilities.hs | 406 ------------------- hadrian/src/Main.hs | 59 --- hadrian/src/Oracles/Flag.hs | 74 ---- hadrian/src/Oracles/ModuleFiles.hs | 160 -------- hadrian/src/Oracles/PackageData.hs | 66 ---- hadrian/src/Oracles/Setting.hs | 236 ----------- hadrian/src/Rules.hs | 123 ------ hadrian/src/Rules/Clean.hs | 23 -- hadrian/src/Rules/Compile.hs | 81 ---- hadrian/src/Rules/Configure.hs | 43 -- hadrian/src/Rules/Dependencies.hs | 33 -- hadrian/src/Rules/Documentation.hs | 197 --------- hadrian/src/Rules/Generate.hs | 482 ----------------------- hadrian/src/Rules/Gmp.hs | 119 ------ hadrian/src/Rules/Install.hs | 336 ---------------- hadrian/src/Rules/Libffi.hs | 108 ----- hadrian/src/Rules/Library.hs | 103 ----- hadrian/src/Rules/PackageData.hs | 119 ------ hadrian/src/Rules/Program.hs | 113 ------ hadrian/src/Rules/Register.hs | 44 --- hadrian/src/Rules/Selftest.hs | 92 ----- hadrian/src/Rules/SourceDist.hs | 113 ------ hadrian/src/Rules/Test.hs | 72 ---- hadrian/src/Rules/Wrappers.hs | 162 -------- hadrian/src/Settings.hs | 68 ---- hadrian/src/Settings/Builders/Alex.hs | 8 - hadrian/src/Settings/Builders/Cc.hs | 26 -- hadrian/src/Settings/Builders/Common.hs | 58 --- hadrian/src/Settings/Builders/Configure.hs | 25 -- hadrian/src/Settings/Builders/DeriveConstants.hs | 39 -- hadrian/src/Settings/Builders/GenPrimopCode.hs | 24 -- hadrian/src/Settings/Builders/Ghc.hs | 149 ------- hadrian/src/Settings/Builders/GhcCabal.hs | 118 ------ hadrian/src/Settings/Builders/GhcPkg.hs | 17 - hadrian/src/Settings/Builders/Haddock.hs | 63 --- hadrian/src/Settings/Builders/Happy.hs | 9 - hadrian/src/Settings/Builders/HsCpp.hs | 16 - hadrian/src/Settings/Builders/Hsc2Hs.hs | 56 --- hadrian/src/Settings/Builders/Ld.hs | 9 - hadrian/src/Settings/Builders/Make.hs | 16 - hadrian/src/Settings/Builders/Xelatex.hs | 7 - hadrian/src/Settings/Default.hs | 173 -------- hadrian/src/Settings/Default.hs-boot | 20 - hadrian/src/Settings/Flavours/Development.hs | 20 - hadrian/src/Settings/Flavours/Performance.hs | 18 - hadrian/src/Settings/Flavours/Profiled.hs | 19 - hadrian/src/Settings/Flavours/Quick.hs | 22 -- hadrian/src/Settings/Flavours/QuickCross.hs | 24 -- hadrian/src/Settings/Flavours/Quickest.hs | 23 -- hadrian/src/Settings/Packages/Base.hs | 12 - hadrian/src/Settings/Packages/Cabal.hs | 10 - hadrian/src/Settings/Packages/Compiler.hs | 45 --- hadrian/src/Settings/Packages/Ghc.hs | 13 - hadrian/src/Settings/Packages/GhcCabal.hs | 32 -- hadrian/src/Settings/Packages/GhcPkg.hs | 7 - hadrian/src/Settings/Packages/GhcPrim.hs | 12 - hadrian/src/Settings/Packages/Ghci.hs | 6 - hadrian/src/Settings/Packages/Haddock.hs | 7 - hadrian/src/Settings/Packages/Haskeline.hs | 8 - hadrian/src/Settings/Packages/IntegerGmp.hs | 24 -- hadrian/src/Settings/Packages/Rts.hs | 224 ----------- hadrian/src/Settings/Packages/RunGhc.hs | 9 - hadrian/src/Settings/Warnings.hs | 56 --- hadrian/src/Stage.hs | 31 -- hadrian/src/Target.hs | 26 -- hadrian/src/UserSettings.hs | 64 --- hadrian/src/Utilities.hs | 88 ----- hadrian/src/Way.hs | 162 -------- hadrian/stack.yaml | 25 -- 112 files changed, 8915 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 7733e44dd4ba7e7a0a9f3456e6ddc32decbcf5a3 From git at git.haskell.org Fri Dec 8 18:50:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Dec 2017 18:50:19 +0000 (UTC) Subject: [commit: ghc] master: Add hadrian as a submodule (4335c07) Message-ID: <20171208185019.079783A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4335c07ca7e64624819b22644d7591853826bd75/ghc >--------------------------------------------------------------- commit 4335c07ca7e64624819b22644d7591853826bd75 Author: Ben Gamari Date: Fri Dec 8 13:02:06 2017 -0500 Add hadrian as a submodule It will remain a submodule until we are ready to merge Hadrian into the tree. >--------------------------------------------------------------- 4335c07ca7e64624819b22644d7591853826bd75 .gitmodules | 3 +++ hadrian | 1 + 2 files changed, 4 insertions(+) diff --git a/.gitmodules b/.gitmodules index f5ec0ef..2125a92 100644 --- a/.gitmodules +++ b/.gitmodules @@ -129,3 +129,6 @@ [submodule ".arc-linters/arcanist-external-json-linter"] path = .arc-linters/arcanist-external-json-linter url = ../arcanist-external-json-linter.git +[submodule "hadrian"] + path = hadrian + url = ../hadrian.git diff --git a/hadrian b/hadrian new file mode 160000 index 0000000..86216e2 --- /dev/null +++ b/hadrian @@ -0,0 +1 @@ +Subproject commit 86216e249f307a778bef3755afb7474910bc60cc From git at git.haskell.org Sun Dec 10 07:11:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Dec 2017 07:11:44 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump (982d955) Message-ID: <20171210071144.AEB283A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/982d9554d50381ba8797e52cfb9f45d6e1ae8d92/ghc >--------------------------------------------------------------- commit 982d9554d50381ba8797e52cfb9f45d6e1ae8d92 Author: Moritz Angermann Date: Fri Dec 8 22:41:41 2017 +0800 bump >--------------------------------------------------------------- 982d9554d50381ba8797e52cfb9f45d6e1ae8d92 hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index b990b24..8e0ff6a 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit b990b24ea3c4638ff17032fe9b994b80455d54a7 +Subproject commit 8e0ff6a7ae8891936b4ec8bf9e7f8732d84a8420 From git at git.haskell.org Sun Dec 10 07:11:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Dec 2017 07:11:51 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump hadrian (8b6ca38) Message-ID: <20171210071151.1491C3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/8b6ca384973f03a1dd70477c6ddcf4308720268c/ghc >--------------------------------------------------------------- commit 8b6ca384973f03a1dd70477c6ddcf4308720268c Author: Moritz Angermann Date: Sun Dec 10 15:11:28 2017 +0800 bump hadrian >--------------------------------------------------------------- 8b6ca384973f03a1dd70477c6ddcf4308720268c hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index 8e0ff6a..fbbab87 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit 8e0ff6a7ae8891936b4ec8bf9e7f8732d84a8420 +Subproject commit fbbab8799bc4f3385be0334d3c86a15fdc647ce4 From git at git.haskell.org Sun Dec 10 07:11:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Dec 2017 07:11:47 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds x86_64 android layout (0037d1e) Message-ID: <20171210071147.EA8E03A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/0037d1e284155ec3b2ac25c683d28134eeed18ed/ghc >--------------------------------------------------------------- commit 0037d1e284155ec3b2ac25c683d28134eeed18ed Author: Moritz Angermann Date: Sun Dec 10 07:36:20 2017 +0800 Adds x86_64 android layout >--------------------------------------------------------------- 0037d1e284155ec3b2ac25c683d28134eeed18ed llvm-targets | 1 + utils/llvm-targets/gen-data-layout.sh | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/llvm-targets b/llvm-targets index 3c9da1e..6dd5a60 100644 --- a/llvm-targets +++ b/llvm-targets @@ -11,6 +11,7 @@ ,("i386-unknown-linux", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) ,("x86_64-unknown-linux-gnu", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) ,("x86_64-unknown-linux", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) +,("x86_64-unknown-linux-android", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "+sse4.2 +popcnt")) ,("armv7-unknown-linux-androideabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("aarch64-unknown-linux-android", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("arm-unknown-nto-qnx-eabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm7tdmi", "+strict-align")) diff --git a/utils/llvm-targets/gen-data-layout.sh b/utils/llvm-targets/gen-data-layout.sh index 6f2aafc..05ab085 100755 --- a/utils/llvm-targets/gen-data-layout.sh +++ b/utils/llvm-targets/gen-data-layout.sh @@ -20,7 +20,7 @@ WINDOWS_x86="i386-unknown-windows i686-unknown-windows x86_64-unknown-windows" LINUX_ARM="arm-unknown-linux-gnueabihf armv6-unknown-linux-gnueabihf armv7-unknown-linux-gnueabihf aarch64-unknown-linux-gnu aarch64-unknown-linux armv7a-unknown-linux-gnueabi" LINUX_x86="i386-unknown-linux-gnu i386-unknown-linux x86_64-unknown-linux-gnu x86_64-unknown-linux" -ANDROID="armv7-unknown-linux-androideabi aarch64-unknown-linux-android" +ANDROID="x86_64-unknown-linux-android armv7-unknown-linux-androideabi aarch64-unknown-linux-android" QNX="arm-unknown-nto-qnx-eabi" MACOS="i386-apple-darwin x86_64-apple-darwin" IOS="armv7-apple-ios arm64-apple-ios i386-apple-ios x86_64-apple-ios" From git at git.haskell.org Mon Dec 11 15:30:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 15:30:44 +0000 (UTC) Subject: [commit: ghc] master: Improved panic message for zonkTcTyVarToTyVar (716acbb) Message-ID: <20171211153044.BBC8F3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/716acbb5084db6ace5f06bd6112aa1e24b46423a/ghc >--------------------------------------------------------------- commit 716acbb5084db6ace5f06bd6112aa1e24b46423a Author: Simon Peyton Jones Date: Fri Dec 8 17:32:16 2017 +0000 Improved panic message for zonkTcTyVarToTyVar >--------------------------------------------------------------- 716acbb5084db6ace5f06bd6112aa1e24b46423a compiler/typecheck/TcMType.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index d7e6a5e..7473967 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -1532,10 +1532,14 @@ zonkTcTyVar tv -- Variant that assumes that any result of zonking is still a TyVar. -- Should be used only on skolems and SigTvs -zonkTcTyVarToTyVar :: TcTyVar -> TcM TcTyVar +zonkTcTyVarToTyVar :: HasDebugCallStack => TcTyVar -> TcM TcTyVar zonkTcTyVarToTyVar tv = do { ty <- zonkTcTyVar tv - ; return (tcGetTyVar "zonkTcTyVarToVar" ty) } + ; let tv' = case tcGetTyVar_maybe ty of + Just tv' -> tv' + Nothing -> pprPanic "zonkTcTyVarToTyVar" + (ppr tv $$ ppr ty) + ; return tv' } {- %************************************************************************ From git at git.haskell.org Mon Dec 11 15:30:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 15:30:49 +0000 (UTC) Subject: [commit: ghc] master: Build only well-kinded types in type checker (8b36ed1) Message-ID: <20171211153049.10C253A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8b36ed129652df07af22b5e2a2e57b1df8cfbbc9/ghc >--------------------------------------------------------------- commit 8b36ed129652df07af22b5e2a2e57b1df8cfbbc9 Author: Simon Peyton Jones Date: Mon Dec 11 11:52:44 2017 +0000 Build only well-kinded types in type checker During type inference, we maintain the invariant that every type is well-kinded /without/ zonking; and in particular that typeKind does not fail (as it can for ill-kinded types). But TcHsType.tcInferApps was not guaranteeing this invariant, resulting in Trac #14174 and #14520. This patch fixes it, making things better -- but it does /not/ fix the program in Trac #14174 comment:5, which still crashes. So more work to be done. See Note [Ensure well-kinded types] in TcHsType >--------------------------------------------------------------- 8b36ed129652df07af22b5e2a2e57b1df8cfbbc9 compiler/typecheck/TcHsType.hs | 40 +++++++++++++--- testsuite/tests/polykinds/T14174.hs | 6 +++ testsuite/tests/polykinds/T14174.stderr | 7 +++ testsuite/tests/polykinds/T14174a.hs | 56 ++++++++++++++++++++++ .../tests/polykinds/T14174a.stderr | 1 + testsuite/tests/polykinds/T14520.hs | 16 +++++++ testsuite/tests/polykinds/T14520.stderr | 5 ++ testsuite/tests/polykinds/all.T | 3 ++ 8 files changed, 128 insertions(+), 6 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 8b36ed129652df07af22b5e2a2e57b1df8cfbbc9 From git at git.haskell.org Mon Dec 11 17:35:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 17:35:38 +0000 (UTC) Subject: [commit: ghc] master: Fix SigTvs at the kind level (8361b2c) Message-ID: <20171211173538.B4BF43A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8361b2c5a9f7a00f0024f44a43b851998ae41e33/ghc >--------------------------------------------------------------- commit 8361b2c5a9f7a00f0024f44a43b851998ae41e33 Author: Simon Peyton Jones Date: Mon Dec 11 15:53:32 2017 +0000 Fix SigTvs at the kind level This patch fixes two bugs in the treatment of SigTvs at the kind level: - We should always generalise them, never default them (Trac #14555, #14563) - We should check if they get unified with each other (Trac #11203) Both are described in TcHsType Note [Kind generalisation and SigTvs] >--------------------------------------------------------------- 8361b2c5a9f7a00f0024f44a43b851998ae41e33 compiler/typecheck/TcBinds.hs | 20 +++--- compiler/typecheck/TcHsType.hs | 79 ++++++++++++++++------ compiler/typecheck/TcMType.hs | 30 +++++--- compiler/typecheck/TcSimplify.hs | 3 + compiler/typecheck/TcTyClsDecls.hs | 76 +++++++++++++++++---- compiler/typecheck/TcType.hs | 18 ++++- compiler/types/TyCon.hs | 56 ++------------- .../tests/polykinds/{SigTvKinds2.hs => T11203.hs} | 4 +- testsuite/tests/polykinds/T11203.stderr | 4 ++ testsuite/tests/polykinds/T11821a.stderr | 4 ++ testsuite/tests/polykinds/T14555.hs | 12 ++++ testsuite/tests/polykinds/T14555.stderr | 6 ++ testsuite/tests/polykinds/T14563.hs | 9 +++ testsuite/tests/polykinds/T14563.stderr | 7 ++ testsuite/tests/polykinds/all.T | 6 +- 15 files changed, 228 insertions(+), 106 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 8361b2c5a9f7a00f0024f44a43b851998ae41e33 From git at git.haskell.org Mon Dec 11 19:26:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 19:26:39 +0000 (UTC) Subject: [commit: ghc] master: Only look for locales of the form LL.VV (abd5db6) Message-ID: <20171211192639.23FE43A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/abd5db6072218ada2b4a21177f5200ea0d3273a0/ghc >--------------------------------------------------------------- commit abd5db6072218ada2b4a21177f5200ea0d3273a0 Author: Gabor Greif Date: Thu Nov 30 20:49:03 2017 +0100 Only look for locales of the form LL.VV Because in recent RHEL7 suddenly locales like `bokmål` pop up, which screw up reading-in of ASCII strings a line later. This additional criterion reliably eliminates those unicode characters. >--------------------------------------------------------------- abd5db6072218ada2b4a21177f5200ea0d3273a0 testsuite/driver/runtests.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 9f74494..db17f3b 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -151,7 +151,7 @@ else: h.close() if v == '': # We don't, so now see if 'locale -a' works - h = os.popen('locale -a', 'r') + h = os.popen('locale -a | grep -F .', 'r') v = h.read() h.close() if v != '': From git at git.haskell.org Mon Dec 11 19:26:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 19:26:42 +0000 (UTC) Subject: [commit: ghc] master: Fixed misprint 'aqcuired' (21be5bd) Message-ID: <20171211192642.518C03A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/21be5bde1162c4d006f5eae0f20f9243cb0642f1/ghc >--------------------------------------------------------------- commit 21be5bde1162c4d006f5eae0f20f9243cb0642f1 Author: Kirill Zaborsky Date: Mon Dec 11 18:04:55 2017 +0300 Fixed misprint 'aqcuired' >--------------------------------------------------------------- 21be5bde1162c4d006f5eae0f20f9243cb0642f1 libraries/base/Control/Concurrent/QSem.hs | 2 +- libraries/base/Control/Concurrent/QSemN.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/base/Control/Concurrent/QSem.hs b/libraries/base/Control/Concurrent/QSem.hs index 51624e4..ea39625 100644 --- a/libraries/base/Control/Concurrent/QSem.hs +++ b/libraries/base/Control/Concurrent/QSem.hs @@ -29,7 +29,7 @@ import Control.Concurrent.MVar ( MVar, newEmptyMVar, takeMVar, tryTakeMVar import Control.Exception import Data.Maybe --- | 'QSem' is a quantity semaphore in which the resource is aqcuired +-- | 'QSem' is a quantity semaphore in which the resource is acquired -- and released in units of one. It provides guaranteed FIFO ordering -- for satisfying blocked `waitQSem` calls. -- diff --git a/libraries/base/Control/Concurrent/QSemN.hs b/libraries/base/Control/Concurrent/QSemN.hs index 7686d3f..b8c9274 100644 --- a/libraries/base/Control/Concurrent/QSemN.hs +++ b/libraries/base/Control/Concurrent/QSemN.hs @@ -31,7 +31,7 @@ import Control.Concurrent.MVar ( MVar, newEmptyMVar, takeMVar, tryTakeMVar import Control.Exception import Data.Maybe --- | 'QSemN' is a quantity semaphore in which the resource is aqcuired +-- | 'QSemN' is a quantity semaphore in which the resource is acquired -- and released in units of one. It provides guaranteed FIFO ordering -- for satisfying blocked `waitQSemN` calls. -- From git at git.haskell.org Mon Dec 11 19:26:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 19:26:45 +0000 (UTC) Subject: [commit: ghc] master: Improve Control.Monad.guard and Control.Monad.MonadPlus docs (6847c6b) Message-ID: <20171211192645.448953A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6847c6bf5777eaf507f1cef28c1fc75a2c68bdef/ghc >--------------------------------------------------------------- commit 6847c6bf5777eaf507f1cef28c1fc75a2c68bdef Author: Nathan Collins Date: Mon Dec 11 12:52:55 2017 -0500 Improve Control.Monad.guard and Control.Monad.MonadPlus docs This fixes Issue #12372: documentation for Control.Monad.guard not useful after AMP. Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4258 >--------------------------------------------------------------- 6847c6bf5777eaf507f1cef28c1fc75a2c68bdef libraries/base/Control/Monad.hs | 43 +++++++++++++++++++++++++++++++++++++++-- libraries/base/GHC/Base.hs | 13 +++++++++++-- 2 files changed, 52 insertions(+), 4 deletions(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 0706c86..3570144 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -86,8 +86,47 @@ import GHC.Num ( (-) ) -- ----------------------------------------------------------------------------- -- Functions mandated by the Prelude --- | @'guard' b@ is @'pure' ()@ if @b@ is 'True', --- and 'empty' if @b@ is 'False'. +-- | Conditional failure of 'Alternative' computations. Defined by +-- +-- @ +-- guard True = 'pure' () +-- guard False = 'empty' +-- @ +-- +-- ==== __Examples__ +-- +-- Common uses of 'guard' include conditionally signaling an error in +-- an error monad and conditionally rejecting the current choice in an +-- 'Alternative'-based parser. +-- +-- As an example of signaling an error in the error monad 'Maybe', +-- consider a safe division function @safeDiv x y@ that returns +-- 'Nothing' when the denominator @y@ is zero and @'Just' (x \`div\` +-- y)@ otherwise. For example: +-- +-- @ +-- >>> safeDiv 4 0 +-- Nothing +-- >>> safeDiv 4 2 +-- Just 2 +-- @ +-- +-- A definition of @safeDiv@ using guards, but not 'guard': +-- +-- @ +-- safeDiv :: Int -> Int -> Maybe Int +-- safeDiv x y | y /= 0 = Just (x \`div\` y) +-- | otherwise = Nothing +-- @ +-- +-- A definition of @safeDiv@ using 'guard' and 'Monad' @do at -notation: +-- +-- @ +-- safeDiv :: Int -> Int -> Maybe Int +-- safeDiv x y = do +-- guard (y /= 0) +-- return (x \`div\` y) +-- @ guard :: (Alternative f) => Bool -> f () guard True = pure () guard False = empty diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 052f13f..2d6e0e4 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -880,15 +880,24 @@ instance Alternative Maybe where -- | Monads that also support choice and failure. class (Alternative m, Monad m) => MonadPlus m where - -- | the identity of 'mplus'. It should also satisfy the equations + -- | The identity of 'mplus'. It should also satisfy the equations -- -- > mzero >>= f = mzero -- > v >> mzero = mzero -- + -- The default definition is + -- + -- @ + -- mzero = 'empty' + -- @ mzero :: m a mzero = empty - -- | an associative operation + -- | An associative operation. The default definition is + -- + -- @ + -- mplus = ('<|>') + -- @ mplus :: m a -> m a -> m a mplus = (<|>) From git at git.haskell.org Mon Dec 11 19:26:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 19:26:48 +0000 (UTC) Subject: [commit: ghc] master: Add information about irrefutable pattern Syntax to XStrict. (00d7132) Message-ID: <20171211192648.6D98F3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/00d71323e53a4eb8ae63ab32e6e1709d2f118542/ghc >--------------------------------------------------------------- commit 00d71323e53a4eb8ae63ab32e6e1709d2f118542 Author: klebinger.andreas at gmx.at Date: Mon Dec 11 12:53:54 2017 -0500 Add information about irrefutable pattern Syntax to XStrict. This information was present in the ghc wiki but not the user guide. [skip ci] Test Plan: None Reviewers: bgamari Reviewed By: bgamari Subscribers: RyanGlScott, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4250 >--------------------------------------------------------------- 00d71323e53a4eb8ae63ab32e6e1709d2f118542 docs/users_guide/glasgow_exts.rst | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 3edb8d6..7861a17 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -12523,6 +12523,10 @@ optionally had by adding ``!`` in front of a variable. Adding ``~`` in front of ``x`` gives the regular lazy behavior. + Turning patterns into irrefutable ones requires ``~(~p)`` or ``(~ ~p)`` when ``Strict`` is enabled. + + + - **Let/where bindings** When the user writes :: From git at git.haskell.org Mon Dec 11 19:26:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 19:26:51 +0000 (UTC) Subject: [commit: ghc] master: Add NOINLINE pragma to hPutStr' (21cdfe5) Message-ID: <20171211192651.BBE533A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/21cdfe5ff5b9506c324164dd59e1b1d603784819/ghc >--------------------------------------------------------------- commit 21cdfe5ff5b9506c324164dd59e1b1d603784819 Author: Matthew Pickering Date: Mon Dec 11 12:54:18 2017 -0500 Add NOINLINE pragma to hPutStr' There appears to be no benefit in inlining this function. If you turn up the unfolding threshold a lot then it eventually inlines which produces a bit unoptimisable program. Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4246 >--------------------------------------------------------------- 21cdfe5ff5b9506c324164dd59e1b1d603784819 libraries/base/GHC/IO/Handle/Text.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/GHC/IO/Handle/Text.hs b/libraries/base/GHC/IO/Handle/Text.hs index 57b9534..f15c627 100644 --- a/libraries/base/GHC/IO/Handle/Text.hs +++ b/libraries/base/GHC/IO/Handle/Text.hs @@ -537,6 +537,7 @@ hPutStrLn handle str = hPutStr' handle str True -- overhead of a single putChar '\n', which is quite high now that we -- have to encode eagerly. +{-# NOINLINE hPutStr' #-} hPutStr' :: Handle -> String -> Bool -> IO () hPutStr' handle str add_nl = do From git at git.haskell.org Mon Dec 11 19:26:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 19:26:58 +0000 (UTC) Subject: [commit: ghc] master: Always use the safe open() call (cafe983) Message-ID: <20171211192658.299283A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cafe98345cb5d4b11f2059d60d2f20e976ef4f2a/ghc >--------------------------------------------------------------- commit cafe98345cb5d4b11f2059d60d2f20e976ef4f2a Author: Simon Marlow Date: Mon Dec 11 12:56:09 2017 -0500 Always use the safe open() call open() can sometimes take a long time, for example on NFS or FUSE filesystems. We recently had a case where open() was taking multiple seconds to return for a (presumably overloaded) FUSE filesystem, which blocked GC and caused severe issues. Test Plan: validate Reviewers: niteria, bgamari, nh2, hvr, erikd Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #13296 Differential Revision: https://phabricator.haskell.org/D4239 >--------------------------------------------------------------- cafe98345cb5d4b11f2059d60d2f20e976ef4f2a libraries/base/GHC/IO/FD.hs | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs index a7a34c1..4a4f063 100644 --- a/libraries/base/GHC/IO/FD.hs +++ b/libraries/base/GHC/IO/FD.hs @@ -179,14 +179,10 @@ openFile filepath iomode non_blocking = | otherwise = oflags2 in do - -- the old implementation had a complicated series of three opens, - -- which is perhaps because we have to be careful not to open - -- directories. However, the man pages I've read say that open() - -- always returns EISDIR if the file is a directory and was opened - -- for writing, so I think we're ok with a single open() here... - fd <- throwErrnoIfMinus1Retry "openFile" - (if non_blocking then c_open f oflags 0o666 - else c_safe_open f oflags 0o666) + -- NB. always use a safe open(), because we don't know whether open() + -- will be fast or not. It can be slow on NFS and FUSE filesystems, + -- for example. + fd <- throwErrnoIfMinus1Retry "openFile" $ c_safe_open f oflags 0o666 (fD,fd_type) <- mkFD fd iomode Nothing{-no stat-} False{-not a socket-} From git at git.haskell.org Mon Dec 11 19:26:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 19:26:55 +0000 (UTC) Subject: [commit: ghc] master: rts: Don't default to single capability when profiled (4bfff7a) Message-ID: <20171211192655.0B9B23A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4bfff7a507b5807736e9c6ce9814a9cfa60faeff/ghc >--------------------------------------------------------------- commit 4bfff7a507b5807736e9c6ce9814a9cfa60faeff Author: Ben Gamari Date: Mon Dec 11 12:55:31 2017 -0500 rts: Don't default to single capability when profiled This was presumably a vestige of the days when the profiled RTS couldn't run threaded. Fixes #14545. Test Plan: simonmar Reviewers: erikd, simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14545 Differential Revision: https://phabricator.haskell.org/D4245 >--------------------------------------------------------------- 4bfff7a507b5807736e9c6ce9814a9cfa60faeff rts/RtsFlags.c | 4 ---- 1 file changed, 4 deletions(-) diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index 39b1273..26171cf 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -1289,11 +1289,7 @@ error = true; OPTION_SAFE; THREADED_BUILD_ONLY( if (rts_argv[arg][2] == '\0') { -#if defined(PROFILING) - RtsFlags.ParFlags.nCapabilities = 1; -#else RtsFlags.ParFlags.nCapabilities = getNumberOfProcessors(); -#endif } else { int nCapabilities; OPTION_SAFE; /* but see extra checks below... */ From git at git.haskell.org Mon Dec 11 19:27:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 19:27:01 +0000 (UTC) Subject: [commit: ghc] master: Allow users to ignore optimization changes (708ed9c) Message-ID: <20171211192701.E90603A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/708ed9ca4dbf372817fe84a2fe486940123bddfb/ghc >--------------------------------------------------------------- commit 708ed9ca4dbf372817fe84a2fe486940123bddfb Author: David Feuer Date: Mon Dec 11 13:03:52 2017 -0500 Allow users to ignore optimization changes * Add a new flag, `-fignore-optim-changes`, allowing them to avoid recompilation if the only changes are to the `-O` level or to flags controlling optimizations. * When `-fignore-optim-changes` is *off*, recompile when optimization flags (e.g., `-fno-full-laziness`) change. Previously, we ignored these unconditionally when deciding whether to recompile a module. Reviewers: austin, bgamari, simonmar Reviewed By: simonmar Subscribers: duog, carter, simonmar, rwbarton, thomie GHC Trac Issues: #13604 Differential Revision: https://phabricator.haskell.org/D4123 >--------------------------------------------------------------- 708ed9ca4dbf372817fe84a2fe486940123bddfb compiler/iface/FlagChecker.hs | 67 ++++++++++++++++---- compiler/iface/LoadIface.hs | 2 + compiler/iface/MkIface.hs | 45 ++++++++++++- compiler/main/DynFlags.hs | 73 ++++++++++++++++++++-- compiler/main/HscTypes.hs | 15 ++++- docs/users_guide/8.4.1-notes.rst | 6 ++ docs/users_guide/separate_compilation.rst | 17 +++++ ghc/Main.hs | 12 +++- testsuite/tests/driver/Makefile | 14 +++++ testsuite/tests/driver/T13604.hs | 1 + .../{retc003/retc003.stdout => T13604.stdout} | 2 - testsuite/tests/driver/T13604a.hs | 1 + .../{retc003/retc003.stdout => T13604a.stdout} | 2 - testsuite/tests/driver/T13914/T13914.stdout | 4 +- testsuite/tests/driver/all.T | 2 + testsuite/tests/ghci/scripts/T9293.stdout | 8 +++ testsuite/tests/ghci/scripts/ghci024.stdout | 2 + testsuite/tests/ghci/scripts/ghci057.stdout | 8 +++ testsuite/tests/hpc/T11798.stdout | 2 +- 19 files changed, 254 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 708ed9ca4dbf372817fe84a2fe486940123bddfb From git at git.haskell.org Mon Dec 11 19:27:04 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 19:27:04 +0000 (UTC) Subject: [commit: ghc] master: fdReady: Use C99 bools / CBool in signature (430d1f6) Message-ID: <20171211192704.DCD4A3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/430d1f6a6ea37dd53887391c060ce53be792336f/ghc >--------------------------------------------------------------- commit 430d1f6a6ea37dd53887391c060ce53be792336f Author: Niklas Hambüchen Date: Mon Dec 11 13:06:33 2017 -0500 fdReady: Use C99 bools / CBool in signature Reviewers: bgamari, Phyx, austin, hvr, simonmar Reviewed By: bgamari Subscribers: syd, rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4041 >--------------------------------------------------------------- 430d1f6a6ea37dd53887391c060ce53be792336f libraries/base/Control/Concurrent.hs | 14 +++++++------- libraries/base/GHC/IO/FD.hs | 4 ++-- libraries/base/cbits/inputReady.c | 2 +- libraries/base/include/HsBase.h | 3 ++- 4 files changed, 12 insertions(+), 11 deletions(-) diff --git a/libraries/base/Control/Concurrent.hs b/libraries/base/Control/Concurrent.hs index 0946399..bd222e2 100644 --- a/libraries/base/Control/Concurrent.hs +++ b/libraries/base/Control/Concurrent.hs @@ -407,7 +407,7 @@ threadWaitRead fd -- fdReady does the right thing, but we have to call it in a -- separate thread, otherwise threadWaitRead won't be interruptible, -- and this only works with -threaded. - | threaded = withThread (waitFd fd 0) + | threaded = withThread (waitFd fd False) | otherwise = case fd of 0 -> do _ <- hWaitForInput stdin (-1) return () @@ -428,7 +428,7 @@ threadWaitRead fd threadWaitWrite :: Fd -> IO () threadWaitWrite fd #if defined(mingw32_HOST_OS) - | threaded = withThread (waitFd fd 1) + | threaded = withThread (waitFd fd True) | otherwise = errorWithoutStackTrace "threadWaitWrite requires -threaded on Windows" #else = GHC.Conc.threadWaitWrite fd @@ -444,7 +444,7 @@ threadWaitReadSTM :: Fd -> IO (STM (), IO ()) threadWaitReadSTM fd #if defined(mingw32_HOST_OS) | threaded = do v <- newTVarIO Nothing - mask_ $ void $ forkIO $ do result <- try (waitFd fd 0) + mask_ $ void $ forkIO $ do result <- try (waitFd fd False) atomically (writeTVar v $ Just result) let waitAction = do result <- readTVar v case result of @@ -468,7 +468,7 @@ threadWaitWriteSTM :: Fd -> IO (STM (), IO ()) threadWaitWriteSTM fd #if defined(mingw32_HOST_OS) | threaded = do v <- newTVarIO Nothing - mask_ $ void $ forkIO $ do result <- try (waitFd fd 1) + mask_ $ void $ forkIO $ do result <- try (waitFd fd True) atomically (writeTVar v $ Just result) let waitAction = do result <- readTVar v case result of @@ -494,13 +494,13 @@ withThread io = do Right a -> return a Left e -> throwIO (e :: IOException) -waitFd :: Fd -> CInt -> IO () +waitFd :: Fd -> Bool -> IO () waitFd fd write = do throwErrnoIfMinus1_ "fdReady" $ - fdReady (fromIntegral fd) write (-1) 0 + fdReady (fromIntegral fd) (if write then 1 else 0) (-1) 0 foreign import ccall safe "fdReady" - fdReady :: CInt -> CInt -> Int64 -> CInt -> IO CInt + fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt #endif -- --------------------------------------------------------------------------- diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs index 4a4f063..bb188a9 100644 --- a/libraries/base/GHC/IO/FD.hs +++ b/libraries/base/GHC/IO/FD.hs @@ -401,7 +401,7 @@ ready fd write msecs = do return (toEnum (fromIntegral r)) foreign import ccall safe "fdReady" - fdReady :: CInt -> CInt -> Int64 -> CInt -> IO CInt + fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt -- --------------------------------------------------------------------------- -- Terminal-related stuff @@ -562,7 +562,7 @@ isNonBlocking :: FD -> Bool isNonBlocking fd = fdIsNonBlocking fd /= 0 foreign import ccall unsafe "fdReady" - unsafe_fdReady :: CInt -> CInt -> Int64 -> CInt -> IO CInt + unsafe_fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt #else /* mingw32_HOST_OS.... */ diff --git a/libraries/base/cbits/inputReady.c b/libraries/base/cbits/inputReady.c index a3024bf..9b1bb9e 100644 --- a/libraries/base/cbits/inputReady.c +++ b/libraries/base/cbits/inputReady.c @@ -134,7 +134,7 @@ compute_WaitForSingleObject_timeout(bool infinite, Time remaining) * On error, sets `errno`. */ int -fdReady(int fd, int write, int64_t msecs, int isSock) +fdReady(int fd, bool write, int64_t msecs, bool isSock) { bool infinite = msecs < 0; diff --git a/libraries/base/include/HsBase.h b/libraries/base/include/HsBase.h index 748e357..13640c5 100644 --- a/libraries/base/include/HsBase.h +++ b/libraries/base/include/HsBase.h @@ -24,6 +24,7 @@ #include "HsFFI.h" +#include #include #include #include @@ -152,7 +153,7 @@ extern HsWord64 getMonotonicUSec(void); #endif /* in inputReady.c */ -extern int fdReady(int fd, int write, int64_t msecs, int isSock); +extern int fdReady(int fd, bool write, int64_t msecs, bool isSock); /* ----------------------------------------------------------------------------- INLINE functions. From git at git.haskell.org Mon Dec 11 19:27:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 19:27:08 +0000 (UTC) Subject: [commit: ghc] master: base: fdReady(): Return only after sycall returns after `msecs` have passed (9d29925) Message-ID: <20171211192708.358FB3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9d299253e29558b7d18e6643e1a84fb2bbbecfe5/ghc >--------------------------------------------------------------- commit 9d299253e29558b7d18e6643e1a84fb2bbbecfe5 Author: Niklas Hambüchen Date: Mon Dec 11 13:07:38 2017 -0500 base: fdReady(): Return only after sycall returns after `msecs` have passed Reviewers: bgamari, austin, hvr, dfeuer Reviewed By: dfeuer Subscribers: syd, dfeuer, rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4012 >--------------------------------------------------------------- 9d299253e29558b7d18e6643e1a84fb2bbbecfe5 libraries/base/cbits/inputReady.c | 89 ++++++++++++++++++++++++++++++++++----- 1 file changed, 79 insertions(+), 10 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9d299253e29558b7d18e6643e1a84fb2bbbecfe5 From git at git.haskell.org Mon Dec 11 20:36:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 20:36:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Bump version to 8.4 (ee2acdf) Message-ID: <20171211203625.5D2193A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/ee2acdf5f09f3c2abb014928ee28dc0db0056486/ghc >--------------------------------------------------------------- commit ee2acdf5f09f3c2abb014928ee28dc0db0056486 Author: Ben Gamari Date: Mon Dec 4 17:01:15 2017 -0500 Bump version to 8.4 Updates haddock dsubmodule >--------------------------------------------------------------- ee2acdf5f09f3c2abb014928ee28dc0db0056486 configure.ac | 2 +- iserv/iserv-bin.cabal | 6 +++--- libraries/template-haskell/template-haskell.cabal | 2 +- utils/haddock | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/configure.ac b/configure.ac index d67e5bd..01496b1 100644 --- a/configure.ac +++ b/configure.ac @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.3], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.4.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO : ${RELEASE=NO} diff --git a/iserv/iserv-bin.cabal b/iserv/iserv-bin.cabal index 846a111..4c68d8b 100644 --- a/iserv/iserv-bin.cabal +++ b/iserv/iserv-bin.cabal @@ -85,7 +85,7 @@ Library bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.6, deepseq >= 1.4 && < 1.5, - ghci == 8.3, + ghci == 8.4.*, network >= 2.6 && < 2.7, directory >= 1.3 && < 1.4, filepath >= 1.4 && < 1.5 @@ -112,7 +112,7 @@ Executable iserv bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.6, deepseq >= 1.4 && < 1.5, - ghci == 8.3 + ghci == 8.4.* if os(windows) Cpp-Options: -DWINDOWS @@ -133,7 +133,7 @@ Executable iserv-proxy bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.6, deepseq >= 1.4 && < 1.5, - ghci == 8.3, + ghci == 8.4.*, directory >= 1.3 && < 1.4, network >= 2.6, filepath >= 1.4 && < 1.5, diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal index 887865d..ea380ea 100644 --- a/libraries/template-haskell/template-haskell.cabal +++ b/libraries/template-haskell/template-haskell.cabal @@ -52,7 +52,7 @@ Library build-depends: base >= 4.9 && < 4.12, - ghc-boot-th == 8.3, + ghc-boot-th == 8.4.*, pretty == 1.1.* ghc-options: -Wall diff --git a/utils/haddock b/utils/haddock index ae0d140..e329a73 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit ae0d140334fff57f2737dbd7c5804b4868d9c3ab +Subproject commit e329a73765c510774e3a3f54472bcdeca48613f6 From git at git.haskell.org Mon Dec 11 20:36:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 20:36:31 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Add hadrian as a submodule (2278c4c) Message-ID: <20171211203631.516893A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/2278c4c752717d2a5784ac4fe6a41a051225d1b8/ghc >--------------------------------------------------------------- commit 2278c4c752717d2a5784ac4fe6a41a051225d1b8 Author: Ben Gamari Date: Fri Dec 8 13:02:06 2017 -0500 Add hadrian as a submodule It will remain a submodule until we are ready to merge Hadrian into the tree. >--------------------------------------------------------------- 2278c4c752717d2a5784ac4fe6a41a051225d1b8 .gitmodules | 3 +++ hadrian | 1 + 2 files changed, 4 insertions(+) diff --git a/.gitmodules b/.gitmodules index f5ec0ef..2125a92 100644 --- a/.gitmodules +++ b/.gitmodules @@ -129,3 +129,6 @@ [submodule ".arc-linters/arcanist-external-json-linter"] path = .arc-linters/arcanist-external-json-linter url = ../arcanist-external-json-linter.git +[submodule "hadrian"] + path = hadrian + url = ../hadrian.git diff --git a/hadrian b/hadrian new file mode 160000 index 0000000..86216e2 --- /dev/null +++ b/hadrian @@ -0,0 +1 @@ +Subproject commit 86216e249f307a778bef3755afb7474910bc60cc From git at git.haskell.org Mon Dec 11 20:36:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 20:36:34 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Always use the safe open() call (56fbfb3) Message-ID: <20171211203634.0C8143A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/56fbfb3023b66d785cbfe1b33c6d8052d9205514/ghc >--------------------------------------------------------------- commit 56fbfb3023b66d785cbfe1b33c6d8052d9205514 Author: Simon Marlow Date: Mon Dec 11 12:56:09 2017 -0500 Always use the safe open() call open() can sometimes take a long time, for example on NFS or FUSE filesystems. We recently had a case where open() was taking multiple seconds to return for a (presumably overloaded) FUSE filesystem, which blocked GC and caused severe issues. Test Plan: validate Reviewers: niteria, bgamari, nh2, hvr, erikd Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #13296 Differential Revision: https://phabricator.haskell.org/D4239 (cherry picked from commit cafe98345cb5d4b11f2059d60d2f20e976ef4f2a) >--------------------------------------------------------------- 56fbfb3023b66d785cbfe1b33c6d8052d9205514 libraries/base/GHC/IO/FD.hs | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs index a7a34c1..4a4f063 100644 --- a/libraries/base/GHC/IO/FD.hs +++ b/libraries/base/GHC/IO/FD.hs @@ -179,14 +179,10 @@ openFile filepath iomode non_blocking = | otherwise = oflags2 in do - -- the old implementation had a complicated series of three opens, - -- which is perhaps because we have to be careful not to open - -- directories. However, the man pages I've read say that open() - -- always returns EISDIR if the file is a directory and was opened - -- for writing, so I think we're ok with a single open() here... - fd <- throwErrnoIfMinus1Retry "openFile" - (if non_blocking then c_open f oflags 0o666 - else c_safe_open f oflags 0o666) + -- NB. always use a safe open(), because we don't know whether open() + -- will be fast or not. It can be slow on NFS and FUSE filesystems, + -- for example. + fd <- throwErrnoIfMinus1Retry "openFile" $ c_safe_open f oflags 0o666 (fD,fd_type) <- mkFD fd iomode Nothing{-no stat-} False{-not a socket-} From git at git.haskell.org Mon Dec 11 20:36:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 20:36:28 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Rip out hadrian subtree (351c460) Message-ID: <20171211203628.365343A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/351c460c6df24d8c0a490eea7e19867d2f1784fd/ghc >--------------------------------------------------------------- commit 351c460c6df24d8c0a490eea7e19867d2f1784fd Author: Ben Gamari Date: Fri Dec 8 12:42:35 2017 -0500 Rip out hadrian subtree Sadly subtrees haven't worked quite as well as we would have liked for developers. See Hadrian #440. >--------------------------------------------------------------- 351c460c6df24d8c0a490eea7e19867d2f1784fd hadrian/.ghci | 11 - hadrian/.gitignore | 26 -- hadrian/.travis.yml | 92 ----- hadrian/LICENSE | 21 - hadrian/README.md | 194 --------- hadrian/appveyor.yml | 41 -- hadrian/build.bat | 6 - hadrian/build.cabal.sh | 74 ---- hadrian/build.global-db.bat | 32 -- hadrian/build.global-db.sh | 52 --- hadrian/build.sh | 35 -- hadrian/build.stack.bat | 11 - hadrian/build.stack.nix.sh | 33 -- hadrian/build.stack.sh | 39 -- hadrian/cabal.project | 5 - hadrian/cfg/system.config.in | 138 ------- hadrian/circle.yml | 42 -- hadrian/doc/cross-compile.md | 57 --- hadrian/doc/flavours.md | 176 --------- hadrian/doc/user-settings.md | 212 ---------- hadrian/doc/windows.md | 69 ---- hadrian/hadrian.cabal | 142 ------- hadrian/src/Base.hs | 121 ------ hadrian/src/Builder.hs | 296 -------------- hadrian/src/CommandLine.hs | 137 ------- hadrian/src/Context.hs | 158 -------- hadrian/src/Environment.hs | 16 - hadrian/src/Expression.hs | 123 ------ hadrian/src/Flavour.hs | 34 -- hadrian/src/GHC.hs | 289 -------------- hadrian/src/Hadrian/Builder.hs | 125 ------ hadrian/src/Hadrian/Builder/Ar.hs | 68 ---- hadrian/src/Hadrian/Builder/Sphinx.hs | 39 -- hadrian/src/Hadrian/Builder/Tar.hs | 40 -- hadrian/src/Hadrian/Expression.hs | 153 ------- hadrian/src/Hadrian/Haskell/Cabal.hs | 44 --- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs | 63 --- hadrian/src/Hadrian/Oracles/ArgsHash.hs | 51 --- hadrian/src/Hadrian/Oracles/DirectoryContents.hs | 64 --- hadrian/src/Hadrian/Oracles/Path.hs | 62 --- hadrian/src/Hadrian/Oracles/TextFile.hs | 123 ------ hadrian/src/Hadrian/Package.hs | 120 ------ hadrian/src/Hadrian/Target.hs | 29 -- hadrian/src/Hadrian/Utilities.hs | 406 ------------------- hadrian/src/Main.hs | 59 --- hadrian/src/Oracles/Flag.hs | 74 ---- hadrian/src/Oracles/ModuleFiles.hs | 160 -------- hadrian/src/Oracles/PackageData.hs | 66 ---- hadrian/src/Oracles/Setting.hs | 236 ----------- hadrian/src/Rules.hs | 123 ------ hadrian/src/Rules/Clean.hs | 23 -- hadrian/src/Rules/Compile.hs | 81 ---- hadrian/src/Rules/Configure.hs | 43 -- hadrian/src/Rules/Dependencies.hs | 33 -- hadrian/src/Rules/Documentation.hs | 197 --------- hadrian/src/Rules/Generate.hs | 482 ----------------------- hadrian/src/Rules/Gmp.hs | 119 ------ hadrian/src/Rules/Install.hs | 336 ---------------- hadrian/src/Rules/Libffi.hs | 108 ----- hadrian/src/Rules/Library.hs | 103 ----- hadrian/src/Rules/PackageData.hs | 119 ------ hadrian/src/Rules/Program.hs | 113 ------ hadrian/src/Rules/Register.hs | 44 --- hadrian/src/Rules/Selftest.hs | 92 ----- hadrian/src/Rules/SourceDist.hs | 113 ------ hadrian/src/Rules/Test.hs | 72 ---- hadrian/src/Rules/Wrappers.hs | 162 -------- hadrian/src/Settings.hs | 68 ---- hadrian/src/Settings/Builders/Alex.hs | 8 - hadrian/src/Settings/Builders/Cc.hs | 26 -- hadrian/src/Settings/Builders/Common.hs | 58 --- hadrian/src/Settings/Builders/Configure.hs | 25 -- hadrian/src/Settings/Builders/DeriveConstants.hs | 39 -- hadrian/src/Settings/Builders/GenPrimopCode.hs | 24 -- hadrian/src/Settings/Builders/Ghc.hs | 149 ------- hadrian/src/Settings/Builders/GhcCabal.hs | 118 ------ hadrian/src/Settings/Builders/GhcPkg.hs | 17 - hadrian/src/Settings/Builders/Haddock.hs | 63 --- hadrian/src/Settings/Builders/Happy.hs | 9 - hadrian/src/Settings/Builders/HsCpp.hs | 16 - hadrian/src/Settings/Builders/Hsc2Hs.hs | 56 --- hadrian/src/Settings/Builders/Ld.hs | 9 - hadrian/src/Settings/Builders/Make.hs | 16 - hadrian/src/Settings/Builders/Xelatex.hs | 7 - hadrian/src/Settings/Default.hs | 173 -------- hadrian/src/Settings/Default.hs-boot | 20 - hadrian/src/Settings/Flavours/Development.hs | 20 - hadrian/src/Settings/Flavours/Performance.hs | 18 - hadrian/src/Settings/Flavours/Profiled.hs | 19 - hadrian/src/Settings/Flavours/Quick.hs | 22 -- hadrian/src/Settings/Flavours/QuickCross.hs | 24 -- hadrian/src/Settings/Flavours/Quickest.hs | 23 -- hadrian/src/Settings/Packages/Base.hs | 12 - hadrian/src/Settings/Packages/Cabal.hs | 10 - hadrian/src/Settings/Packages/Compiler.hs | 45 --- hadrian/src/Settings/Packages/Ghc.hs | 13 - hadrian/src/Settings/Packages/GhcCabal.hs | 32 -- hadrian/src/Settings/Packages/GhcPkg.hs | 7 - hadrian/src/Settings/Packages/GhcPrim.hs | 12 - hadrian/src/Settings/Packages/Ghci.hs | 6 - hadrian/src/Settings/Packages/Haddock.hs | 7 - hadrian/src/Settings/Packages/Haskeline.hs | 8 - hadrian/src/Settings/Packages/IntegerGmp.hs | 24 -- hadrian/src/Settings/Packages/Rts.hs | 224 ----------- hadrian/src/Settings/Packages/RunGhc.hs | 9 - hadrian/src/Settings/Warnings.hs | 56 --- hadrian/src/Stage.hs | 31 -- hadrian/src/Target.hs | 26 -- hadrian/src/UserSettings.hs | 64 --- hadrian/src/Utilities.hs | 88 ----- hadrian/src/Way.hs | 162 -------- hadrian/stack.yaml | 25 -- 112 files changed, 8915 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 351c460c6df24d8c0a490eea7e19867d2f1784fd From git at git.haskell.org Mon Dec 11 20:36:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 20:36:39 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Allow users to ignore optimization changes (6fd8629) Message-ID: <20171211203639.D92D63A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/6fd8629dcc9d71bcc00a124ba53de918f3820781/ghc >--------------------------------------------------------------- commit 6fd8629dcc9d71bcc00a124ba53de918f3820781 Author: David Feuer Date: Mon Dec 11 13:03:52 2017 -0500 Allow users to ignore optimization changes * Add a new flag, `-fignore-optim-changes`, allowing them to avoid recompilation if the only changes are to the `-O` level or to flags controlling optimizations. * When `-fignore-optim-changes` is *off*, recompile when optimization flags (e.g., `-fno-full-laziness`) change. Previously, we ignored these unconditionally when deciding whether to recompile a module. Reviewers: austin, bgamari, simonmar Reviewed By: simonmar Subscribers: duog, carter, simonmar, rwbarton, thomie GHC Trac Issues: #13604 Differential Revision: https://phabricator.haskell.org/D4123 (cherry picked from commit 708ed9ca4dbf372817fe84a2fe486940123bddfb) >--------------------------------------------------------------- 6fd8629dcc9d71bcc00a124ba53de918f3820781 compiler/iface/FlagChecker.hs | 67 ++++++++++++++++---- compiler/iface/LoadIface.hs | 2 + compiler/iface/MkIface.hs | 45 ++++++++++++- compiler/main/DynFlags.hs | 73 ++++++++++++++++++++-- compiler/main/HscTypes.hs | 15 ++++- docs/users_guide/8.4.1-notes.rst | 6 ++ docs/users_guide/separate_compilation.rst | 17 +++++ ghc/Main.hs | 12 +++- testsuite/tests/driver/Makefile | 14 +++++ testsuite/tests/driver/T13604.hs | 1 + .../{retc003/retc003.stdout => T13604.stdout} | 2 - testsuite/tests/driver/T13604a.hs | 1 + .../{retc003/retc003.stdout => T13604a.stdout} | 2 - testsuite/tests/driver/T13914/T13914.stdout | 4 +- testsuite/tests/driver/all.T | 2 + testsuite/tests/ghci/scripts/T9293.stdout | 8 +++ testsuite/tests/ghci/scripts/ghci024.stdout | 2 + testsuite/tests/ghci/scripts/ghci057.stdout | 8 +++ testsuite/tests/hpc/T11798.stdout | 2 +- 19 files changed, 254 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 6fd8629dcc9d71bcc00a124ba53de918f3820781 From git at git.haskell.org Mon Dec 11 20:36:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Dec 2017 20:36:36 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: rts: Don't default to single capability when profiled (ce8d8c0) Message-ID: <20171211203636.C35A33A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/ce8d8c01b85ed1ce2e67f46a0fde09012c471d1d/ghc >--------------------------------------------------------------- commit ce8d8c01b85ed1ce2e67f46a0fde09012c471d1d Author: Ben Gamari Date: Mon Dec 11 12:55:31 2017 -0500 rts: Don't default to single capability when profiled This was presumably a vestige of the days when the profiled RTS couldn't run threaded. Fixes #14545. Test Plan: simonmar Reviewers: erikd, simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14545 Differential Revision: https://phabricator.haskell.org/D4245 (cherry picked from commit 4bfff7a507b5807736e9c6ce9814a9cfa60faeff) >--------------------------------------------------------------- ce8d8c01b85ed1ce2e67f46a0fde09012c471d1d rts/RtsFlags.c | 4 ---- 1 file changed, 4 deletions(-) diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index 39b1273..26171cf 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -1289,11 +1289,7 @@ error = true; OPTION_SAFE; THREADED_BUILD_ONLY( if (rts_argv[arg][2] == '\0') { -#if defined(PROFILING) - RtsFlags.ParFlags.nCapabilities = 1; -#else RtsFlags.ParFlags.nCapabilities = getNumberOfProcessors(); -#endif } else { int nCapabilities; OPTION_SAFE; /* but see extra checks below... */ From git at git.haskell.org Tue Dec 12 15:20:29 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Dec 2017 15:20:29 +0000 (UTC) Subject: [commit: ghc] master: Add regression test for #14040 (be1ca0e) Message-ID: <20171212152029.D9E1D3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/be1ca0e439e9d26107c7d82fe6e78b64ee6320a9/ghc >--------------------------------------------------------------- commit be1ca0e439e9d26107c7d82fe6e78b64ee6320a9 Author: Ryan Scott Date: Tue Dec 12 10:16:39 2017 -0500 Add regression test for #14040 This adds a regression test for the original program in #14040. This does not fix #14040 entirely, though, as the program in https://ghc.haskell.org/trac/ghc/ticket/14040#comment:2 still panics, so there is more work to be done there. >--------------------------------------------------------------- be1ca0e439e9d26107c7d82fe6e78b64ee6320a9 .../tests/partial-sigs/should_fail/T14040a.hs | 34 +++++++++++++++ .../tests/partial-sigs/should_fail/T14040a.stderr | 48 ++++++++++++++++++++++ testsuite/tests/partial-sigs/should_fail/all.T | 1 + 3 files changed, 83 insertions(+) diff --git a/testsuite/tests/partial-sigs/should_fail/T14040a.hs b/testsuite/tests/partial-sigs/should_fail/T14040a.hs new file mode 100644 index 0000000..382e218 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T14040a.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +module T14040a where + +import Data.Kind + +data family Sing (a :: k) + +data WeirdList :: Type -> Type where + WeirdNil :: WeirdList a + WeirdCons :: a -> WeirdList (WeirdList a) -> WeirdList a + +data instance Sing (z :: WeirdList a) where + SWeirdNil :: Sing WeirdNil + SWeirdCons :: Sing w -> Sing wws -> Sing (WeirdCons w wws) + +elimWeirdList :: forall (a :: Type) (wl :: WeirdList a) + (p :: forall (x :: Type). x -> WeirdList x -> Type). + Sing wl + -> (forall (y :: Type). p _ WeirdNil) + -> (forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)). + Sing x -> Sing xs -> p _ xs + -> p _ (WeirdCons x xs)) + -> p _ wl +elimWeirdList SWeirdNil pWeirdNil _ = pWeirdNil +elimWeirdList (SWeirdCons (x :: Sing (x :: z)) + (xs :: Sing (xs :: WeirdList (WeirdList z)))) + pWeirdNil pWeirdCons + = pWeirdCons @z @x @xs x xs + (elimWeirdList @(WeirdList z) @xs @p xs pWeirdNil pWeirdCons) diff --git a/testsuite/tests/partial-sigs/should_fail/T14040a.stderr b/testsuite/tests/partial-sigs/should_fail/T14040a.stderr new file mode 100644 index 0000000..b4f0e26 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T14040a.stderr @@ -0,0 +1,48 @@ + +T14040a.hs:21:18: error: + • The kind of variable ‘wl1’, namely ‘WeirdList a1’, + depends on variable ‘a1’ from an inner scope + Perhaps bind ‘wl1’ sometime after binding ‘a1’ + • In the type signature: + elimWeirdList :: forall (a :: Type) + (wl :: WeirdList a) + (p :: forall (x :: Type). x -> WeirdList x -> Type). + Sing wl + -> (forall (y :: Type). p _ WeirdNil) + -> (forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)). + Sing x -> Sing xs -> p _ xs -> p _ (WeirdCons x xs)) + -> p _ wl + +T14040a.hs:34:8: error: + • Cannot apply expression of type ‘Sing wl + -> (forall y. p x0 w0 'WeirdNil) + -> (forall z1 (x :: z1) (xs :: WeirdList (WeirdList z1)). + Sing x + -> Sing xs + -> p (WeirdList z1) w1 xs + -> p z1 w2 ('WeirdCons x xs)) + -> p a w3 wl’ + to a visible type argument ‘(WeirdList z)’ + • In the sixth argument of ‘pWeirdCons’, namely + ‘(elimWeirdList @(WeirdList z) @xs @p xs pWeirdNil pWeirdCons)’ + In the expression: + pWeirdCons + @z + @x + @xs + x + xs + (elimWeirdList @(WeirdList z) @xs @p xs pWeirdNil pWeirdCons) + In an equation for ‘elimWeirdList’: + elimWeirdList + (SWeirdCons (x :: Sing (x :: z)) + (xs :: Sing (xs :: WeirdList (WeirdList z)))) + pWeirdNil + pWeirdCons + = pWeirdCons + @z + @x + @xs + x + xs + (elimWeirdList @(WeirdList z) @xs @p xs pWeirdNil pWeirdCons) diff --git a/testsuite/tests/partial-sigs/should_fail/all.T b/testsuite/tests/partial-sigs/should_fail/all.T index d452dad..bb813f0 100644 --- a/testsuite/tests/partial-sigs/should_fail/all.T +++ b/testsuite/tests/partial-sigs/should_fail/all.T @@ -64,4 +64,5 @@ test('PatBind3', normal, compile_fail, ['']) test('T12039', normal, compile_fail, ['']) test('T12634', normal, compile_fail, ['']) test('T12732', normal, compile_fail, ['-fobject-code -fdefer-typed-holes']) +test('T14040a', normal, compile_fail, ['']) test('T14449', normal, compile_fail, ['']) From git at git.haskell.org Wed Dec 13 12:57:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 12:57:21 +0000 (UTC) Subject: [commit: ghc] master: Tidy up of wired-in names (321b420) Message-ID: <20171213125721.CAB053A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/321b420f4582d103ca7b304867b916a749712e9f/ghc >--------------------------------------------------------------- commit 321b420f4582d103ca7b304867b916a749712e9f Author: Simon Peyton Jones Date: Wed Dec 13 10:49:31 2017 +0000 Tidy up of wired-in names Two things here: * While debugging Trac #14561 I found it hard to understand ghcPrimIds and magicIds in MkId. This patch adds more structure and comments. * I also discovered that ($) no longer needs to be a wiredInId because we now have levity polymorphism. So I took dollarId out of MkId; and gave it a levity-polymorphic type in GHC.Base >--------------------------------------------------------------- 321b420f4582d103ca7b304867b916a749712e9f compiler/basicTypes/MkId.hs | 134 +++++++++++++++++++--------------------- compiler/prelude/PrelNames.hs | 9 +-- libraries/base/GHC/Base.hs | 9 ++- libraries/ghc-prim/GHC/Magic.hs | 4 ++ 4 files changed, 78 insertions(+), 78 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 321b420f4582d103ca7b304867b916a749712e9f From git at git.haskell.org Wed Dec 13 12:57:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 12:57:15 +0000 (UTC) Subject: [commit: ghc] master: Minor refactor of TcExpr.tcApp (a106a20) Message-ID: <20171213125715.64C763A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a106a200892e2ac7953f0929c303d392c8808f89/ghc >--------------------------------------------------------------- commit a106a200892e2ac7953f0929c303d392c8808f89 Author: Simon Peyton Jones Date: Wed Dec 13 10:37:57 2017 +0000 Minor refactor of TcExpr.tcApp This refactoring has no change in behaviour but makes the structure clearer >--------------------------------------------------------------- a106a200892e2ac7953f0929c303d392c8808f89 compiler/typecheck/TcExpr.hs | 124 ++++++++++++++++++++++++------------------- 1 file changed, 70 insertions(+), 54 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 4eb5dd1..80b2b14 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -1143,7 +1143,8 @@ tcApp1 e res_ty mk_hs_app f (HsValArg a) = mkHsApp f a mk_hs_app f (HsTypeArg a) = mkHsAppTypeOut f a -tcApp :: Maybe SDoc -- like "The function `f' is applied to" +tcApp, tcGeneralApp + :: Maybe SDoc -- like "The function `f' is applied to" -- or leave out to get exactly that message -> LHsExpr GhcRn -> [LHsExprArgIn] -- Function and args -> ExpRhoType -> TcM (HsWrapper, LHsExpr GhcTcId, [LHsExprArgOut]) @@ -1152,63 +1153,78 @@ tcApp :: Maybe SDoc -- like "The function `f' is applied to" -- But OpApp is slightly different, so that's why the caller -- must assemble -tcApp m_herald orig_fun orig_args res_ty - = go orig_fun orig_args - where - go :: LHsExpr GhcRn -> [LHsExprArgIn] - -> TcM (HsWrapper, LHsExpr GhcTcId, [LHsExprArgOut]) - go (L _ (HsPar e)) args = go e args - go (L _ (HsApp e1 e2)) args = go e1 (HsValArg e2:args) - go (L _ (HsAppType e t)) args = go e (HsTypeArg t:args) - - go (L loc (HsVar (L _ fun))) args - | fun `hasKey` tagToEnumKey - , count isHsValArg args == 1 - = do { (wrap, expr, args) <- tcTagToEnum loc fun args res_ty - ; return (wrap, expr, args) } - - | fun `hasKey` seqIdKey - , count isHsValArg args == 2 - = do { (wrap, expr, args) <- tcSeq loc fun args res_ty - ; return (wrap, expr, args) } - - go (L loc (HsRecFld (Ambiguous lbl _))) args@(HsValArg (L _ arg) : _) - | Just sig_ty <- obviousSig arg - = do { sig_tc_ty <- tcHsSigWcType ExprSigCtxt sig_ty - ; sel_name <- disambiguateSelector lbl sig_tc_ty - ; go (L loc (HsRecFld (Unambiguous lbl sel_name))) args } - - -- See Note [Visible type application for the empty list constructor] - go (L loc (ExplicitList _ Nothing [])) [HsTypeArg ty_arg] - = do { ty_arg' <- tcHsTypeApp ty_arg liftedTypeKind - ; let list_ty = TyConApp listTyCon [ty_arg'] - ; _ <- tcSubTypeDS (OccurrenceOf nilDataConName) GenSigCtxt - list_ty res_ty - ; let expr :: LHsExpr GhcTcId - expr = L loc $ ExplicitList ty_arg' Nothing [] - ; return (idHsWrapper, expr, []) } - - go fun args - = do { -- Type-check the function - ; (fun1, fun_sigma) <- tcInferFun fun - ; let orig = lexprCtOrigin fun - - ; (wrap_fun, args1, actual_res_ty) - <- tcArgs fun fun_sigma orig args - (m_herald `orElse` mk_app_msg fun args) - - -- this is just like tcWrapResult, but the types don't line - -- up to call that function - ; wrap_res <- addFunResCtxt True (unLoc fun) actual_res_ty res_ty $ - tcSubTypeDS_NC_O orig GenSigCtxt - (Just $ unLoc $ foldl mk_hs_app fun args) - actual_res_ty res_ty - - ; return (wrap_res, mkLHsWrap wrap_fun fun1, args1) } +tcApp m_herald (L _ (HsPar fun)) args res_ty + = tcApp m_herald fun args res_ty + +tcApp m_herald (L _ (HsApp fun arg1)) args res_ty + = tcApp m_herald fun (HsValArg arg1 : args) res_ty + +tcApp m_herald (L _ (HsAppType fun ty1)) args res_ty + = tcApp m_herald fun (HsTypeArg ty1 : args) res_ty + +tcApp m_herald (L loc (HsRecFld fld_lbl)) args res_ty + | Ambiguous lbl _ <- fld_lbl -- Still ambiguous + , HsValArg (L _ arg) : _ <- args -- A value arg is first + , Just sig_ty <- obviousSig arg -- A type sig on the arg disambiguates + = do { sig_tc_ty <- tcHsSigWcType ExprSigCtxt sig_ty + ; sel_name <- disambiguateSelector lbl sig_tc_ty + ; let unambig_fun = L loc (HsRecFld (Unambiguous lbl sel_name)) + ; tcGeneralApp m_herald unambig_fun args res_ty } + +tcApp _ (L loc (HsVar (L _ fun_id))) args res_ty + -- Special typing rule for tagToEnum# + | fun_id `hasKey` tagToEnumKey + , n_val_args == 1 + = do { (wrap, expr, args) <- tcTagToEnum loc fun_id args res_ty + ; return (wrap, expr, args) } + + -- Special typing rule for 'seq' + | fun_id `hasKey` seqIdKey + , n_val_args == 2 + = do { (wrap, expr, args) <- tcSeq loc fun_id args res_ty + ; return (wrap, expr, args) } + where + n_val_args = count isHsValArg args + +tcApp _ (L loc (ExplicitList _ Nothing [])) [HsTypeArg ty_arg] res_ty + -- See Note [Visible type application for the empty list constructor] + = do { ty_arg' <- tcHsTypeApp ty_arg liftedTypeKind + ; let list_ty = TyConApp listTyCon [ty_arg'] + ; _ <- tcSubTypeDS (OccurrenceOf nilDataConName) GenSigCtxt + list_ty res_ty + ; let expr :: LHsExpr GhcTcId + expr = L loc $ ExplicitList ty_arg' Nothing [] + ; return (idHsWrapper, expr, []) } + +tcApp m_herald fun args res_ty + = tcGeneralApp m_herald fun args res_ty + +--------------------- +-- tcGeneralApp deals with the general case; +-- the special cases are handled by tcApp +tcGeneralApp m_herald fun args res_ty + = do { -- Type-check the function + ; (fun1, fun_sigma) <- tcInferFun fun + ; let orig = lexprCtOrigin fun + + ; (wrap_fun, args1, actual_res_ty) + <- tcArgs fun fun_sigma orig args + (m_herald `orElse` mk_app_msg fun args) + + -- this is just like tcWrapResult, but the types don't line + -- up to call that function + ; wrap_res <- addFunResCtxt True (unLoc fun) actual_res_ty res_ty $ + tcSubTypeDS_NC_O orig GenSigCtxt + (Just $ unLoc $ foldl mk_hs_app fun args) + actual_res_ty res_ty + + ; return (wrap_res, mkLHsWrap wrap_fun fun1, args1) } + where mk_hs_app f (HsValArg a) = mkHsApp f a mk_hs_app f (HsTypeArg a) = mkHsAppType f a + mk_app_msg :: LHsExpr GhcRn -> [LHsExprArgIn] -> SDoc mk_app_msg fun args = sep [ text "The" <+> text what <+> quotes (ppr expr) , text "is applied to"] From git at git.haskell.org Wed Dec 13 12:57:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 12:57:18 +0000 (UTC) Subject: [commit: ghc] master: Detect levity-polymorphic uses of unsafeCoerce# (e40db7b) Message-ID: <20171213125718.D2EBC3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e40db7b1676627f5291b463405338e7b69fa3f69/ghc >--------------------------------------------------------------- commit e40db7b1676627f5291b463405338e7b69fa3f69 Author: Simon Peyton Jones Date: Wed Dec 13 10:46:26 2017 +0000 Detect levity-polymorphic uses of unsafeCoerce# This bug was shown up by Trac #14561. The deguarer carefully detects unsaturated and levity-polymorphic uses of primops, but not of things like unsafeCoerce#. The fix is simple: see Note [Levity-polymorphic Ids] in Id. >--------------------------------------------------------------- e40db7b1676627f5291b463405338e7b69fa3f69 compiler/basicTypes/Id.hs | 26 +++++++++++++++++++--- compiler/deSugar/DsExpr.hs | 3 ++- testsuite/tests/polykinds/T14561.hs | 18 +++++++++++++++ .../T5472.stdout => polykinds/T14561.stderr} | 0 testsuite/tests/polykinds/all.T | 1 + 5 files changed, 44 insertions(+), 4 deletions(-) diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index 63ca38c..fbece0e 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -119,7 +119,8 @@ module Id ( import GhcPrelude import DynFlags -import CoreSyn ( CoreRule, isStableUnfolding, evaldUnfolding, Unfolding( NoUnfolding ) ) +import CoreSyn ( CoreRule, isStableUnfolding, evaldUnfolding, + isCompulsoryUnfolding, Unfolding( NoUnfolding ) ) import IdInfo import BasicTypes @@ -519,7 +520,8 @@ hasNoBinding id = case Var.idDetails id of PrimOpId _ -> True -- See Note [Primop wrappers] FCallId _ -> True DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc - _ -> False + _ -> isCompulsoryUnfolding (idUnfolding id) + -- See Note [Levity-polymorphic Ids] isImplicitId :: Id -> Bool -- ^ 'isImplicitId' tells whether an 'Id's info is implied by other @@ -541,7 +543,25 @@ isImplicitId id idIsFrom :: Module -> Id -> Bool idIsFrom mod id = nameIsLocalOrFrom mod (idName id) -{- +{- Note [Levity-polymorphic Ids] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Some levity-polymorphic Ids must be applied and and inlined, not left +un-saturated. Example: + unsafeCoerceId :: forall r1 r2 (a::TYPE r1) (b::TYPE r2). a -> b + +This has a compulsory unfolding because we can't lambda-bind those +arguments. But the compulsory unfolding may leave levity-polymorphic +lambdas if it is not applied to enough arguments; e.g. (Trac #14561) + bad :: forall (a :: TYPE r). a -> a + bad = unsafeCoerce# + +The desugar has special magic to detect such cases: DsExpr.badUseOfLevPolyPrimop. +And we want that magic to apply to levity-polymorphic compulsory-inline things. +The easiest way to do this is for hasNoBinding to return True of all things +that have compulsory unfolding. A very Ids with a compulsory unfolding also +have a binding, but it does not harm to say they don't here, and its a very +simple way to fix Trac #14561. + Note [Primop wrappers] ~~~~~~~~~~~~~~~~~~~~~~ Currently hasNoBinding claims that PrimOpIds don't have a curried diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index 635a9c6..2f3739e 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -260,7 +260,8 @@ ds_expr _ (HsLit lit) = dsLit (convertLit lit) ds_expr _ (HsOverLit lit) = dsOverLit lit ds_expr _ (HsWrap co_fn e) - = do { e' <- ds_expr True e + = do { e' <- ds_expr True e -- This is the one place where we recurse to + -- ds_expr (passing True), rather than dsExpr ; wrap' <- dsHsWrapper co_fn ; dflags <- getDynFlags ; let wrapped_e = wrap' e' diff --git a/testsuite/tests/polykinds/T14561.hs b/testsuite/tests/polykinds/T14561.hs new file mode 100644 index 0000000..f528e7c --- /dev/null +++ b/testsuite/tests/polykinds/T14561.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MagicHash #-} + +module T14561 where + +import GHC.Types +import GHC.Prim + +badId :: forall (a :: TYPE r). a -> a +badId = unsafeCoerce# +-- Un-saturated application of a levity-polymorphic +-- function that must be eta-expanded + +goodId :: forall (a :: Type). a -> a +goodId = unsafeCoerce# +-- But this one is OK diff --git a/testsuite/tests/deSugar/should_run/T5472.stdout b/testsuite/tests/polykinds/T14561.stderr similarity index 100% copy from testsuite/tests/deSugar/should_run/T5472.stdout copy to testsuite/tests/polykinds/T14561.stderr diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 8a03e89..8d0abff 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -180,4 +180,5 @@ test('T14520', normal, compile_fail, ['']) test('T11203', normal, compile_fail, ['']) test('T14555', normal, compile_fail, ['']) test('T14563', normal, compile_fail, ['']) +test('T14561', normal, compile_fail, ['']) From git at git.haskell.org Wed Dec 13 15:57:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 15:57:13 +0000 (UTC) Subject: [commit: ghc] master: Add missing stderr for Trac #14561 (aef4dee) Message-ID: <20171213155713.930493A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aef4dee8d2b2bffdaa955a65e967bfe9f07a8d0c/ghc >--------------------------------------------------------------- commit aef4dee8d2b2bffdaa955a65e967bfe9f07a8d0c Author: Simon Peyton Jones Date: Wed Dec 13 15:56:41 2017 +0000 Add missing stderr for Trac #14561 >--------------------------------------------------------------- aef4dee8d2b2bffdaa955a65e967bfe9f07a8d0c testsuite/tests/polykinds/T14561.stderr | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/testsuite/tests/polykinds/T14561.stderr b/testsuite/tests/polykinds/T14561.stderr index 0519ecb..d39dec4 100644 --- a/testsuite/tests/polykinds/T14561.stderr +++ b/testsuite/tests/polykinds/T14561.stderr @@ -1 +1,5 @@ +T14561.hs:12:9: error: + Cannot use primitive with levity-polymorphic arguments: + unsafeCoerce# :: a -> a + Levity-polymorphic arguments: a :: TYPE r From git at git.haskell.org Wed Dec 13 16:02:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 16:02:42 +0000 (UTC) Subject: [commit: ghc] master: Re-centre perf for T5321Fun (63e968a) Message-ID: <20171213160242.1A77D3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/63e968a9dd915fc0f5819589b6830603f563902f/ghc >--------------------------------------------------------------- commit 63e968a9dd915fc0f5819589b6830603f563902f Author: Simon Peyton Jones Date: Wed Dec 13 16:00:14 2017 +0000 Re-centre perf for T5321Fun Bytes allocated has fallen by around 5%. I think this due to some of my recent refactoring of the typechecker, but I'm not certain about exactly which change did it. Good though! >--------------------------------------------------------------- 63e968a9dd915fc0f5819589b6830603f563902f testsuite/tests/perf/compiler/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index aa53d98..390e126 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -545,7 +545,7 @@ test('T5321Fun', # 2016-04-06: 279922360 x86/Linux # 2017-03-24: 244387620 x86/Linux (64-bit machine) - (wordsize(64), 449577856, 5)]) + (wordsize(64), 423774560, 5)]) # prev: 585521080 # 2012-08-29: 713385808 # (increase due to new codegen) # 2013-05-15: 628341952 # (reason for decrease unknown) @@ -572,6 +572,7 @@ test('T5321Fun', # 2017-02-23: 524706256 # Type-indexed Typeable? (on Darwin) # 2017-02-25: 488295304 # Early inlining patch # 2017-05-14: 449577856 # (amd64/Linxu) Two-pass CmmLayoutStack + # 2017-12-13: 423774560 # (amd64/Linxu) Typechecker improvements ], compile,['']) From git at git.haskell.org Wed Dec 13 16:45:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 16:45:33 +0000 (UTC) Subject: [commit: ghc] master: Further improvements to well-kinded types (0a12d92) Message-ID: <20171213164533.2D7763A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0a12d92a8f65d374f9317af2759af2b46267ad5c/ghc >--------------------------------------------------------------- commit 0a12d92a8f65d374f9317af2759af2b46267ad5c Author: Simon Peyton Jones Date: Wed Dec 13 12:53:26 2017 +0000 Further improvements to well-kinded types The typechecker has the invariant that every type should be well-kinded as it stands, without zonking. See Note [The well-kinded type invariant] in TcType. That invariant was not being upheld, which led to Trac #14174. I fixed part of it, but T14174a showed that there was more. This patch finishes the job. * See Note [The tcType invariant] in TcHsType, which articulates an invariant that was very nearly, but not quite, true. One place that falisified it was the HsWildCardTy case of tc_hs_type, so I fixed that. * mkNakedCastTy now makes no attempt to eliminate casts; indeed it cannot lest it break Note [The well-kinded type invariant]. The prior comment suggested that it was crucial for performance but happily it seems not to be. The extra Refls are eliminated by the zonker. * I found I could tidy up TcHsType.instantiateTyN and instantiateTyUntilN by eliminating one of its parameters. That led to a cascade of minor improvements in TcTyClsDecls. Hooray. >--------------------------------------------------------------- 0a12d92a8f65d374f9317af2759af2b46267ad5c compiler/typecheck/TcHsType.hs | 144 +++++++++++---------- compiler/typecheck/TcTyClsDecls.hs | 43 +++--- compiler/typecheck/TcType.hs | 49 +++++-- testsuite/tests/polykinds/T7524.stderr | 2 +- testsuite/tests/polykinds/all.T | 2 +- .../typecheck/should_fail/T6018failclosed.stderr | 4 +- 6 files changed, 138 insertions(+), 106 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 0a12d92a8f65d374f9317af2759af2b46267ad5c From git at git.haskell.org Wed Dec 13 21:32:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 21:32:08 +0000 (UTC) Subject: [commit: ghc] wip/T14373: Implement pointer tagging for 'big' families #14373 (e0fbfab) Message-ID: <20171213213208.DF6663A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/e0fbfabf807272d090259278e51aec8d938c6f74/ghc >--------------------------------------------------------------- commit e0fbfabf807272d090259278e51aec8d938c6f74 Author: Gabor Greif Date: Fri Oct 20 15:45:37 2017 +0200 Implement pointer tagging for 'big' families #14373 Formerly we punted on these and evaluated constructors always got a tag of 1. We now cascade switches because we have to check the tag first and when it is MAX_PTR_TAG then get the precise tag from the info table and switch on that. The only technically tricky part is that the default case needs (logical) duplication. To do this we emit an extra label for it and branch to that from the second switch. This avoids duplicated codegen. >--------------------------------------------------------------- e0fbfabf807272d090259278e51aec8d938c6f74 compiler/codeGen/StgCmmClosure.hs | 11 +++++-- compiler/codeGen/StgCmmExpr.hs | 67 ++++++++++++++++++++++++++++++--------- 2 files changed, 60 insertions(+), 18 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 2501ec9..ce0f623 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -354,9 +354,12 @@ type DynTag = Int -- The tag on a *pointer* -- * big, otherwise. -- -- Small families can have the constructor tag in the tag bits. --- Big families only use the tag value 1 to represent evaluatedness. +-- Big families always use the tag values 1..mAX_PTR_TAG to represent +-- evaluatedness, the last one lumping together all overflowing ones. -- We don't have very many tag bits: for example, we have 2 bits on -- x86-32 and 3 bits on x86-64. +-- +-- Also see Note [tagging big families] isSmallFamily :: DynFlags -> Int -> Bool isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags @@ -369,10 +372,12 @@ isSmallFamilyTyCon dflags tycon = tagForCon :: DynFlags -> DataCon -> DynTag tagForCon dflags con | isSmallFamilyTyCon dflags tycon = con_tag - | otherwise = 1 + | con_tag <= max_tag = con_tag + | otherwise = max_tag where - con_tag = dataConTag con -- NB: 1-indexed + con_tag = dataConTag con -- NB: 1-indexed tycon = dataConTyCon con + max_tag = mAX_PTR_TAG dflags tagForArity :: DynFlags -> RepArity -> DynTag tagForArity dflags arity diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 3fcc935..6c00cef 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -37,6 +37,7 @@ import Cmm import CmmInfo import CoreSyn import DataCon +import DynFlags ( mAX_PTR_TAG ) import ForeignCall import Id import PrimOp @@ -49,9 +50,10 @@ import Util import FastString import Outputable -import Control.Monad (unless,void) -import Control.Arrow (first) +import Control.Monad ( unless, void ) +import Control.Arrow ( first ) import Data.Function ( on ) +import Data.List ( partition ) ------------------------------------------------------------------------ -- cgExpr: the main function @@ -607,21 +609,36 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts ; let fam_sz = tyConFamilySize tycon bndr_reg = CmmLocal (idToReg dflags bndr) + tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg) + branches' = [(tag+1,branch) | (tag,branch) <- branches] + maxpt = mAX_PTR_TAG dflags + (ptr, info) = partition ((< maxpt) . fst) branches' + small = isSmallFamily dflags fam_sz -- Is the constructor tag in the node reg? - ; if isSmallFamily dflags fam_sz - then do - let -- Yes, bndr_reg has constr. tag in ls bits - tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg) - branches' = [(tag+1,branch) | (tag,branch) <- branches] - emitSwitch tag_expr branches' mb_deflt 1 fam_sz - - else -- No, get tag from info table - let -- Note that ptr _always_ has tag 1 - -- when the family size is big enough - untagged_ptr = cmmRegOffB bndr_reg (-1) - tag_expr = getConstrTag dflags (untagged_ptr) - in emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1) + -- See Note [tagging big families] + ; if small || null info + then -- Yes, bndr_reg has constr. tag in ls bits + emitSwitch tag_expr branches' mb_deflt 1 (if small then fam_sz else maxpt) + + else -- No, get exact tag from info table when mAX_PTR_TAG + do + infos_lbl <- newBlockId -- branch destination for info pointer lookup + infos_scp <- getTickScope + + let catchall = (maxpt, (mkBranch infos_lbl, infos_scp)) + prelabel (Just (stmts, scp)) = + do lbl <- newBlockId + return (Just (mkLabel lbl scp <*> stmts, scp), Just (mkBranch lbl, scp)) + prelabel _ = return (Nothing, Nothing) + + (mb_deflt, mb_branch) <- prelabel mb_deflt + emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt + emitLabel infos_lbl + let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) + tag_expr = getConstrTag dflags untagged_ptr + info0 = (\(tag,branch)->(tag-1,branch)) <$> info + emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1) ; return AssignedDirectly } @@ -649,6 +666,26 @@ cgAlts _ _ _ _ = panic "cgAlts" -- x = R1 -- goto L1 + +-- Note [tagging big families] +-- +-- Previousy, only the small constructor families were tagged. +-- This penalized greater unions which overflow the tag space +-- of TAG_BITS (i.e. 3 on 32 resp. 7 constructors on 64 bit). +-- But there is a clever way of combining pointer and info-table +-- tagging. We now use 1..{2,6} as pointer-resident tags while +-- {3,7} signifies we have to fall back and get the tag from the +-- info-table. +-- Conseqently we now cascade switches because we have to check +-- the tag first and when it is MAX_PTR_TAG then get the precise +-- tag from the info table and switch on that. The only technically +-- tricky part is that the default case needs (logical) duplication. +-- To do this we emit an extra label for it and branch to that from +-- the second switch. This avoids duplicated codegen. +-- +-- Also see Note [Data constructor dynamic tags] + + ------------------- cgAlgAltRhss :: (GcPlan,ReturnKind) -> NonVoid Id -> [StgAlt] -> FCode ( Maybe CmmAGraphScoped From git at git.haskell.org Wed Dec 13 21:32:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 21:32:11 +0000 (UTC) Subject: [commit: ghc] wip/T14373: less debugging (41ab5aa) Message-ID: <20171213213211.B95383A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/41ab5aa66e1affd2640cd1aa76cb262e95599e91/ghc >--------------------------------------------------------------- commit 41ab5aa66e1affd2640cd1aa76cb262e95599e91 Author: Gabor Greif Date: Wed Dec 13 16:11:10 2017 +0100 less debugging >--------------------------------------------------------------- 41ab5aa66e1affd2640cd1aa76cb262e95599e91 compiler/stgSyn/CoreToStg.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs index bd4f1a6..573560a 100644 --- a/compiler/stgSyn/CoreToStg.hs +++ b/compiler/stgSyn/CoreToStg.hs @@ -547,7 +547,7 @@ coreToStgApp _ f args ticks = do | otherwise = stgUnsatOcc -- Unsaturated function or thunk res_ty = exprType (mkApps (Var f) args) - app = case traceShowId $ idDetails f of + app = case {-traceShowId $-} idDetails f of DataConWorkId dc | saturated -> StgConApp dc args' (dropRuntimeRepArgs (fromMaybe [] (tyConAppArgs_maybe res_ty))) From git at git.haskell.org Wed Dec 13 21:32:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 21:32:17 +0000 (UTC) Subject: [commit: ghc] wip/T14373: join *after* the second switch (ba28c54) Message-ID: <20171213213217.4427A3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/ba28c54db4890ce44c37ee327eedcc827501efbc/ghc >--------------------------------------------------------------- commit ba28c54db4890ce44c37ee327eedcc827501efbc Author: Gabor Greif Date: Wed Dec 13 15:50:17 2017 +0100 join *after* the second switch >--------------------------------------------------------------- ba28c54db4890ce44c37ee327eedcc827501efbc compiler/codeGen/StgCmmExpr.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 6c00cef..21b8045 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -634,11 +634,14 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts (mb_deflt, mb_branch) <- prelabel mb_deflt emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt + join_lbl <- newBlockId + emit (mkBranch join_lbl) emitLabel infos_lbl let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) tag_expr = getConstrTag dflags untagged_ptr info0 = (\(tag,branch)->(tag-1,branch)) <$> info emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1) + emitLabel join_lbl ; return AssignedDirectly } From git at git.haskell.org Wed Dec 13 21:32:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 21:32:14 +0000 (UTC) Subject: [commit: ghc] wip/T14373: debugging... (172b555) Message-ID: <20171213213214.7ED743A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/172b5555a89a3b664cea2a623411bc5d29d3e9e5/ghc >--------------------------------------------------------------- commit 172b5555a89a3b664cea2a623411bc5d29d3e9e5 Author: Gabor Greif Date: Thu Dec 7 17:25:19 2017 +0100 debugging... >--------------------------------------------------------------- 172b5555a89a3b664cea2a623411bc5d29d3e9e5 compiler/stgSyn/CoreToStg.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs index 900c52e..bd4f1a6 100644 --- a/compiler/stgSyn/CoreToStg.hs +++ b/compiler/stgSyn/CoreToStg.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns, CPP, MagicHash #-} -- -- (c) The GRASP/AQUA Project, Glasgow University, 1993-1998 @@ -49,6 +49,13 @@ import UniqFM import Data.Maybe (isJust, fromMaybe) import Control.Monad (liftM, ap) +import Debug.Trace (traceShowId) +import GHC.Base (getTag) +import GHC.Exts (Int(..)) + + +instance Show IdDetails where + show !det = "## we have an IdDetails with tag " ++ show (I# (getTag det)) -- Note [Live vs free] -- ~~~~~~~~~~~~~~~~~~~ @@ -540,7 +547,7 @@ coreToStgApp _ f args ticks = do | otherwise = stgUnsatOcc -- Unsaturated function or thunk res_ty = exprType (mkApps (Var f) args) - app = case idDetails f of + app = case traceShowId $ idDetails f of DataConWorkId dc | saturated -> StgConApp dc args' (dropRuntimeRepArgs (fromMaybe [] (tyConAppArgs_maybe res_ty))) From git at git.haskell.org Wed Dec 13 21:32:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 21:32:19 +0000 (UTC) Subject: [commit: ghc] wip/T14373's head updated: less debugging (41ab5aa) Message-ID: <20171213213219.C99043A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T14373' now includes: 1acb922 Make the Con and Con' patterns produce evidence cfea745 template-haskell: Rip out FamFlavour 595f60f Fix ghc_packages d6fccfb Bump version to 8.5 30d6373 rts: fix filename case for mingw32 target 1ecbe9c utils/hsc2hs: update submodule 5f332e1 Forward-port changes from GHC 8.2 branch fa29df0 Refactor ConDecl: Trac #14529 e4a1f03 Revert accidental hsc2hs submodule downgrade de20440 Refactor kcHsTyVarBndrs 800009d Improve LiberateCase 5695f46 Occurrrence analysis improvements for NOINLINE functions 7733e44 Rip out hadrian subtree 4335c07 Add hadrian as a submodule 716acbb Improved panic message for zonkTcTyVarToTyVar 8b36ed1 Build only well-kinded types in type checker 8361b2c Fix SigTvs at the kind level abd5db6 Only look for locales of the form LL.VV 21be5bd Fixed misprint 'aqcuired' 6847c6b Improve Control.Monad.guard and Control.Monad.MonadPlus docs 00d7132 Add information about irrefutable pattern Syntax to XStrict. 21cdfe5 Add NOINLINE pragma to hPutStr' 4bfff7a rts: Don't default to single capability when profiled cafe983 Always use the safe open() call 708ed9c Allow users to ignore optimization changes 430d1f6 fdReady: Use C99 bools / CBool in signature 9d29925 base: fdReady(): Return only after sycall returns after `msecs` have passed be1ca0e Add regression test for #14040 a106a20 Minor refactor of TcExpr.tcApp e40db7b Detect levity-polymorphic uses of unsafeCoerce# 321b420 Tidy up of wired-in names aef4dee Add missing stderr for Trac #14561 63e968a Re-centre perf for T5321Fun 0a12d92 Further improvements to well-kinded types e0fbfab Implement pointer tagging for 'big' families #14373 172b555 debugging... ba28c54 join *after* the second switch 41ab5aa less debugging From git at git.haskell.org Wed Dec 13 21:59:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 21:59:39 +0000 (UTC) Subject: [commit: ghc] master: Typofix in comment (6eb3257) Message-ID: <20171213215939.B750B3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6eb32579478fb9b2c5b0227aabcd18a9caf37bb5/ghc >--------------------------------------------------------------- commit 6eb32579478fb9b2c5b0227aabcd18a9caf37bb5 Author: Gabor Greif Date: Wed Dec 13 22:59:03 2017 +0100 Typofix in comment >--------------------------------------------------------------- 6eb32579478fb9b2c5b0227aabcd18a9caf37bb5 compiler/coreSyn/CoreUtils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index 55bd9e5..21fc65d 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -182,7 +182,7 @@ isExprLevPoly = go Note [Type bindings] ~~~~~~~~~~~~~~~~~~~~ Core does allow type bindings, although such bindings are -not much used, except in the output of the desuguarer. +not much used, except in the output of the desugarer. Example: let a = Int in (\x:a. x) Given this, exprType must be careful to substitute 'a' in the From git at git.haskell.org Wed Dec 13 22:32:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 22:32:34 +0000 (UTC) Subject: [commit: ghc] wip/T14373: Implement pointer tagging for 'big' families #14373 (6ef8e9e) Message-ID: <20171213223234.D5FD93A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/6ef8e9e2c058f7e4ef5e3472a78b5cf13946ae2e/ghc >--------------------------------------------------------------- commit 6ef8e9e2c058f7e4ef5e3472a78b5cf13946ae2e Author: Gabor Greif Date: Fri Oct 20 15:45:37 2017 +0200 Implement pointer tagging for 'big' families #14373 Formerly we punted on these and evaluated constructors always got a tag of 1. We now cascade switches because we have to check the tag first and when it is MAX_PTR_TAG then get the precise tag from the info table and switch on that. The only technically tricky part is that the default case needs (logical) duplication. To do this we emit an extra label for it and branch to that from the second switch. This avoids duplicated codegen. >--------------------------------------------------------------- 6ef8e9e2c058f7e4ef5e3472a78b5cf13946ae2e compiler/codeGen/StgCmmClosure.hs | 11 +++++-- compiler/codeGen/StgCmmExpr.hs | 67 ++++++++++++++++++++++++++++++--------- 2 files changed, 60 insertions(+), 18 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 2501ec9..ce0f623 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -354,9 +354,12 @@ type DynTag = Int -- The tag on a *pointer* -- * big, otherwise. -- -- Small families can have the constructor tag in the tag bits. --- Big families only use the tag value 1 to represent evaluatedness. +-- Big families always use the tag values 1..mAX_PTR_TAG to represent +-- evaluatedness, the last one lumping together all overflowing ones. -- We don't have very many tag bits: for example, we have 2 bits on -- x86-32 and 3 bits on x86-64. +-- +-- Also see Note [tagging big families] isSmallFamily :: DynFlags -> Int -> Bool isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags @@ -369,10 +372,12 @@ isSmallFamilyTyCon dflags tycon = tagForCon :: DynFlags -> DataCon -> DynTag tagForCon dflags con | isSmallFamilyTyCon dflags tycon = con_tag - | otherwise = 1 + | con_tag <= max_tag = con_tag + | otherwise = max_tag where - con_tag = dataConTag con -- NB: 1-indexed + con_tag = dataConTag con -- NB: 1-indexed tycon = dataConTyCon con + max_tag = mAX_PTR_TAG dflags tagForArity :: DynFlags -> RepArity -> DynTag tagForArity dflags arity diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 3fcc935..6c00cef 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -37,6 +37,7 @@ import Cmm import CmmInfo import CoreSyn import DataCon +import DynFlags ( mAX_PTR_TAG ) import ForeignCall import Id import PrimOp @@ -49,9 +50,10 @@ import Util import FastString import Outputable -import Control.Monad (unless,void) -import Control.Arrow (first) +import Control.Monad ( unless, void ) +import Control.Arrow ( first ) import Data.Function ( on ) +import Data.List ( partition ) ------------------------------------------------------------------------ -- cgExpr: the main function @@ -607,21 +609,36 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts ; let fam_sz = tyConFamilySize tycon bndr_reg = CmmLocal (idToReg dflags bndr) + tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg) + branches' = [(tag+1,branch) | (tag,branch) <- branches] + maxpt = mAX_PTR_TAG dflags + (ptr, info) = partition ((< maxpt) . fst) branches' + small = isSmallFamily dflags fam_sz -- Is the constructor tag in the node reg? - ; if isSmallFamily dflags fam_sz - then do - let -- Yes, bndr_reg has constr. tag in ls bits - tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg) - branches' = [(tag+1,branch) | (tag,branch) <- branches] - emitSwitch tag_expr branches' mb_deflt 1 fam_sz - - else -- No, get tag from info table - let -- Note that ptr _always_ has tag 1 - -- when the family size is big enough - untagged_ptr = cmmRegOffB bndr_reg (-1) - tag_expr = getConstrTag dflags (untagged_ptr) - in emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1) + -- See Note [tagging big families] + ; if small || null info + then -- Yes, bndr_reg has constr. tag in ls bits + emitSwitch tag_expr branches' mb_deflt 1 (if small then fam_sz else maxpt) + + else -- No, get exact tag from info table when mAX_PTR_TAG + do + infos_lbl <- newBlockId -- branch destination for info pointer lookup + infos_scp <- getTickScope + + let catchall = (maxpt, (mkBranch infos_lbl, infos_scp)) + prelabel (Just (stmts, scp)) = + do lbl <- newBlockId + return (Just (mkLabel lbl scp <*> stmts, scp), Just (mkBranch lbl, scp)) + prelabel _ = return (Nothing, Nothing) + + (mb_deflt, mb_branch) <- prelabel mb_deflt + emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt + emitLabel infos_lbl + let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) + tag_expr = getConstrTag dflags untagged_ptr + info0 = (\(tag,branch)->(tag-1,branch)) <$> info + emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1) ; return AssignedDirectly } @@ -649,6 +666,26 @@ cgAlts _ _ _ _ = panic "cgAlts" -- x = R1 -- goto L1 + +-- Note [tagging big families] +-- +-- Previousy, only the small constructor families were tagged. +-- This penalized greater unions which overflow the tag space +-- of TAG_BITS (i.e. 3 on 32 resp. 7 constructors on 64 bit). +-- But there is a clever way of combining pointer and info-table +-- tagging. We now use 1..{2,6} as pointer-resident tags while +-- {3,7} signifies we have to fall back and get the tag from the +-- info-table. +-- Conseqently we now cascade switches because we have to check +-- the tag first and when it is MAX_PTR_TAG then get the precise +-- tag from the info table and switch on that. The only technically +-- tricky part is that the default case needs (logical) duplication. +-- To do this we emit an extra label for it and branch to that from +-- the second switch. This avoids duplicated codegen. +-- +-- Also see Note [Data constructor dynamic tags] + + ------------------- cgAlgAltRhss :: (GcPlan,ReturnKind) -> NonVoid Id -> [StgAlt] -> FCode ( Maybe CmmAGraphScoped From git at git.haskell.org Wed Dec 13 22:32:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 22:32:39 +0000 (UTC) Subject: [commit: ghc] wip/T14373's head updated: join *after* the second switch (9186d7b) Message-ID: <20171213223239.F10323A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T14373' now includes: 6eb3257 Typofix in comment 6ef8e9e Implement pointer tagging for 'big' families #14373 9186d7b join *after* the second switch From git at git.haskell.org Wed Dec 13 22:32:37 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Dec 2017 22:32:37 +0000 (UTC) Subject: [commit: ghc] wip/T14373: join *after* the second switch (9186d7b) Message-ID: <20171213223237.AEE053A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/9186d7bc5ba6516024b5b0f646fc75bbf89dab2e/ghc >--------------------------------------------------------------- commit 9186d7bc5ba6516024b5b0f646fc75bbf89dab2e Author: Gabor Greif Date: Wed Dec 13 15:50:17 2017 +0100 join *after* the second switch >--------------------------------------------------------------- 9186d7bc5ba6516024b5b0f646fc75bbf89dab2e compiler/codeGen/StgCmmExpr.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 6c00cef..21b8045 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -634,11 +634,14 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts (mb_deflt, mb_branch) <- prelabel mb_deflt emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt + join_lbl <- newBlockId + emit (mkBranch join_lbl) emitLabel infos_lbl let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) tag_expr = getConstrTag dflags untagged_ptr info0 = (\(tag,branch)->(tag-1,branch)) <$> info emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1) + emitLabel join_lbl ; return AssignedDirectly } From git at git.haskell.org Thu Dec 14 11:39:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 11:39:56 +0000 (UTC) Subject: [commit: ghc] master: Add test for Trac #14580 (6f6d105) Message-ID: <20171214113956.02C0D3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f6d1050d96e6697cc4559eb54d03959efe28de1/ghc >--------------------------------------------------------------- commit 6f6d1050d96e6697cc4559eb54d03959efe28de1 Author: Simon Peyton Jones Date: Thu Dec 14 11:39:19 2017 +0000 Add test for Trac #14580 >--------------------------------------------------------------- 6f6d1050d96e6697cc4559eb54d03959efe28de1 testsuite/tests/polykinds/T14580.hs | 8 ++++++++ testsuite/tests/polykinds/T14580.stderr | 6 ++++++ testsuite/tests/polykinds/all.T | 1 + 3 files changed, 15 insertions(+) diff --git a/testsuite/tests/polykinds/T14580.hs b/testsuite/tests/polykinds/T14580.hs new file mode 100644 index 0000000..6d11d78 --- /dev/null +++ b/testsuite/tests/polykinds/T14580.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE PolyKinds, DataKinds, TypeInType, TypeOperators #-} +module T14580 where +import Data.Kind + +type Cat ob = ob -> ob -> Type +data ISO' :: Cat i -> i -> i -> Type +type ISO cat a b = ISO' cat a b -> Type +type (a <--> b) iso cat = ISO (iso :: cat a b) diff --git a/testsuite/tests/polykinds/T14580.stderr b/testsuite/tests/polykinds/T14580.stderr new file mode 100644 index 0000000..babbb49 --- /dev/null +++ b/testsuite/tests/polykinds/T14580.stderr @@ -0,0 +1,6 @@ + +T14580.hs:8:31: error: + • Expected kind ‘Cat a’, but ‘(iso :: cat a b)’ has kind ‘cat a b’ + • In the first argument of ‘ISO’, namely ‘(iso :: cat a b)’ + In the type ‘ISO (iso :: cat a b)’ + In the type declaration for ‘<-->’ diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 4c4d01b..89ebc2a 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -181,4 +181,5 @@ test('T11203', normal, compile_fail, ['']) test('T14555', normal, compile_fail, ['']) test('T14563', normal, compile_fail, ['']) test('T14561', normal, compile_fail, ['']) +test('T14580', normal, compile_fail, ['']) From git at git.haskell.org Thu Dec 14 13:28:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 13:28:15 +0000 (UTC) Subject: [commit: ghc] master: Better tc-trace messages (fa1afcd) Message-ID: <20171214132815.567D33A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fa1afcde4a3f9caaa0ac37e94f1d8fa3e624405f/ghc >--------------------------------------------------------------- commit fa1afcde4a3f9caaa0ac37e94f1d8fa3e624405f Author: Simon Peyton Jones Date: Thu Dec 14 13:27:52 2017 +0000 Better tc-trace messages >--------------------------------------------------------------- fa1afcde4a3f9caaa0ac37e94f1d8fa3e624405f compiler/typecheck/TcHsType.hs | 10 ++++------ compiler/typecheck/TcTyClsDecls.hs | 14 +++++++++----- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index bf08b7e..a9e8afd 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -840,8 +840,10 @@ tcInferApps :: TcTyMode -> [LHsType GhcRn] -- ^ Args -> TcM (TcType, [TcType], TcKind) -- ^ (f args, args, result kind) tcInferApps mode mb_kind_info orig_hs_ty fun_ty fun_ki orig_hs_args - = do { traceTc "tcInferApps" (ppr orig_hs_ty $$ ppr orig_hs_args $$ ppr fun_ki) - ; go 1 [] empty_subst fun_ty orig_ki_binders orig_inner_ki orig_hs_args } + = do { traceTc "tcInferApps {" (ppr orig_hs_ty $$ ppr orig_hs_args $$ ppr fun_ki) + ; stuff <- go 1 [] empty_subst fun_ty orig_ki_binders orig_inner_ki orig_hs_args + ; traceTc "tcInferApps }" empty + ; return stuff } where empty_subst = mkEmptyTCvSubst $ mkInScopeSet $ tyCoVarsOfType fun_ki @@ -877,10 +879,6 @@ tcInferApps mode mb_kind_info orig_hs_ty fun_ty fun_ki orig_hs_args , ppr subst ]) ; arg' <- addErrCtxt (funAppCtxt orig_hs_ty arg n) $ tc_lhs_type mode arg (substTy subst $ tyBinderType ki_binder) - ; traceTc "tcInferApps (vis2)" (vcat [ ppr ki_binder, ppr arg - , ppr arg', ppr (typeKind arg') - , ppr (substTy subst $ tyBinderType ki_binder) - , ppr subst ]) ; let subst' = extendTvSubstBinderAndInScope subst ki_binder arg' ; go (n+1) (arg' : acc_args) subst' (mkNakedAppTy fun arg') ki_binders inner_ki args } diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 113fb9d..00f23f9 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -152,7 +152,7 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds = do { let role_annots = mkRoleAnnotEnv roles -- Step 1: Typecheck the type/class declarations - ; traceTc "-------- tcTyClGroup ------------" empty + ; traceTc "---- tcTyClGroup ---- {" empty ; traceTc "Decls for" (ppr (map (tcdName . unLoc) tyclds)) ; tyclss <- tcTyClDecls tyclds role_annots @@ -172,6 +172,8 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds ; mapM_ (recoverM (return ()) . checkValidRoleAnnots role_annots) tyclss -- See Note [Check role annotations in a second pass] + ; traceTc "---- end tcTyClGroup ---- }" empty + -- Step 3: Add the implicit things; -- we want them in the environment because -- they may be mentioned in interface files @@ -379,7 +381,7 @@ kcTyClGroup :: [LTyClDecl GhcRn] -> TcM [TcTyCon] -- the arity kcTyClGroup decls = do { mod <- getModule - ; traceTc "kcTyClGroup" (text "module" <+> ppr mod $$ vcat (map ppr decls)) + ; traceTc "---- kcTyClGroup ---- {" (text "module" <+> ppr mod $$ vcat (map ppr decls)) -- Kind checking; -- 1. Bind kind variables for decls @@ -403,7 +405,7 @@ kcTyClGroup decls -- Now we have to kind generalize the flexis ; res <- concatMapM (generaliseTCD (tcl_env lcl_env)) decls - ; traceTc "kcTyClGroup result" (vcat (map pp_res res)) + ; traceTc "---- kcTyClGroup end ---- }" (vcat (map pp_res res)) ; return res } where @@ -807,8 +809,10 @@ tcTyClDecl roles_info (L loc decl) | otherwise = setSrcSpan loc $ tcAddDeclCtxt decl $ - do { traceTc "tcTyAndCl-x" (ppr decl) - ; tcTyClDecl1 Nothing roles_info decl } + do { traceTc "---- tcTyClDecl ---- {" (ppr decl) + ; tc <- tcTyClDecl1 Nothing roles_info decl + ; traceTc "---- tcTyClDecl end ---- }" (ppr tc) + ; return tc } -- "type family" declarations tcTyClDecl1 :: Maybe Class -> RolesInfo -> TyClDecl GhcRn -> TcM TyCon From git at git.haskell.org Thu Dec 14 13:28:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 13:28:12 +0000 (UTC) Subject: [commit: ghc] master: Fix an outright bug in the unflattener (b1ea047) Message-ID: <20171214132812.864783A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b1ea0475894713b9fc753bf288589e0dc3175083/ghc >--------------------------------------------------------------- commit b1ea0475894713b9fc753bf288589e0dc3175083 Author: Simon Peyton Jones Date: Thu Dec 14 13:25:48 2017 +0000 Fix an outright bug in the unflattener Trac #14554 showed up an outright bug in the unflattening code in TcFlatten. I was filling in a coercion with the wrong coercion (a Syn in the wrong place). Result: "Bad coercion hole" assertion failures, and Core Lint Errors. Easily fixed, and the code is simpler too. >--------------------------------------------------------------- b1ea0475894713b9fc753bf288589e0dc3175083 compiler/typecheck/TcFlatten.hs | 45 ++++++++++++---------- .../tests/indexed-types/should_compile/T14554.hs | 34 ++++++++++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 59 insertions(+), 21 deletions(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index c8479a6..ff4195c 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1571,11 +1571,13 @@ unflattenWanteds tv_eqs funeqs do { is_filled <- isFilledMetaTyVar tv ; elim <- case is_filled of False -> do { traceTcS "unflatten_eq 2" (ppr ct) - ; tryFill ev eq_rel tv rhs } - True -> do { traceTcS "unflatten_eq 2" (ppr ct) - ; try_fill_rhs ev eq_rel tclvl tv rhs } - ; if elim then return rest - else return (ct `consCts` rest) } + ; tryFill ev tv rhs } + True -> do { traceTcS "unflatten_eq 3" (ppr ct) + ; try_fill_rhs ev tclvl tv rhs } + ; if elim + then do { setReflEvidence ev eq_rel (mkTyVarTy tv) + ; return rest } + else return (ct `consCts` rest) } | otherwise = return (ct `consCts` rest) @@ -1583,7 +1585,7 @@ unflattenWanteds tv_eqs funeqs unflatten_eq _ ct _ = pprPanic "unflatten_irred" (ppr ct) ---------------- - try_fill_rhs ev eq_rel tclvl lhs_tv rhs + try_fill_rhs ev tclvl lhs_tv rhs -- Constraint is lhs_tv ~ rhs_tv, -- and lhs_tv is filled, so try RHS | Just (rhs_tv, co) <- getCastedTyVar_maybe rhs @@ -1595,7 +1597,7 @@ unflattenWanteds tv_eqs funeqs -- not unify with = do { is_filled <- isFilledMetaTyVar rhs_tv ; if is_filled then return False - else tryFill ev eq_rel rhs_tv + else tryFill ev rhs_tv (mkTyVarTy lhs_tv `mkCastTy` mkSymCo co) } | otherwise @@ -1618,26 +1620,27 @@ unflattenWanteds tv_eqs funeqs finalise_eq ct _ = pprPanic "finalise_irred" (ppr ct) -tryFill :: CtEvidence -> EqRel -> TcTyVar -> TcType -> TcS Bool +tryFill :: CtEvidence -> TcTyVar -> TcType -> TcS Bool -- (tryFill tv rhs ev) assumes 'tv' is an /un-filled/ MetaTv -- If tv does not appear in 'rhs', it set tv := rhs, -- binds the evidence (which should be a CtWanted) to Refl -- and return True. Otherwise returns False -tryFill ev eq_rel tv rhs +tryFill ev tv rhs = ASSERT2( not (isGiven ev), ppr ev ) do { rhs' <- zonkTcType rhs - ; case tcGetTyVar_maybe rhs' of { - Just tv' | tv == tv' -> do { setReflEvidence ev eq_rel rhs - ; return True } ; - _other -> - do { case occCheckExpand tv rhs' of - Just rhs'' -- Normal case: fill the tyvar - -> do { setReflEvidence ev eq_rel rhs'' - ; unifyTyVar tv rhs'' - ; return True } - - Nothing -> -- Occurs check - return False } } } + ; case () of + _ | Just tv' <- tcGetTyVar_maybe rhs' + , tv == tv' -- tv == rhs + -> return True + + _ | Just rhs'' <- occCheckExpand tv rhs' + -> do { -- Fill the tyvar + unifyTyVar tv rhs'' + ; return True } + + _ | otherwise -- Occurs check + -> return False + } setReflEvidence :: CtEvidence -> EqRel -> TcType -> TcS () setReflEvidence ev eq_rel rhs diff --git a/testsuite/tests/indexed-types/should_compile/T14554.hs b/testsuite/tests/indexed-types/should_compile/T14554.hs new file mode 100644 index 0000000..f6b3822 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T14554.hs @@ -0,0 +1,34 @@ +{-# Language UndecidableInstances, DataKinds, TypeOperators, + KindSignatures, PolyKinds, TypeInType, TypeFamilies, + GADTs, LambdaCase, ScopedTypeVariables #-} + +module T14554 where + +import Data.Kind +import Data.Proxy + +type a ~> b = (a, b) -> Type + +data IdSym0 :: (Type,Type) -> Type + +data KIND = X | FNARR KIND KIND + +data TY :: KIND -> Type where + ID :: TY (FNARR X X) + FNAPP :: TY (FNARR k k') -> TY k -> TY k' + +data TyRep (kind::KIND) :: TY kind -> Type where + TID :: TyRep (FNARR X X) ID + TFnApp :: TyRep (FNARR k k') f + -> TyRep k a + -> TyRep k' (FNAPP f a) + +type family IK (kind::KIND) :: Type where + IK X = Type + IK (FNARR k k') = IK k ~> IK k' + +type family IT (ty::TY kind) :: IK kind + +zero :: TyRep X a -> IT a +zero x = case x of + TFnApp TID a -> undefined diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 6407324..9250fa2 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -271,3 +271,4 @@ test('T12938', normal, compile, ['']) test('T14131', normal, compile, ['']) test('T14162', normal, compile, ['']) test('T14237', normal, compile, ['']) +test('T14554', normal, compile, ['']) From git at git.haskell.org Thu Dec 14 16:01:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 16:01:19 +0000 (UTC) Subject: [commit: ghc] master: typos in local var (eeb36eb) Message-ID: <20171214160119.6A1803A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eeb36ebdfd1361e18a57609dda6524ddd24cdd8d/ghc >--------------------------------------------------------------- commit eeb36ebdfd1361e18a57609dda6524ddd24cdd8d Author: Gabor Greif Date: Thu Dec 14 16:57:28 2017 +0100 typos in local var >--------------------------------------------------------------- eeb36ebdfd1361e18a57609dda6524ddd24cdd8d compiler/codeGen/StgCmmUtils.hs | 2 +- rts/linker/elf_util.c | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 07432c4..b6092e8 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -585,7 +585,7 @@ mk_float_switch rep scrut deflt_blk_id (lo_bound, hi_bound) branches -------------- label_default :: BlockId -> Maybe CmmAGraphScoped -> FCode (Maybe BlockId) label_default _ Nothing - = return Nothing + = return Nothing label_default join_lbl (Just code) = do lbl <- label_code join_lbl code return (Just lbl) diff --git a/rts/linker/elf_util.c b/rts/linker/elf_util.c index 9ff9d62..052b2d9 100644 --- a/rts/linker/elf_util.c +++ b/rts/linker/elf_util.c @@ -3,9 +3,9 @@ #if defined(OBJFORMAT_ELF) ElfSymbolTable * -findSymbolTable(ObjectCode * oc, unsigned symolTableIndex) { +findSymbolTable(ObjectCode * oc, unsigned symbolTableIndex) { for(ElfSymbolTable * t=oc->info->symbolTables; t != NULL; t = t->next) - if(t->index == symolTableIndex) + if(t->index == symbolTableIndex) return t; return NULL; } From git at git.haskell.org Thu Dec 14 17:49:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 17:49:24 +0000 (UTC) Subject: [commit: ghc] master: Fix #14135 by validity checking matches (16c7d9d) Message-ID: <20171214174924.2082E3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/16c7d9dc9ea7505256e0792c958cab8ae7c8a5c4/ghc >--------------------------------------------------------------- commit 16c7d9dc9ea7505256e0792c958cab8ae7c8a5c4 Author: Carlos Tomé Date: Mon Dec 11 15:38:03 2017 -0500 Fix #14135 by validity checking matches We filter the complete patterns given in a COMPLETE set to only those that subsume the type we are matching. Otherwise we end up introducing an ill-typed equation into the overlap checking, provoking a crash. This was the cause of Trac #14135. Reviewers: austin, bgamari, mpickering, gkaracha, simonpj, RyanGlScott, carlostome Reviewed By: bgamari Subscribers: carter, dfeuer, RyanGlScott, goldfire, rwbarton, thomie GHC Trac Issues: #14135 Differential Revision: https://phabricator.haskell.org/D3981 >--------------------------------------------------------------- 16c7d9dc9ea7505256e0792c958cab8ae7c8a5c4 compiler/deSugar/Check.hs | 26 ++++++++++++++-------- testsuite/tests/deSugar/should_compile/T14135.hs | 16 +++++++++++++ .../tests/deSugar/should_compile/T14135.stderr | 4 ++++ testsuite/tests/deSugar/should_compile/all.T | 1 + 4 files changed, 38 insertions(+), 9 deletions(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index d49a5c3..d35615c 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -1263,24 +1263,32 @@ singleConstructor _ = False -- These come from two places. -- 1. From data constructors defined with the result type constructor. -- 2. From `COMPLETE` pragmas which have the same type as the result --- type constructor. +-- type constructor. Note that we only use `COMPLETE` pragmas +-- *all* of whose pattern types match. See #14135 allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] allCompleteMatches cl tys = do let fam = case cl of RealDataCon dc -> [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] PatSynCon _ -> [] - - pragmas <- case splitTyConApp_maybe (conLikeResTy cl tys) of - Just (tc, _) -> dsGetCompleteMatches tc - Nothing -> return [] - let fams cm = fmap (FromComplete,) $ + ty = conLikeResTy cl tys + pragmas <- case splitTyConApp_maybe ty of + Just (tc, _) -> dsGetCompleteMatches tc + Nothing -> return [] + let fams cm = (FromComplete,) <$> mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- mapM fams pragmas - + from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> + mapM fams pragmas let final_groups = fam ++ from_pragma - tracePmD "allCompleteMatches" (ppr final_groups) return final_groups + where + -- Check that all the pattern types in a `COMPLETE` + -- pragma subsume the type we're matching. See #14135. + isValidCompleteMatch :: Type -> [ConLike] -> Bool + isValidCompleteMatch ty = + isJust . mapM (flip tcMatchTy ty . resTy . conLikeFullSig) + where + resTy (_, _, _, _, _, _, res_ty) = res_ty -- ----------------------------------------------------------------------- -- * Types and constraints diff --git a/testsuite/tests/deSugar/should_compile/T14135.hs b/testsuite/tests/deSugar/should_compile/T14135.hs new file mode 100644 index 0000000..fbdd5bd --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14135.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_GHC -Wincomplete-patterns #-} +{-# LANGUAGE GADTs #-} +module T14135 where + +data Foo a where + Foo1 :: a -> Foo a + Foo2 :: Int -> Foo Int + +pattern MyFoo2 :: (a ~ Int) => Int -> Foo a +pattern MyFoo2 i = Foo2 i + +{-# COMPLETE Foo1, MyFoo2 #-} + +f :: Foo a -> a +f (Foo1 x) = x diff --git a/testsuite/tests/deSugar/should_compile/T14135.stderr b/testsuite/tests/deSugar/should_compile/T14135.stderr new file mode 100644 index 0000000..23a3e90 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14135.stderr @@ -0,0 +1,4 @@ + +T14135.hs:16:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘f’: Patterns not matched: (Foo2 _) diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T index 0a20fbb..fe6535e 100644 --- a/testsuite/tests/deSugar/should_compile/all.T +++ b/testsuite/tests/deSugar/should_compile/all.T @@ -99,3 +99,4 @@ test('T13215', normal, compile, ['']) test('T13290', normal, compile, ['']) test('T13257', normal, compile, ['']) test('T13870', normal, compile, ['']) +test('T14135', normal, compile, ['']) From git at git.haskell.org Thu Dec 14 18:31:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 18:31:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Only look for locales of the form LL.VV (c384029) Message-ID: <20171214183125.0B9E63A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/c384029ae415b9d2b8843eb1d0e399862dc6a576/ghc >--------------------------------------------------------------- commit c384029ae415b9d2b8843eb1d0e399862dc6a576 Author: Gabor Greif Date: Thu Nov 30 20:49:03 2017 +0100 Only look for locales of the form LL.VV Because in recent RHEL7 suddenly locales like `bokmål` pop up, which screw up reading-in of ASCII strings a line later. This additional criterion reliably eliminates those unicode characters. (cherry picked from commit abd5db6072218ada2b4a21177f5200ea0d3273a0) >--------------------------------------------------------------- c384029ae415b9d2b8843eb1d0e399862dc6a576 testsuite/driver/runtests.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 9f74494..db17f3b 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -151,7 +151,7 @@ else: h.close() if v == '': # We don't, so now see if 'locale -a' works - h = os.popen('locale -a', 'r') + h = os.popen('locale -a | grep -F .', 'r') v = h.read() h.close() if v != '': From git at git.haskell.org Thu Dec 14 22:00:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:00:42 +0000 (UTC) Subject: [commit: ghc] wip/T14373: first round of review feedback (c33d45d) Message-ID: <20171214220042.2F6D03A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/c33d45dae0669dacb89974ea1c3e8628a5b24fe3/ghc >--------------------------------------------------------------- commit c33d45dae0669dacb89974ea1c3e8628a5b24fe3 Author: Gabor Greif Date: Thu Dec 14 23:00:13 2017 +0100 first round of review feedback >--------------------------------------------------------------- c33d45dae0669dacb89974ea1c3e8628a5b24fe3 compiler/codeGen/StgCmmExpr.hs | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 21b8045..93cea88 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -33,7 +33,7 @@ import StgSyn import MkGraph import BlockId -import Cmm +import Cmm hiding ( succ ) import CmmInfo import CoreSyn import DataCon @@ -610,7 +610,7 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts ; let fam_sz = tyConFamilySize tycon bndr_reg = CmmLocal (idToReg dflags bndr) tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg) - branches' = [(tag+1,branch) | (tag,branch) <- branches] + branches' = first succ <$> branches maxpt = mAX_PTR_TAG dflags (ptr, info) = partition ((< maxpt) . fst) branches' small = isSmallFamily dflags fam_sz @@ -619,17 +619,20 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts -- See Note [tagging big families] ; if small || null info then -- Yes, bndr_reg has constr. tag in ls bits - emitSwitch tag_expr branches' mb_deflt 1 (if small then fam_sz else maxpt) + emitSwitch tag_expr branches' mb_deflt 1 + $ if small then fam_sz else maxpt else -- No, get exact tag from info table when mAX_PTR_TAG do - infos_lbl <- newBlockId -- branch destination for info pointer lookup + infos_lbl <- newBlockId -- branch destination for + -- info pointer lookup infos_scp <- getTickScope let catchall = (maxpt, (mkBranch infos_lbl, infos_scp)) prelabel (Just (stmts, scp)) = do lbl <- newBlockId - return (Just (mkLabel lbl scp <*> stmts, scp), Just (mkBranch lbl, scp)) + return ( Just (mkLabel lbl scp <*> stmts, scp) + , Just (mkBranch lbl, scp)) prelabel _ = return (Nothing, Nothing) (mb_deflt, mb_branch) <- prelabel mb_deflt @@ -639,7 +642,7 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts emitLabel infos_lbl let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) tag_expr = getConstrTag dflags untagged_ptr - info0 = (\(tag,branch)->(tag-1,branch)) <$> info + info0 = first pred <$> info emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1) emitLabel join_lbl @@ -679,12 +682,12 @@ cgAlts _ _ _ _ = panic "cgAlts" -- tagging. We now use 1..{2,6} as pointer-resident tags while -- {3,7} signifies we have to fall back and get the tag from the -- info-table. --- Conseqently we now cascade switches because we have to check +-- Consequently we now cascade switches because we have to check -- the tag first and when it is MAX_PTR_TAG then get the precise -- tag from the info table and switch on that. The only technically -- tricky part is that the default case needs (logical) duplication. -- To do this we emit an extra label for it and branch to that from --- the second switch. This avoids duplicated codegen. +-- the second switch. This avoids duplicated codegen. See Trac #14373. -- -- Also see Note [Data constructor dynamic tags] From git at git.haskell.org Thu Dec 14 22:05:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:05:00 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Improve Control.Monad.guard and Control.Monad.MonadPlus docs (c01e413) Message-ID: <20171214220500.832953A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/c01e413f9f3cad4b85b5dec73ea9f2e6a574f213/ghc >--------------------------------------------------------------- commit c01e413f9f3cad4b85b5dec73ea9f2e6a574f213 Author: Nathan Collins Date: Mon Dec 11 12:52:55 2017 -0500 Improve Control.Monad.guard and Control.Monad.MonadPlus docs This fixes Issue #12372: documentation for Control.Monad.guard not useful after AMP. Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4258 (cherry picked from commit 6847c6bf5777eaf507f1cef28c1fc75a2c68bdef) >--------------------------------------------------------------- c01e413f9f3cad4b85b5dec73ea9f2e6a574f213 libraries/base/Control/Monad.hs | 43 +++++++++++++++++++++++++++++++++++++++-- libraries/base/GHC/Base.hs | 13 +++++++++++-- 2 files changed, 52 insertions(+), 4 deletions(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 0706c86..3570144 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -86,8 +86,47 @@ import GHC.Num ( (-) ) -- ----------------------------------------------------------------------------- -- Functions mandated by the Prelude --- | @'guard' b@ is @'pure' ()@ if @b@ is 'True', --- and 'empty' if @b@ is 'False'. +-- | Conditional failure of 'Alternative' computations. Defined by +-- +-- @ +-- guard True = 'pure' () +-- guard False = 'empty' +-- @ +-- +-- ==== __Examples__ +-- +-- Common uses of 'guard' include conditionally signaling an error in +-- an error monad and conditionally rejecting the current choice in an +-- 'Alternative'-based parser. +-- +-- As an example of signaling an error in the error monad 'Maybe', +-- consider a safe division function @safeDiv x y@ that returns +-- 'Nothing' when the denominator @y@ is zero and @'Just' (x \`div\` +-- y)@ otherwise. For example: +-- +-- @ +-- >>> safeDiv 4 0 +-- Nothing +-- >>> safeDiv 4 2 +-- Just 2 +-- @ +-- +-- A definition of @safeDiv@ using guards, but not 'guard': +-- +-- @ +-- safeDiv :: Int -> Int -> Maybe Int +-- safeDiv x y | y /= 0 = Just (x \`div\` y) +-- | otherwise = Nothing +-- @ +-- +-- A definition of @safeDiv@ using 'guard' and 'Monad' @do at -notation: +-- +-- @ +-- safeDiv :: Int -> Int -> Maybe Int +-- safeDiv x y = do +-- guard (y /= 0) +-- return (x \`div\` y) +-- @ guard :: (Alternative f) => Bool -> f () guard True = pure () guard False = empty diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 052f13f..2d6e0e4 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -880,15 +880,24 @@ instance Alternative Maybe where -- | Monads that also support choice and failure. class (Alternative m, Monad m) => MonadPlus m where - -- | the identity of 'mplus'. It should also satisfy the equations + -- | The identity of 'mplus'. It should also satisfy the equations -- -- > mzero >>= f = mzero -- > v >> mzero = mzero -- + -- The default definition is + -- + -- @ + -- mzero = 'empty' + -- @ mzero :: m a mzero = empty - -- | an associative operation + -- | An associative operation. The default definition is + -- + -- @ + -- mplus = ('<|>') + -- @ mplus :: m a -> m a -> m a mplus = (<|>) From git at git.haskell.org Thu Dec 14 22:05:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:05:03 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Improve Control.Monad.guard and Control.Monad.MonadPlus docs (c01e413) Message-ID: <20171214220503.31E8A3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/c01e413f9f3cad4b85b5dec73ea9f2e6a574f213/ghc >--------------------------------------------------------------- commit c01e413f9f3cad4b85b5dec73ea9f2e6a574f213 Author: Nathan Collins Date: Mon Dec 11 12:52:55 2017 -0500 Improve Control.Monad.guard and Control.Monad.MonadPlus docs This fixes Issue #12372: documentation for Control.Monad.guard not useful after AMP. Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4258 (cherry picked from commit 6847c6bf5777eaf507f1cef28c1fc75a2c68bdef) >--------------------------------------------------------------- c01e413f9f3cad4b85b5dec73ea9f2e6a574f213 libraries/base/Control/Monad.hs | 43 +++++++++++++++++++++++++++++++++++++++-- libraries/base/GHC/Base.hs | 13 +++++++++++-- 2 files changed, 52 insertions(+), 4 deletions(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 0706c86..3570144 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -86,8 +86,47 @@ import GHC.Num ( (-) ) -- ----------------------------------------------------------------------------- -- Functions mandated by the Prelude --- | @'guard' b@ is @'pure' ()@ if @b@ is 'True', --- and 'empty' if @b@ is 'False'. +-- | Conditional failure of 'Alternative' computations. Defined by +-- +-- @ +-- guard True = 'pure' () +-- guard False = 'empty' +-- @ +-- +-- ==== __Examples__ +-- +-- Common uses of 'guard' include conditionally signaling an error in +-- an error monad and conditionally rejecting the current choice in an +-- 'Alternative'-based parser. +-- +-- As an example of signaling an error in the error monad 'Maybe', +-- consider a safe division function @safeDiv x y@ that returns +-- 'Nothing' when the denominator @y@ is zero and @'Just' (x \`div\` +-- y)@ otherwise. For example: +-- +-- @ +-- >>> safeDiv 4 0 +-- Nothing +-- >>> safeDiv 4 2 +-- Just 2 +-- @ +-- +-- A definition of @safeDiv@ using guards, but not 'guard': +-- +-- @ +-- safeDiv :: Int -> Int -> Maybe Int +-- safeDiv x y | y /= 0 = Just (x \`div\` y) +-- | otherwise = Nothing +-- @ +-- +-- A definition of @safeDiv@ using 'guard' and 'Monad' @do at -notation: +-- +-- @ +-- safeDiv :: Int -> Int -> Maybe Int +-- safeDiv x y = do +-- guard (y /= 0) +-- return (x \`div\` y) +-- @ guard :: (Alternative f) => Bool -> f () guard True = pure () guard False = empty diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 052f13f..2d6e0e4 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -880,15 +880,24 @@ instance Alternative Maybe where -- | Monads that also support choice and failure. class (Alternative m, Monad m) => MonadPlus m where - -- | the identity of 'mplus'. It should also satisfy the equations + -- | The identity of 'mplus'. It should also satisfy the equations -- -- > mzero >>= f = mzero -- > v >> mzero = mzero -- + -- The default definition is + -- + -- @ + -- mzero = 'empty' + -- @ mzero :: m a mzero = empty - -- | an associative operation + -- | An associative operation. The default definition is + -- + -- @ + -- mplus = ('<|>') + -- @ mplus :: m a -> m a -> m a mplus = (<|>) From git at git.haskell.org Thu Dec 14 22:05:04 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:05:04 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix #14135 by validity checking matches (cc034b3) Message-ID: <20171214220504.30E5C3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/cc034b35a6890bd67739e59319f50dc020f04da7/ghc >--------------------------------------------------------------- commit cc034b35a6890bd67739e59319f50dc020f04da7 Author: Carlos Tomé Date: Mon Dec 11 15:38:03 2017 -0500 Fix #14135 by validity checking matches We filter the complete patterns given in a COMPLETE set to only those that subsume the type we are matching. Otherwise we end up introducing an ill-typed equation into the overlap checking, provoking a crash. This was the cause of Trac #14135. Reviewers: austin, bgamari, mpickering, gkaracha, simonpj, RyanGlScott, carlostome Reviewed By: bgamari Subscribers: carter, dfeuer, RyanGlScott, goldfire, rwbarton, thomie GHC Trac Issues: #14135 Differential Revision: https://phabricator.haskell.org/D3981 (cherry picked from commit 16c7d9dc9ea7505256e0792c958cab8ae7c8a5c4) >--------------------------------------------------------------- cc034b35a6890bd67739e59319f50dc020f04da7 compiler/deSugar/Check.hs | 26 ++++++++++++++-------- testsuite/tests/deSugar/should_compile/T14135.hs | 16 +++++++++++++ .../tests/deSugar/should_compile/T14135.stderr | 4 ++++ testsuite/tests/deSugar/should_compile/all.T | 1 + 4 files changed, 38 insertions(+), 9 deletions(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index d49a5c3..d35615c 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -1263,24 +1263,32 @@ singleConstructor _ = False -- These come from two places. -- 1. From data constructors defined with the result type constructor. -- 2. From `COMPLETE` pragmas which have the same type as the result --- type constructor. +-- type constructor. Note that we only use `COMPLETE` pragmas +-- *all* of whose pattern types match. See #14135 allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] allCompleteMatches cl tys = do let fam = case cl of RealDataCon dc -> [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] PatSynCon _ -> [] - - pragmas <- case splitTyConApp_maybe (conLikeResTy cl tys) of - Just (tc, _) -> dsGetCompleteMatches tc - Nothing -> return [] - let fams cm = fmap (FromComplete,) $ + ty = conLikeResTy cl tys + pragmas <- case splitTyConApp_maybe ty of + Just (tc, _) -> dsGetCompleteMatches tc + Nothing -> return [] + let fams cm = (FromComplete,) <$> mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- mapM fams pragmas - + from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> + mapM fams pragmas let final_groups = fam ++ from_pragma - tracePmD "allCompleteMatches" (ppr final_groups) return final_groups + where + -- Check that all the pattern types in a `COMPLETE` + -- pragma subsume the type we're matching. See #14135. + isValidCompleteMatch :: Type -> [ConLike] -> Bool + isValidCompleteMatch ty = + isJust . mapM (flip tcMatchTy ty . resTy . conLikeFullSig) + where + resTy (_, _, _, _, _, _, res_ty) = res_ty -- ----------------------------------------------------------------------- -- * Types and constraints diff --git a/testsuite/tests/deSugar/should_compile/T14135.hs b/testsuite/tests/deSugar/should_compile/T14135.hs new file mode 100644 index 0000000..fbdd5bd --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14135.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_GHC -Wincomplete-patterns #-} +{-# LANGUAGE GADTs #-} +module T14135 where + +data Foo a where + Foo1 :: a -> Foo a + Foo2 :: Int -> Foo Int + +pattern MyFoo2 :: (a ~ Int) => Int -> Foo a +pattern MyFoo2 i = Foo2 i + +{-# COMPLETE Foo1, MyFoo2 #-} + +f :: Foo a -> a +f (Foo1 x) = x diff --git a/testsuite/tests/deSugar/should_compile/T14135.stderr b/testsuite/tests/deSugar/should_compile/T14135.stderr new file mode 100644 index 0000000..23a3e90 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14135.stderr @@ -0,0 +1,4 @@ + +T14135.hs:16:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘f’: Patterns not matched: (Foo2 _) diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T index 0a20fbb..fe6535e 100644 --- a/testsuite/tests/deSugar/should_compile/all.T +++ b/testsuite/tests/deSugar/should_compile/all.T @@ -99,3 +99,4 @@ test('T13215', normal, compile, ['']) test('T13290', normal, compile, ['']) test('T13257', normal, compile, ['']) test('T13870', normal, compile, ['']) +test('T14135', normal, compile, ['']) From git at git.haskell.org Thu Dec 14 22:05:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:05:07 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Fix #14135 by validity checking matches (cc034b3) Message-ID: <20171214220507.1C76C3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/cc034b35a6890bd67739e59319f50dc020f04da7/ghc >--------------------------------------------------------------- commit cc034b35a6890bd67739e59319f50dc020f04da7 Author: Carlos Tomé Date: Mon Dec 11 15:38:03 2017 -0500 Fix #14135 by validity checking matches We filter the complete patterns given in a COMPLETE set to only those that subsume the type we are matching. Otherwise we end up introducing an ill-typed equation into the overlap checking, provoking a crash. This was the cause of Trac #14135. Reviewers: austin, bgamari, mpickering, gkaracha, simonpj, RyanGlScott, carlostome Reviewed By: bgamari Subscribers: carter, dfeuer, RyanGlScott, goldfire, rwbarton, thomie GHC Trac Issues: #14135 Differential Revision: https://phabricator.haskell.org/D3981 (cherry picked from commit 16c7d9dc9ea7505256e0792c958cab8ae7c8a5c4) >--------------------------------------------------------------- cc034b35a6890bd67739e59319f50dc020f04da7 compiler/deSugar/Check.hs | 26 ++++++++++++++-------- testsuite/tests/deSugar/should_compile/T14135.hs | 16 +++++++++++++ .../tests/deSugar/should_compile/T14135.stderr | 4 ++++ testsuite/tests/deSugar/should_compile/all.T | 1 + 4 files changed, 38 insertions(+), 9 deletions(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index d49a5c3..d35615c 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -1263,24 +1263,32 @@ singleConstructor _ = False -- These come from two places. -- 1. From data constructors defined with the result type constructor. -- 2. From `COMPLETE` pragmas which have the same type as the result --- type constructor. +-- type constructor. Note that we only use `COMPLETE` pragmas +-- *all* of whose pattern types match. See #14135 allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] allCompleteMatches cl tys = do let fam = case cl of RealDataCon dc -> [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] PatSynCon _ -> [] - - pragmas <- case splitTyConApp_maybe (conLikeResTy cl tys) of - Just (tc, _) -> dsGetCompleteMatches tc - Nothing -> return [] - let fams cm = fmap (FromComplete,) $ + ty = conLikeResTy cl tys + pragmas <- case splitTyConApp_maybe ty of + Just (tc, _) -> dsGetCompleteMatches tc + Nothing -> return [] + let fams cm = (FromComplete,) <$> mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- mapM fams pragmas - + from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> + mapM fams pragmas let final_groups = fam ++ from_pragma - tracePmD "allCompleteMatches" (ppr final_groups) return final_groups + where + -- Check that all the pattern types in a `COMPLETE` + -- pragma subsume the type we're matching. See #14135. + isValidCompleteMatch :: Type -> [ConLike] -> Bool + isValidCompleteMatch ty = + isJust . mapM (flip tcMatchTy ty . resTy . conLikeFullSig) + where + resTy (_, _, _, _, _, _, res_ty) = res_ty -- ----------------------------------------------------------------------- -- * Types and constraints diff --git a/testsuite/tests/deSugar/should_compile/T14135.hs b/testsuite/tests/deSugar/should_compile/T14135.hs new file mode 100644 index 0000000..fbdd5bd --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14135.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_GHC -Wincomplete-patterns #-} +{-# LANGUAGE GADTs #-} +module T14135 where + +data Foo a where + Foo1 :: a -> Foo a + Foo2 :: Int -> Foo Int + +pattern MyFoo2 :: (a ~ Int) => Int -> Foo a +pattern MyFoo2 i = Foo2 i + +{-# COMPLETE Foo1, MyFoo2 #-} + +f :: Foo a -> a +f (Foo1 x) = x diff --git a/testsuite/tests/deSugar/should_compile/T14135.stderr b/testsuite/tests/deSugar/should_compile/T14135.stderr new file mode 100644 index 0000000..23a3e90 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14135.stderr @@ -0,0 +1,4 @@ + +T14135.hs:16:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘f’: Patterns not matched: (Foo2 _) diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T index 0a20fbb..fe6535e 100644 --- a/testsuite/tests/deSugar/should_compile/all.T +++ b/testsuite/tests/deSugar/should_compile/all.T @@ -99,3 +99,4 @@ test('T13215', normal, compile, ['']) test('T13290', normal, compile, ['']) test('T13257', normal, compile, ['']) test('T13870', normal, compile, ['']) +test('T14135', normal, compile, ['']) From git at git.haskell.org Thu Dec 14 22:05:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:05:12 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: users-guide: Fix various bits of markup (15b2b95) Message-ID: <20171214220512.CE76C3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/15b2b959abbc724187b0e58979968d24ab323681/ghc >--------------------------------------------------------------- commit 15b2b959abbc724187b0e58979968d24ab323681 Author: Ben Gamari Date: Thu Dec 14 16:52:59 2017 -0500 users-guide: Fix various bits of markup >--------------------------------------------------------------- 15b2b959abbc724187b0e58979968d24ab323681 docs/users_guide/8.4.1-notes.rst | 18 +++++++++++++----- docs/users_guide/separate_compilation.rst | 10 +++++----- 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst index 7c2f954..6ad4cc5 100644 --- a/docs/users_guide/8.4.1-notes.rst +++ b/docs/users_guide/8.4.1-notes.rst @@ -13,7 +13,15 @@ Highlights The highlights, since the 8.2.1 release, are: -- Many, many bug fixes. +- GHC is now capable of deriving more instances + +- More refinement of the :ghc-flag:`-XTypeInType` story and improvements in type + error messages. + +- Further improvements in code generation + +- Many, many bug fixes. + Full details ------------ @@ -59,16 +67,16 @@ Language data StrictJust a <- Just !a where StrictJust !a = Just a -- GADTs with kind-polymorphic type arguments now require :ghc-flag:`TypeInType`. +- GADTs with kind-polymorphic type arguments now require :ghc-flag:`-XTypeInType`. For instance, consider the following, :: data G :: k -> * where GInt :: G Int GMaybe :: G Maybe - In previous releases this would compile with :ghc-flag:`PolyKinds` alone due + In previous releases this would compile with :ghc-flag:`-XPolyKinds` alone due to bug :ghc-ticket:`13391`. As of GHC 8.4, however, this requires - :ghc-flag:`TypeInType`. Note that since GADT kind signatures aren't generalized, + :ghc-flag:`-XTypeInType`. Note that since GADT kind signatures aren't generalized, this will also require that you provide a :ref:`CUSK ` by explicitly quantifying over the kind argument, ``k``, :: @@ -101,7 +109,7 @@ Language which require extensions to derive, such as :ghc-flag:`-XDeriveFunctor`. - Hexadecimal floating point literals (e.g. ``0x0.1p4``), enabled with - :ghc-flag:`HexFloatLiterals`. See + :ghc-flag:`-XHexFloatLiterals`. See :ref:`Hexadecimal floating point literals ` for the full details. diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst index 2375f63..e7501c2 100644 --- a/docs/users_guide/separate_compilation.rst +++ b/docs/users_guide/separate_compilation.rst @@ -544,17 +544,17 @@ The recompilation checker .. ghc-flag:: -fignore-optim-changes :shortdesc: Do not recompile modules just to match changes to - optimisation flags. This is especially useful for avoiding - recompilation when using GHCi, and is enabled by default for - GHCi. + optimisation flags. This is especially useful for avoiding + recompilation when using GHCi, and is enabled by default for + GHCi. :type: dynamic :reverse: -fno-ignore-optim-changes :category: recompilation .. ghc-flag:: -fignore-hpc-changes :shortdesc: Do not recompile modules just to match changes to - HPC flags. This is especially useful for avoiding recompilation - when using GHCi, and is enabled by default for GHCi. + HPC flags. This is especially useful for avoiding recompilation + when using GHCi, and is enabled by default for GHCi. :type: dynamic :reverse: -fno-ignore-hpc-changes :category: recompilation From git at git.haskell.org Thu Dec 14 22:05:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:05:07 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: users-guide: Consistently document LLVM version requirement (fdccc66) Message-ID: <20171214220507.642533A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/fdccc6666d838cf8708b9fc03a9ce2aa04fe9439/ghc >--------------------------------------------------------------- commit fdccc6666d838cf8708b9fc03a9ce2aa04fe9439 Author: Ben Gamari Date: Thu Dec 14 13:44:52 2017 -0500 users-guide: Consistently document LLVM version requirement >--------------------------------------------------------------- fdccc6666d838cf8708b9fc03a9ce2aa04fe9439 docs/users_guide/8.4.1-notes.rst | 3 +++ docs/users_guide/codegens.rst | 15 ++++++++++----- docs/users_guide/conf.py | 4 ++++ docs/users_guide/ghc_config.py.in | 2 ++ docs/users_guide/phases.rst | 5 +++++ 5 files changed, 24 insertions(+), 5 deletions(-) diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst index 246a278..7c2f954 100644 --- a/docs/users_guide/8.4.1-notes.rst +++ b/docs/users_guide/8.4.1-notes.rst @@ -108,6 +108,9 @@ Language Compiler ~~~~~~~~ +- LLVM code generator (e.g. :ghc-flag:`-fllvm`) compatible with LLVM releases in + the |llvm-version| series. + - Add warning flag :ghc-flag:`-Wmissing-export-lists` which causes the type checker to warn when a module does not include an explicit export list. diff --git a/docs/users_guide/codegens.rst b/docs/users_guide/codegens.rst index 402e783..936d725 100644 --- a/docs/users_guide/codegens.rst +++ b/docs/users_guide/codegens.rst @@ -40,7 +40,7 @@ performance as good as the native code generator but for some cases can produce much faster code. This is especially true for numeric, array heavy code using packages like vector. The penalty is a significant increase in compilation times. Select the LLVM backend with the -``-fllvm`` flag. Currently *LLVM 2.8* and later are supported. +:ghc-flag:`-fllvm` flag. You must install and have LLVM available on your ``PATH`` for the LLVM code generator to work. Specifically GHC needs to be able to call the ``opt`` @@ -48,12 +48,17 @@ and ``llc`` tools. Secondly, if you are running Mac OS X with LLVM 3.0 or greater then you also need the `Clang C compiler `__ compiler available on your ``PATH``. +.. note:: + + Note that this GHC release expects an LLVM version in the |llvm-version| + release series. + To install LLVM and Clang: - *Linux*: Use your package management tool. - *Mac OS X*: Clang is included by default on recent OS X machines when - XCode is installed (from ``10.6`` and later). LLVM is not included. + XCode is installed (from 10.6 and later). LLVM is not included. In order to use the LLVM based code generator, you should install the `Homebrew `__ package manager for OS X. Alternatively you can download binaries for LLVM and Clang from @@ -73,7 +78,7 @@ C Code Generator (``-fvia-C``) This is the oldest code generator in GHC and is generally not included any more having been deprecated around GHC 7.0. Select it with the -``-fvia-C`` flag. +:ghc-flag:`-fvia-C` flag. The C code generator is only supported when GHC is built in unregisterised mode, a mode where GHC produces "portable" C code as @@ -81,7 +86,7 @@ output to facilitate porting GHC itself to a new platform. This mode produces much slower code though so it's unlikely your version of GHC was built this way. If it has then the native code generator probably won't be available. You can check this information by calling -``ghc --info`` (see :ref:`ghc-info`). +``ghc --info`` (see :ghc-flag:`--info`). .. _unreg: @@ -112,4 +117,4 @@ to build GHC with the appropriate options set. Consult the GHC Building Guide for details. You can check if your GHC is unregisterised by calling -``ghc --info`` (see :ref:`ghc-info`). +``ghc --info`` (see :ghc-flag:`--info`). diff --git a/docs/users_guide/conf.py b/docs/users_guide/conf.py index 4d4704a..ef7b9d5 100644 --- a/docs/users_guide/conf.py +++ b/docs/users_guide/conf.py @@ -24,6 +24,10 @@ source_suffix = '.rst' source_encoding = 'utf-8-sig' master_doc = 'index' +rst_prolog = """ +.. |llvm-version| replace:: {llvm_version} +""".format(llvm_version=ghc_config.llvm_version) + # General information about the project. project = u'Glasgow Haskell Compiler' copyright = u'2015, GHC Team' diff --git a/docs/users_guide/ghc_config.py.in b/docs/users_guide/ghc_config.py.in index 113d1b0..4ff77ad 100644 --- a/docs/users_guide/ghc_config.py.in +++ b/docs/users_guide/ghc_config.py.in @@ -16,3 +16,5 @@ lib_versions = { } version = '@ProjectVersion@' + +llvm_version = '@LlvmVersion@' diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst index 169cb36..da8a84b 100644 --- a/docs/users_guide/phases.rst +++ b/docs/users_guide/phases.rst @@ -527,6 +527,11 @@ Options affecting code generation via LLVM requires LLVM's :command:`opt` and :command:`llc` executables to be in :envvar:`PATH`. + .. note:: + + Note that this GHC release expects an LLVM version in the |llvm-version| + release series. + .. ghc-flag:: -fno-code :shortdesc: Omit code generation :type: dynamic From git at git.haskell.org Thu Dec 14 22:05:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:05:10 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: users-guide: Fix various bits of markup (15b2b95) Message-ID: <20171214220510.816733A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/15b2b959abbc724187b0e58979968d24ab323681/ghc >--------------------------------------------------------------- commit 15b2b959abbc724187b0e58979968d24ab323681 Author: Ben Gamari Date: Thu Dec 14 16:52:59 2017 -0500 users-guide: Fix various bits of markup >--------------------------------------------------------------- 15b2b959abbc724187b0e58979968d24ab323681 docs/users_guide/8.4.1-notes.rst | 18 +++++++++++++----- docs/users_guide/separate_compilation.rst | 10 +++++----- 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst index 7c2f954..6ad4cc5 100644 --- a/docs/users_guide/8.4.1-notes.rst +++ b/docs/users_guide/8.4.1-notes.rst @@ -13,7 +13,15 @@ Highlights The highlights, since the 8.2.1 release, are: -- Many, many bug fixes. +- GHC is now capable of deriving more instances + +- More refinement of the :ghc-flag:`-XTypeInType` story and improvements in type + error messages. + +- Further improvements in code generation + +- Many, many bug fixes. + Full details ------------ @@ -59,16 +67,16 @@ Language data StrictJust a <- Just !a where StrictJust !a = Just a -- GADTs with kind-polymorphic type arguments now require :ghc-flag:`TypeInType`. +- GADTs with kind-polymorphic type arguments now require :ghc-flag:`-XTypeInType`. For instance, consider the following, :: data G :: k -> * where GInt :: G Int GMaybe :: G Maybe - In previous releases this would compile with :ghc-flag:`PolyKinds` alone due + In previous releases this would compile with :ghc-flag:`-XPolyKinds` alone due to bug :ghc-ticket:`13391`. As of GHC 8.4, however, this requires - :ghc-flag:`TypeInType`. Note that since GADT kind signatures aren't generalized, + :ghc-flag:`-XTypeInType`. Note that since GADT kind signatures aren't generalized, this will also require that you provide a :ref:`CUSK ` by explicitly quantifying over the kind argument, ``k``, :: @@ -101,7 +109,7 @@ Language which require extensions to derive, such as :ghc-flag:`-XDeriveFunctor`. - Hexadecimal floating point literals (e.g. ``0x0.1p4``), enabled with - :ghc-flag:`HexFloatLiterals`. See + :ghc-flag:`-XHexFloatLiterals`. See :ref:`Hexadecimal floating point literals ` for the full details. diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst index 2375f63..e7501c2 100644 --- a/docs/users_guide/separate_compilation.rst +++ b/docs/users_guide/separate_compilation.rst @@ -544,17 +544,17 @@ The recompilation checker .. ghc-flag:: -fignore-optim-changes :shortdesc: Do not recompile modules just to match changes to - optimisation flags. This is especially useful for avoiding - recompilation when using GHCi, and is enabled by default for - GHCi. + optimisation flags. This is especially useful for avoiding + recompilation when using GHCi, and is enabled by default for + GHCi. :type: dynamic :reverse: -fno-ignore-optim-changes :category: recompilation .. ghc-flag:: -fignore-hpc-changes :shortdesc: Do not recompile modules just to match changes to - HPC flags. This is especially useful for avoiding recompilation - when using GHCi, and is enabled by default for GHCi. + HPC flags. This is especially useful for avoiding recompilation + when using GHCi, and is enabled by default for GHCi. :type: dynamic :reverse: -fno-ignore-hpc-changes :category: recompilation From git at git.haskell.org Thu Dec 14 22:05:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:05:16 +0000 (UTC) Subject: [commit: ghc] master: users-guide: Fix various bits of markup (4a331e6) Message-ID: <20171214220516.13C403A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4a331e659f636e28330142b6df90cb0772a19463/ghc >--------------------------------------------------------------- commit 4a331e659f636e28330142b6df90cb0772a19463 Author: Ben Gamari Date: Thu Dec 14 16:52:59 2017 -0500 users-guide: Fix various bits of markup (cherry picked from commit 15b2b959abbc724187b0e58979968d24ab323681) >--------------------------------------------------------------- 4a331e659f636e28330142b6df90cb0772a19463 docs/users_guide/8.4.1-notes.rst | 18 +++++++++++++----- docs/users_guide/separate_compilation.rst | 10 +++++----- 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst index 7c2f954..6ad4cc5 100644 --- a/docs/users_guide/8.4.1-notes.rst +++ b/docs/users_guide/8.4.1-notes.rst @@ -13,7 +13,15 @@ Highlights The highlights, since the 8.2.1 release, are: -- Many, many bug fixes. +- GHC is now capable of deriving more instances + +- More refinement of the :ghc-flag:`-XTypeInType` story and improvements in type + error messages. + +- Further improvements in code generation + +- Many, many bug fixes. + Full details ------------ @@ -59,16 +67,16 @@ Language data StrictJust a <- Just !a where StrictJust !a = Just a -- GADTs with kind-polymorphic type arguments now require :ghc-flag:`TypeInType`. +- GADTs with kind-polymorphic type arguments now require :ghc-flag:`-XTypeInType`. For instance, consider the following, :: data G :: k -> * where GInt :: G Int GMaybe :: G Maybe - In previous releases this would compile with :ghc-flag:`PolyKinds` alone due + In previous releases this would compile with :ghc-flag:`-XPolyKinds` alone due to bug :ghc-ticket:`13391`. As of GHC 8.4, however, this requires - :ghc-flag:`TypeInType`. Note that since GADT kind signatures aren't generalized, + :ghc-flag:`-XTypeInType`. Note that since GADT kind signatures aren't generalized, this will also require that you provide a :ref:`CUSK ` by explicitly quantifying over the kind argument, ``k``, :: @@ -101,7 +109,7 @@ Language which require extensions to derive, such as :ghc-flag:`-XDeriveFunctor`. - Hexadecimal floating point literals (e.g. ``0x0.1p4``), enabled with - :ghc-flag:`HexFloatLiterals`. See + :ghc-flag:`-XHexFloatLiterals`. See :ref:`Hexadecimal floating point literals ` for the full details. diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst index 2375f63..e7501c2 100644 --- a/docs/users_guide/separate_compilation.rst +++ b/docs/users_guide/separate_compilation.rst @@ -544,17 +544,17 @@ The recompilation checker .. ghc-flag:: -fignore-optim-changes :shortdesc: Do not recompile modules just to match changes to - optimisation flags. This is especially useful for avoiding - recompilation when using GHCi, and is enabled by default for - GHCi. + optimisation flags. This is especially useful for avoiding + recompilation when using GHCi, and is enabled by default for + GHCi. :type: dynamic :reverse: -fno-ignore-optim-changes :category: recompilation .. ghc-flag:: -fignore-hpc-changes :shortdesc: Do not recompile modules just to match changes to - HPC flags. This is especially useful for avoiding recompilation - when using GHCi, and is enabled by default for GHCi. + HPC flags. This is especially useful for avoiding recompilation + when using GHCi, and is enabled by default for GHCi. :type: dynamic :reverse: -fno-ignore-hpc-changes :category: recompilation From git at git.haskell.org Thu Dec 14 22:05:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:05:13 +0000 (UTC) Subject: [commit: ghc] master: users-guide: Consistently document LLVM version requirement (d4c8d89) Message-ID: <20171214220513.4A1333A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d4c8d895a477e66cc5d892de7d5f06a4068f9244/ghc >--------------------------------------------------------------- commit d4c8d895a477e66cc5d892de7d5f06a4068f9244 Author: Ben Gamari Date: Thu Dec 14 13:44:52 2017 -0500 users-guide: Consistently document LLVM version requirement (cherry picked from commit fdccc6666d838cf8708b9fc03a9ce2aa04fe9439) >--------------------------------------------------------------- d4c8d895a477e66cc5d892de7d5f06a4068f9244 docs/users_guide/8.4.1-notes.rst | 3 +++ docs/users_guide/codegens.rst | 15 ++++++++++----- docs/users_guide/conf.py | 4 ++++ docs/users_guide/ghc_config.py.in | 2 ++ docs/users_guide/phases.rst | 5 +++++ 5 files changed, 24 insertions(+), 5 deletions(-) diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst index 246a278..7c2f954 100644 --- a/docs/users_guide/8.4.1-notes.rst +++ b/docs/users_guide/8.4.1-notes.rst @@ -108,6 +108,9 @@ Language Compiler ~~~~~~~~ +- LLVM code generator (e.g. :ghc-flag:`-fllvm`) compatible with LLVM releases in + the |llvm-version| series. + - Add warning flag :ghc-flag:`-Wmissing-export-lists` which causes the type checker to warn when a module does not include an explicit export list. diff --git a/docs/users_guide/codegens.rst b/docs/users_guide/codegens.rst index 402e783..936d725 100644 --- a/docs/users_guide/codegens.rst +++ b/docs/users_guide/codegens.rst @@ -40,7 +40,7 @@ performance as good as the native code generator but for some cases can produce much faster code. This is especially true for numeric, array heavy code using packages like vector. The penalty is a significant increase in compilation times. Select the LLVM backend with the -``-fllvm`` flag. Currently *LLVM 2.8* and later are supported. +:ghc-flag:`-fllvm` flag. You must install and have LLVM available on your ``PATH`` for the LLVM code generator to work. Specifically GHC needs to be able to call the ``opt`` @@ -48,12 +48,17 @@ and ``llc`` tools. Secondly, if you are running Mac OS X with LLVM 3.0 or greater then you also need the `Clang C compiler `__ compiler available on your ``PATH``. +.. note:: + + Note that this GHC release expects an LLVM version in the |llvm-version| + release series. + To install LLVM and Clang: - *Linux*: Use your package management tool. - *Mac OS X*: Clang is included by default on recent OS X machines when - XCode is installed (from ``10.6`` and later). LLVM is not included. + XCode is installed (from 10.6 and later). LLVM is not included. In order to use the LLVM based code generator, you should install the `Homebrew `__ package manager for OS X. Alternatively you can download binaries for LLVM and Clang from @@ -73,7 +78,7 @@ C Code Generator (``-fvia-C``) This is the oldest code generator in GHC and is generally not included any more having been deprecated around GHC 7.0. Select it with the -``-fvia-C`` flag. +:ghc-flag:`-fvia-C` flag. The C code generator is only supported when GHC is built in unregisterised mode, a mode where GHC produces "portable" C code as @@ -81,7 +86,7 @@ output to facilitate porting GHC itself to a new platform. This mode produces much slower code though so it's unlikely your version of GHC was built this way. If it has then the native code generator probably won't be available. You can check this information by calling -``ghc --info`` (see :ref:`ghc-info`). +``ghc --info`` (see :ghc-flag:`--info`). .. _unreg: @@ -112,4 +117,4 @@ to build GHC with the appropriate options set. Consult the GHC Building Guide for details. You can check if your GHC is unregisterised by calling -``ghc --info`` (see :ref:`ghc-info`). +``ghc --info`` (see :ghc-flag:`--info`). diff --git a/docs/users_guide/conf.py b/docs/users_guide/conf.py index 4d4704a..ef7b9d5 100644 --- a/docs/users_guide/conf.py +++ b/docs/users_guide/conf.py @@ -24,6 +24,10 @@ source_suffix = '.rst' source_encoding = 'utf-8-sig' master_doc = 'index' +rst_prolog = """ +.. |llvm-version| replace:: {llvm_version} +""".format(llvm_version=ghc_config.llvm_version) + # General information about the project. project = u'Glasgow Haskell Compiler' copyright = u'2015, GHC Team' diff --git a/docs/users_guide/ghc_config.py.in b/docs/users_guide/ghc_config.py.in index 113d1b0..4ff77ad 100644 --- a/docs/users_guide/ghc_config.py.in +++ b/docs/users_guide/ghc_config.py.in @@ -16,3 +16,5 @@ lib_versions = { } version = '@ProjectVersion@' + +llvm_version = '@LlvmVersion@' diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst index 169cb36..da8a84b 100644 --- a/docs/users_guide/phases.rst +++ b/docs/users_guide/phases.rst @@ -527,6 +527,11 @@ Options affecting code generation via LLVM requires LLVM's :command:`opt` and :command:`llc` executables to be in :envvar:`PATH`. + .. note:: + + Note that this GHC release expects an LLVM version in the |llvm-version| + release series. + .. ghc-flag:: -fno-code :shortdesc: Omit code generation :type: dynamic From git at git.haskell.org Thu Dec 14 22:05:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:05:10 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: users-guide: Consistently document LLVM version requirement (fdccc66) Message-ID: <20171214220510.0F66D3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/fdccc6666d838cf8708b9fc03a9ce2aa04fe9439/ghc >--------------------------------------------------------------- commit fdccc6666d838cf8708b9fc03a9ce2aa04fe9439 Author: Ben Gamari Date: Thu Dec 14 13:44:52 2017 -0500 users-guide: Consistently document LLVM version requirement >--------------------------------------------------------------- fdccc6666d838cf8708b9fc03a9ce2aa04fe9439 docs/users_guide/8.4.1-notes.rst | 3 +++ docs/users_guide/codegens.rst | 15 ++++++++++----- docs/users_guide/conf.py | 4 ++++ docs/users_guide/ghc_config.py.in | 2 ++ docs/users_guide/phases.rst | 5 +++++ 5 files changed, 24 insertions(+), 5 deletions(-) diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst index 246a278..7c2f954 100644 --- a/docs/users_guide/8.4.1-notes.rst +++ b/docs/users_guide/8.4.1-notes.rst @@ -108,6 +108,9 @@ Language Compiler ~~~~~~~~ +- LLVM code generator (e.g. :ghc-flag:`-fllvm`) compatible with LLVM releases in + the |llvm-version| series. + - Add warning flag :ghc-flag:`-Wmissing-export-lists` which causes the type checker to warn when a module does not include an explicit export list. diff --git a/docs/users_guide/codegens.rst b/docs/users_guide/codegens.rst index 402e783..936d725 100644 --- a/docs/users_guide/codegens.rst +++ b/docs/users_guide/codegens.rst @@ -40,7 +40,7 @@ performance as good as the native code generator but for some cases can produce much faster code. This is especially true for numeric, array heavy code using packages like vector. The penalty is a significant increase in compilation times. Select the LLVM backend with the -``-fllvm`` flag. Currently *LLVM 2.8* and later are supported. +:ghc-flag:`-fllvm` flag. You must install and have LLVM available on your ``PATH`` for the LLVM code generator to work. Specifically GHC needs to be able to call the ``opt`` @@ -48,12 +48,17 @@ and ``llc`` tools. Secondly, if you are running Mac OS X with LLVM 3.0 or greater then you also need the `Clang C compiler `__ compiler available on your ``PATH``. +.. note:: + + Note that this GHC release expects an LLVM version in the |llvm-version| + release series. + To install LLVM and Clang: - *Linux*: Use your package management tool. - *Mac OS X*: Clang is included by default on recent OS X machines when - XCode is installed (from ``10.6`` and later). LLVM is not included. + XCode is installed (from 10.6 and later). LLVM is not included. In order to use the LLVM based code generator, you should install the `Homebrew `__ package manager for OS X. Alternatively you can download binaries for LLVM and Clang from @@ -73,7 +78,7 @@ C Code Generator (``-fvia-C``) This is the oldest code generator in GHC and is generally not included any more having been deprecated around GHC 7.0. Select it with the -``-fvia-C`` flag. +:ghc-flag:`-fvia-C` flag. The C code generator is only supported when GHC is built in unregisterised mode, a mode where GHC produces "portable" C code as @@ -81,7 +86,7 @@ output to facilitate porting GHC itself to a new platform. This mode produces much slower code though so it's unlikely your version of GHC was built this way. If it has then the native code generator probably won't be available. You can check this information by calling -``ghc --info`` (see :ref:`ghc-info`). +``ghc --info`` (see :ghc-flag:`--info`). .. _unreg: @@ -112,4 +117,4 @@ to build GHC with the appropriate options set. Consult the GHC Building Guide for details. You can check if your GHC is unregisterised by calling -``ghc --info`` (see :ref:`ghc-info`). +``ghc --info`` (see :ghc-flag:`--info`). diff --git a/docs/users_guide/conf.py b/docs/users_guide/conf.py index 4d4704a..ef7b9d5 100644 --- a/docs/users_guide/conf.py +++ b/docs/users_guide/conf.py @@ -24,6 +24,10 @@ source_suffix = '.rst' source_encoding = 'utf-8-sig' master_doc = 'index' +rst_prolog = """ +.. |llvm-version| replace:: {llvm_version} +""".format(llvm_version=ghc_config.llvm_version) + # General information about the project. project = u'Glasgow Haskell Compiler' copyright = u'2015, GHC Team' diff --git a/docs/users_guide/ghc_config.py.in b/docs/users_guide/ghc_config.py.in index 113d1b0..4ff77ad 100644 --- a/docs/users_guide/ghc_config.py.in +++ b/docs/users_guide/ghc_config.py.in @@ -16,3 +16,5 @@ lib_versions = { } version = '@ProjectVersion@' + +llvm_version = '@LlvmVersion@' diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst index 169cb36..da8a84b 100644 --- a/docs/users_guide/phases.rst +++ b/docs/users_guide/phases.rst @@ -527,6 +527,11 @@ Options affecting code generation via LLVM requires LLVM's :command:`opt` and :command:`llc` executables to be in :envvar:`PATH`. + .. note:: + + Note that this GHC release expects an LLVM version in the |llvm-version| + release series. + .. ghc-flag:: -fno-code :shortdesc: Omit code generation :type: dynamic From git at git.haskell.org Thu Dec 14 22:05:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:05:18 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: users-guide: Remove release notes for 8.2 (af117d9) Message-ID: <20171214220518.E1C213A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/af117d9800f547a5fc91f7d404c6a5c6df72f00d/ghc >--------------------------------------------------------------- commit af117d9800f547a5fc91f7d404c6a5c6df72f00d Author: Ben Gamari Date: Thu Dec 14 17:04:19 2017 -0500 users-guide: Remove release notes for 8.2 >--------------------------------------------------------------- af117d9800f547a5fc91f7d404c6a5c6df72f00d docs/users_guide/8.2.1-notes.rst | 527 --------------------------------------- docs/users_guide/index.rst | 1 - 2 files changed, 528 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 af117d9800f547a5fc91f7d404c6a5c6df72f00d From git at git.haskell.org Thu Dec 14 22:05:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:05:18 +0000 (UTC) Subject: [commit: ghc] master: users-guide: Fix various bits of markup (4a331e6) Message-ID: <20171214220518.5FB253A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4a331e659f636e28330142b6df90cb0772a19463/ghc >--------------------------------------------------------------- commit 4a331e659f636e28330142b6df90cb0772a19463 Author: Ben Gamari Date: Thu Dec 14 16:52:59 2017 -0500 users-guide: Fix various bits of markup (cherry picked from commit 15b2b959abbc724187b0e58979968d24ab323681) >--------------------------------------------------------------- 4a331e659f636e28330142b6df90cb0772a19463 docs/users_guide/8.4.1-notes.rst | 18 +++++++++++++----- docs/users_guide/separate_compilation.rst | 10 +++++----- 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst index 7c2f954..6ad4cc5 100644 --- a/docs/users_guide/8.4.1-notes.rst +++ b/docs/users_guide/8.4.1-notes.rst @@ -13,7 +13,15 @@ Highlights The highlights, since the 8.2.1 release, are: -- Many, many bug fixes. +- GHC is now capable of deriving more instances + +- More refinement of the :ghc-flag:`-XTypeInType` story and improvements in type + error messages. + +- Further improvements in code generation + +- Many, many bug fixes. + Full details ------------ @@ -59,16 +67,16 @@ Language data StrictJust a <- Just !a where StrictJust !a = Just a -- GADTs with kind-polymorphic type arguments now require :ghc-flag:`TypeInType`. +- GADTs with kind-polymorphic type arguments now require :ghc-flag:`-XTypeInType`. For instance, consider the following, :: data G :: k -> * where GInt :: G Int GMaybe :: G Maybe - In previous releases this would compile with :ghc-flag:`PolyKinds` alone due + In previous releases this would compile with :ghc-flag:`-XPolyKinds` alone due to bug :ghc-ticket:`13391`. As of GHC 8.4, however, this requires - :ghc-flag:`TypeInType`. Note that since GADT kind signatures aren't generalized, + :ghc-flag:`-XTypeInType`. Note that since GADT kind signatures aren't generalized, this will also require that you provide a :ref:`CUSK ` by explicitly quantifying over the kind argument, ``k``, :: @@ -101,7 +109,7 @@ Language which require extensions to derive, such as :ghc-flag:`-XDeriveFunctor`. - Hexadecimal floating point literals (e.g. ``0x0.1p4``), enabled with - :ghc-flag:`HexFloatLiterals`. See + :ghc-flag:`-XHexFloatLiterals`. See :ref:`Hexadecimal floating point literals ` for the full details. diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst index 2375f63..e7501c2 100644 --- a/docs/users_guide/separate_compilation.rst +++ b/docs/users_guide/separate_compilation.rst @@ -544,17 +544,17 @@ The recompilation checker .. ghc-flag:: -fignore-optim-changes :shortdesc: Do not recompile modules just to match changes to - optimisation flags. This is especially useful for avoiding - recompilation when using GHCi, and is enabled by default for - GHCi. + optimisation flags. This is especially useful for avoiding + recompilation when using GHCi, and is enabled by default for + GHCi. :type: dynamic :reverse: -fno-ignore-optim-changes :category: recompilation .. ghc-flag:: -fignore-hpc-changes :shortdesc: Do not recompile modules just to match changes to - HPC flags. This is especially useful for avoiding recompilation - when using GHCi, and is enabled by default for GHCi. + HPC flags. This is especially useful for avoiding recompilation + when using GHCi, and is enabled by default for GHCi. :type: dynamic :reverse: -fno-ignore-hpc-changes :category: recompilation From git at git.haskell.org Thu Dec 14 22:05:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:05:15 +0000 (UTC) Subject: [commit: ghc] master: users-guide: Consistently document LLVM version requirement (d4c8d89) Message-ID: <20171214220515.935953A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d4c8d895a477e66cc5d892de7d5f06a4068f9244/ghc >--------------------------------------------------------------- commit d4c8d895a477e66cc5d892de7d5f06a4068f9244 Author: Ben Gamari Date: Thu Dec 14 13:44:52 2017 -0500 users-guide: Consistently document LLVM version requirement (cherry picked from commit fdccc6666d838cf8708b9fc03a9ce2aa04fe9439) >--------------------------------------------------------------- d4c8d895a477e66cc5d892de7d5f06a4068f9244 docs/users_guide/8.4.1-notes.rst | 3 +++ docs/users_guide/codegens.rst | 15 ++++++++++----- docs/users_guide/conf.py | 4 ++++ docs/users_guide/ghc_config.py.in | 2 ++ docs/users_guide/phases.rst | 5 +++++ 5 files changed, 24 insertions(+), 5 deletions(-) diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst index 246a278..7c2f954 100644 --- a/docs/users_guide/8.4.1-notes.rst +++ b/docs/users_guide/8.4.1-notes.rst @@ -108,6 +108,9 @@ Language Compiler ~~~~~~~~ +- LLVM code generator (e.g. :ghc-flag:`-fllvm`) compatible with LLVM releases in + the |llvm-version| series. + - Add warning flag :ghc-flag:`-Wmissing-export-lists` which causes the type checker to warn when a module does not include an explicit export list. diff --git a/docs/users_guide/codegens.rst b/docs/users_guide/codegens.rst index 402e783..936d725 100644 --- a/docs/users_guide/codegens.rst +++ b/docs/users_guide/codegens.rst @@ -40,7 +40,7 @@ performance as good as the native code generator but for some cases can produce much faster code. This is especially true for numeric, array heavy code using packages like vector. The penalty is a significant increase in compilation times. Select the LLVM backend with the -``-fllvm`` flag. Currently *LLVM 2.8* and later are supported. +:ghc-flag:`-fllvm` flag. You must install and have LLVM available on your ``PATH`` for the LLVM code generator to work. Specifically GHC needs to be able to call the ``opt`` @@ -48,12 +48,17 @@ and ``llc`` tools. Secondly, if you are running Mac OS X with LLVM 3.0 or greater then you also need the `Clang C compiler `__ compiler available on your ``PATH``. +.. note:: + + Note that this GHC release expects an LLVM version in the |llvm-version| + release series. + To install LLVM and Clang: - *Linux*: Use your package management tool. - *Mac OS X*: Clang is included by default on recent OS X machines when - XCode is installed (from ``10.6`` and later). LLVM is not included. + XCode is installed (from 10.6 and later). LLVM is not included. In order to use the LLVM based code generator, you should install the `Homebrew `__ package manager for OS X. Alternatively you can download binaries for LLVM and Clang from @@ -73,7 +78,7 @@ C Code Generator (``-fvia-C``) This is the oldest code generator in GHC and is generally not included any more having been deprecated around GHC 7.0. Select it with the -``-fvia-C`` flag. +:ghc-flag:`-fvia-C` flag. The C code generator is only supported when GHC is built in unregisterised mode, a mode where GHC produces "portable" C code as @@ -81,7 +86,7 @@ output to facilitate porting GHC itself to a new platform. This mode produces much slower code though so it's unlikely your version of GHC was built this way. If it has then the native code generator probably won't be available. You can check this information by calling -``ghc --info`` (see :ref:`ghc-info`). +``ghc --info`` (see :ghc-flag:`--info`). .. _unreg: @@ -112,4 +117,4 @@ to build GHC with the appropriate options set. Consult the GHC Building Guide for details. You can check if your GHC is unregisterised by calling -``ghc --info`` (see :ref:`ghc-info`). +``ghc --info`` (see :ghc-flag:`--info`). diff --git a/docs/users_guide/conf.py b/docs/users_guide/conf.py index 4d4704a..ef7b9d5 100644 --- a/docs/users_guide/conf.py +++ b/docs/users_guide/conf.py @@ -24,6 +24,10 @@ source_suffix = '.rst' source_encoding = 'utf-8-sig' master_doc = 'index' +rst_prolog = """ +.. |llvm-version| replace:: {llvm_version} +""".format(llvm_version=ghc_config.llvm_version) + # General information about the project. project = u'Glasgow Haskell Compiler' copyright = u'2015, GHC Team' diff --git a/docs/users_guide/ghc_config.py.in b/docs/users_guide/ghc_config.py.in index 113d1b0..4ff77ad 100644 --- a/docs/users_guide/ghc_config.py.in +++ b/docs/users_guide/ghc_config.py.in @@ -16,3 +16,5 @@ lib_versions = { } version = '@ProjectVersion@' + +llvm_version = '@LlvmVersion@' diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst index 169cb36..da8a84b 100644 --- a/docs/users_guide/phases.rst +++ b/docs/users_guide/phases.rst @@ -527,6 +527,11 @@ Options affecting code generation via LLVM requires LLVM's :command:`opt` and :command:`llc` executables to be in :envvar:`PATH`. + .. note:: + + Note that this GHC release expects an LLVM version in the |llvm-version| + release series. + .. ghc-flag:: -fno-code :shortdesc: Omit code generation :type: dynamic From git at git.haskell.org Thu Dec 14 22:05:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Dec 2017 22:05:21 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: users-guide: Remove release notes for 8.2 (af117d9) Message-ID: <20171214220521.2E7853A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/af117d9800f547a5fc91f7d404c6a5c6df72f00d/ghc >--------------------------------------------------------------- commit af117d9800f547a5fc91f7d404c6a5c6df72f00d Author: Ben Gamari Date: Thu Dec 14 17:04:19 2017 -0500 users-guide: Remove release notes for 8.2 >--------------------------------------------------------------- af117d9800f547a5fc91f7d404c6a5c6df72f00d docs/users_guide/8.2.1-notes.rst | 527 --------------------------------------- docs/users_guide/index.rst | 1 - 2 files changed, 528 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 af117d9800f547a5fc91f7d404c6a5c6df72f00d From git at git.haskell.org Fri Dec 15 10:40:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Dec 2017 10:40:22 +0000 (UTC) Subject: [commit: ghc] wip/T14373: note tweaks (6c61ba8) Message-ID: <20171215104022.476BD3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/6c61ba85afc68a886addd683bd9029991d56a097/ghc >--------------------------------------------------------------- commit 6c61ba85afc68a886addd683bd9029991d56a097 Author: Gabor Greif Date: Fri Dec 15 11:36:28 2017 +0100 note tweaks >--------------------------------------------------------------- 6c61ba85afc68a886addd683bd9029991d56a097 compiler/codeGen/StgCmmExpr.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 93cea88..a793048 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -675,14 +675,14 @@ cgAlts _ _ _ _ = panic "cgAlts" -- Note [tagging big families] -- --- Previousy, only the small constructor families were tagged. --- This penalized greater unions which overflow the tag space +-- Previously, only the small constructor families were tagged. +-- This penalised greater unions which overflow the tag space -- of TAG_BITS (i.e. 3 on 32 resp. 7 constructors on 64 bit). -- But there is a clever way of combining pointer and info-table -- tagging. We now use 1..{2,6} as pointer-resident tags while -- {3,7} signifies we have to fall back and get the tag from the -- info-table. --- Consequently we now cascade switches because we have to check +-- Consequently we now cascade switches, because we have to check -- the tag first and when it is MAX_PTR_TAG then get the precise -- tag from the info table and switch on that. The only technically -- tricky part is that the default case needs (logical) duplication. From git at git.haskell.org Fri Dec 15 11:23:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Dec 2017 11:23:10 +0000 (UTC) Subject: [commit: ghc] master: Fix tcDataKindSig (6814945) Message-ID: <20171215112310.4D28D3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/68149452a793aedd8d468b689dc93fb2ba5ec436/ghc >--------------------------------------------------------------- commit 68149452a793aedd8d468b689dc93fb2ba5ec436 Author: Simon Peyton Jones Date: Fri Dec 15 09:29:12 2017 +0000 Fix tcDataKindSig This patch fixes an outright bug in tcDataKindSig, shown up in Trac of a data type declaration. See Note [TyConBinders for the result kind signature of a data type] I also took the opportunity to elminate the DataKindCheck argument and data type from tcDataKindSig, instead moving the check to the call site, which is easier to understand. >--------------------------------------------------------------- 68149452a793aedd8d468b689dc93fb2ba5ec436 compiler/typecheck/TcHsType.hs | 126 +++++++++++++++++------------ compiler/typecheck/TcInstDcls.hs | 20 ++--- compiler/typecheck/TcTyClsDecls.hs | 22 +++-- compiler/types/Type.hs | 16 +--- testsuite/tests/ghci/scripts/T13407.stdout | 2 +- testsuite/tests/polykinds/T14515.hs | 13 +++ testsuite/tests/polykinds/all.T | 1 + 7 files changed, 116 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 68149452a793aedd8d468b689dc93fb2ba5ec436 From git at git.haskell.org Fri Dec 15 14:19:04 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Dec 2017 14:19:04 +0000 (UTC) Subject: [commit: ghc] wip/T14373: WIP: cater for emitting pre-join label code in 'emitSwitch' (ffd0d09) Message-ID: <20171215141904.034BE3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/ffd0d09998839dbb53663b7f7af602230228c1e8/ghc >--------------------------------------------------------------- commit ffd0d09998839dbb53663b7f7af602230228c1e8 Author: Gabor Greif Date: Fri Dec 15 11:54:49 2017 +0100 WIP: cater for emitting pre-join label code in 'emitSwitch' >--------------------------------------------------------------- ffd0d09998839dbb53663b7f7af602230228c1e8 compiler/codeGen/StgCmmExpr.hs | 8 ++++---- compiler/codeGen/StgCmmUtils.hs | 9 +++++---- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index a793048..05492fc 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -307,7 +307,7 @@ cgCase (StgOpApp (StgPrimOp op) args _) bndr (AlgAlt tycon) alts ; (mb_deflt, branches) <- cgAlgAltRhss (NoGcInAlts,AssignedDirectly) (NonVoid bndr) alts -- See Note [GC for conditionals] - ; emitSwitch tag_expr branches mb_deflt 0 (tyConFamilySize tycon - 1) + ; emitSwitch tag_expr branches mb_deflt 0 (tyConFamilySize tycon - 1) (return ()) ; return AssignedDirectly } where @@ -620,7 +620,7 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts ; if small || null info then -- Yes, bndr_reg has constr. tag in ls bits emitSwitch tag_expr branches' mb_deflt 1 - $ if small then fam_sz else maxpt + (if small then fam_sz else maxpt) (return ()) else -- No, get exact tag from info table when mAX_PTR_TAG do @@ -636,14 +636,14 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts prelabel _ = return (Nothing, Nothing) (mb_deflt, mb_branch) <- prelabel mb_deflt - emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt + emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt (return ()) join_lbl <- newBlockId emit (mkBranch join_lbl) emitLabel infos_lbl let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) tag_expr = getConstrTag dflags untagged_ptr info0 = first pred <$> info - emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1) + emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1) (return ()) emitLabel join_lbl ; return AssignedDirectly } diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 07432c4..2e12b16 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -453,14 +453,15 @@ emitSwitch :: CmmExpr -- Tag to switch on -> ConTagZ -> ConTagZ -- Min and Max possible values; -- behaviour outside this range is -- undefined + -> FCode () -- code to insert before join label -> FCode () -- First, two rather common cases in which there is no work to do -emitSwitch _ [] (Just code) _ _ = emit (fst code) -emitSwitch _ [(_,code)] Nothing _ _ = emit (fst code) +emitSwitch _ [] (Just code) _ _ pj = emit (fst code) >> pj +emitSwitch _ [(_,code)] Nothing _ _ pj = emit (fst code) >> pj -- Right, off we go -emitSwitch tag_expr branches mb_deflt lo_tag hi_tag = do +emitSwitch tag_expr branches mb_deflt lo_tag hi_tag pj = do join_lbl <- newBlockId mb_deflt_lbl <- label_default join_lbl mb_deflt branches_lbls <- label_branches join_lbl branches @@ -472,7 +473,7 @@ emitSwitch tag_expr branches mb_deflt lo_tag hi_tag = do emit $ mk_discrete_switch False tag_expr' branches_lbls' mb_deflt_lbl range - emitLabel join_lbl + pj >> emitLabel join_lbl mk_discrete_switch :: Bool -- ^ Use signed comparisons -> CmmExpr From git at git.haskell.org Fri Dec 15 14:19:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Dec 2017 14:19:09 +0000 (UTC) Subject: [commit: ghc] wip/T14373: WIP: clean up (4bf7922) Message-ID: <20171215141909.917B83A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/4bf792264681119d3e55bc2c1116b7f4d6e5417b/ghc >--------------------------------------------------------------- commit 4bf792264681119d3e55bc2c1116b7f4d6e5417b Author: Gabor Greif Date: Fri Dec 15 12:07:20 2017 +0100 WIP: clean up >--------------------------------------------------------------- 4bf792264681119d3e55bc2c1116b7f4d6e5417b compiler/codeGen/StgCmmExpr.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index b53dfe5..5bb2528 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -637,15 +637,12 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts (mb_deflt, mb_branch) <- prelabel mb_deflt emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt - --join_lbl <- newBlockId - --emit (mkBranch join_lbl) (do emitLabel infos_lbl let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) tag_expr = getConstrTag dflags untagged_ptr info0 = first pred <$> info emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1) (pure ())) - --emitLabel join_lbl ; return AssignedDirectly } From git at git.haskell.org Fri Dec 15 14:19:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Dec 2017 14:19:06 +0000 (UTC) Subject: [commit: ghc] wip/T14373: WIP: use new pre-join ability of emitSwitch (d755a58) Message-ID: <20171215141906.C01F43A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/d755a5876866d68741ca6b7841348abf007801f7/ghc >--------------------------------------------------------------- commit d755a5876866d68741ca6b7841348abf007801f7 Author: Gabor Greif Date: Fri Dec 15 12:06:59 2017 +0100 WIP: use new pre-join ability of emitSwitch >--------------------------------------------------------------- d755a5876866d68741ca6b7841348abf007801f7 compiler/codeGen/StgCmmExpr.hs | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 05492fc..b53dfe5 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -307,7 +307,7 @@ cgCase (StgOpApp (StgPrimOp op) args _) bndr (AlgAlt tycon) alts ; (mb_deflt, branches) <- cgAlgAltRhss (NoGcInAlts,AssignedDirectly) (NonVoid bndr) alts -- See Note [GC for conditionals] - ; emitSwitch tag_expr branches mb_deflt 0 (tyConFamilySize tycon - 1) (return ()) + ; emitSwitch tag_expr branches mb_deflt 0 (tyConFamilySize tycon - 1) (pure ()) ; return AssignedDirectly } where @@ -620,7 +620,7 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts ; if small || null info then -- Yes, bndr_reg has constr. tag in ls bits emitSwitch tag_expr branches' mb_deflt 1 - (if small then fam_sz else maxpt) (return ()) + (if small then fam_sz else maxpt) (pure ()) else -- No, get exact tag from info table when mAX_PTR_TAG do @@ -636,15 +636,16 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts prelabel _ = return (Nothing, Nothing) (mb_deflt, mb_branch) <- prelabel mb_deflt - emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt (return ()) - join_lbl <- newBlockId - emit (mkBranch join_lbl) - emitLabel infos_lbl - let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) - tag_expr = getConstrTag dflags untagged_ptr - info0 = first pred <$> info - emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1) (return ()) - emitLabel join_lbl + emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt + --join_lbl <- newBlockId + --emit (mkBranch join_lbl) + (do emitLabel infos_lbl + let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) + tag_expr = getConstrTag dflags untagged_ptr + info0 = first pred <$> info + emitSwitch tag_expr info0 mb_branch + (maxpt - 1) (fam_sz - 1) (pure ())) + --emitLabel join_lbl ; return AssignedDirectly } From git at git.haskell.org Fri Dec 15 14:41:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Dec 2017 14:41:55 +0000 (UTC) Subject: [commit: ghc] wip/T14373: WIP: cover case where only have pj (8305a93) Message-ID: <20171215144155.20F593A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/8305a939944461392a01d55731c599a7bbe70c34/ghc >--------------------------------------------------------------- commit 8305a939944461392a01d55731c599a7bbe70c34 Author: Gabor Greif Date: Fri Dec 15 15:41:34 2017 +0100 WIP: cover case where only have pj >--------------------------------------------------------------- 8305a939944461392a01d55731c599a7bbe70c34 compiler/codeGen/StgCmmUtils.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 2e12b16..0b77bc9 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -456,9 +456,10 @@ emitSwitch :: CmmExpr -- Tag to switch on -> FCode () -- code to insert before join label -> FCode () --- First, two rather common cases in which there is no work to do +-- First, three rather common cases in which there is no work to do emitSwitch _ [] (Just code) _ _ pj = emit (fst code) >> pj emitSwitch _ [(_,code)] Nothing _ _ pj = emit (fst code) >> pj +emitSwitch _ [] Nothing _ _ pj = pj -- Right, off we go emitSwitch tag_expr branches mb_deflt lo_tag hi_tag pj = do From git at git.haskell.org Fri Dec 15 19:30:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Dec 2017 19:30:39 +0000 (UTC) Subject: [commit: ghc] master: Add some commentary re: fix to #11203 (3910d3e) Message-ID: <20171215193039.7510D3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3910d3e2f8b3084f6f6de3d9aeb8d8ed20670245/ghc >--------------------------------------------------------------- commit 3910d3e2f8b3084f6f6de3d9aeb8d8ed20670245 Author: Richard Eisenberg Date: Fri Dec 15 14:27:47 2017 -0500 Add some commentary re: fix to #11203 The fix for #11203 prohibits duplicate SigTvs in non-CUSK kind signatures by checking for duplicates after type inference is done. This works well. GHC also checks for duplicate SigTvs after working with partial type signatures (another place where SigTvs arise). However, neither fix eliminates this whole class of problems (because doing so would be heavier than we would like). So, this comment adds a warning to users of newSigTyVar to be aware of problems with duplicates. >--------------------------------------------------------------- 3910d3e2f8b3084f6f6de3d9aeb8d8ed20670245 compiler/typecheck/TcMType.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 7f2f92a..3d45129 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -583,6 +583,13 @@ instead of the buggous ************************************************************************ -} +-- a SigTv can unify with type *variables* only, including other SigTvs +-- and skolems. Sometimes, they can unify with type variables that the +-- user would rather keep distinct; see #11203 for an example. +-- So, any client of this +-- function needs to either allow the SigTvs to unify with each other +-- (say, for pattern-bound scoped type variables), or check that they +-- don't (say, with a call to findDubSigTvs). newSigTyVar :: Name -> Kind -> TcM TcTyVar newSigTyVar name kind = do { details <- newMetaDetails SigTv From git at git.haskell.org Sat Dec 16 12:12:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Dec 2017 12:12:46 +0000 (UTC) Subject: [commit: ghc] wip/T14373: Extra argument for emitting pre-join label code (af8914d) Message-ID: <20171216121246.AA4EE3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/af8914ddbd1eae626bd950a59a9e7032fc4e6c64/ghc >--------------------------------------------------------------- commit af8914ddbd1eae626bd950a59a9e7032fc4e6c64 Author: Gabor Greif Date: Fri Dec 15 11:54:49 2017 +0100 Extra argument for emitting pre-join label code in 'emitSwitch'. The former functionality can be recovered by passing `(pure ())`. Now we can eliminate the forming a the weird branch island around the switch on info-pointer tag (`cgAlts` in StgCmmExpr.hs). >--------------------------------------------------------------- af8914ddbd1eae626bd950a59a9e7032fc4e6c64 compiler/codeGen/StgCmmExpr.hs | 18 ++++++++---------- compiler/codeGen/StgCmmUtils.hs | 12 +++++++----- 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index a793048..5bb2528 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -307,7 +307,7 @@ cgCase (StgOpApp (StgPrimOp op) args _) bndr (AlgAlt tycon) alts ; (mb_deflt, branches) <- cgAlgAltRhss (NoGcInAlts,AssignedDirectly) (NonVoid bndr) alts -- See Note [GC for conditionals] - ; emitSwitch tag_expr branches mb_deflt 0 (tyConFamilySize tycon - 1) + ; emitSwitch tag_expr branches mb_deflt 0 (tyConFamilySize tycon - 1) (pure ()) ; return AssignedDirectly } where @@ -620,7 +620,7 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts ; if small || null info then -- Yes, bndr_reg has constr. tag in ls bits emitSwitch tag_expr branches' mb_deflt 1 - $ if small then fam_sz else maxpt + (if small then fam_sz else maxpt) (pure ()) else -- No, get exact tag from info table when mAX_PTR_TAG do @@ -637,14 +637,12 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts (mb_deflt, mb_branch) <- prelabel mb_deflt emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt - join_lbl <- newBlockId - emit (mkBranch join_lbl) - emitLabel infos_lbl - let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) - tag_expr = getConstrTag dflags untagged_ptr - info0 = first pred <$> info - emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1) - emitLabel join_lbl + (do emitLabel infos_lbl + let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) + tag_expr = getConstrTag dflags untagged_ptr + info0 = first pred <$> info + emitSwitch tag_expr info0 mb_branch + (maxpt - 1) (fam_sz - 1) (pure ())) ; return AssignedDirectly } diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 07432c4..0b77bc9 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -453,14 +453,16 @@ emitSwitch :: CmmExpr -- Tag to switch on -> ConTagZ -> ConTagZ -- Min and Max possible values; -- behaviour outside this range is -- undefined + -> FCode () -- code to insert before join label -> FCode () --- First, two rather common cases in which there is no work to do -emitSwitch _ [] (Just code) _ _ = emit (fst code) -emitSwitch _ [(_,code)] Nothing _ _ = emit (fst code) +-- First, three rather common cases in which there is no work to do +emitSwitch _ [] (Just code) _ _ pj = emit (fst code) >> pj +emitSwitch _ [(_,code)] Nothing _ _ pj = emit (fst code) >> pj +emitSwitch _ [] Nothing _ _ pj = pj -- Right, off we go -emitSwitch tag_expr branches mb_deflt lo_tag hi_tag = do +emitSwitch tag_expr branches mb_deflt lo_tag hi_tag pj = do join_lbl <- newBlockId mb_deflt_lbl <- label_default join_lbl mb_deflt branches_lbls <- label_branches join_lbl branches @@ -472,7 +474,7 @@ emitSwitch tag_expr branches mb_deflt lo_tag hi_tag = do emit $ mk_discrete_switch False tag_expr' branches_lbls' mb_deflt_lbl range - emitLabel join_lbl + pj >> emitLabel join_lbl mk_discrete_switch :: Bool -- ^ Use signed comparisons -> CmmExpr From git at git.haskell.org Sat Dec 16 13:48:29 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Dec 2017 13:48:29 +0000 (UTC) Subject: [commit: ghc] wip/T14373: WIP: test (089aef2) Message-ID: <20171216134829.588203A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/089aef2d8aeb0d606258ea743465a320811cd5e0/ghc >--------------------------------------------------------------- commit 089aef2d8aeb0d606258ea743465a320811cd5e0 Author: Gabor Greif Date: Sat Dec 16 14:47:59 2017 +0100 WIP: test >--------------------------------------------------------------- 089aef2d8aeb0d606258ea743465a320811cd5e0 testsuite/tests/codeGen/should_compile/T14373.hs | 7 +++++++ testsuite/tests/codeGen/should_compile/all.T | 1 + 2 files changed, 8 insertions(+) diff --git a/testsuite/tests/codeGen/should_compile/T14373.hs b/testsuite/tests/codeGen/should_compile/T14373.hs new file mode 100644 index 0000000..a1c42dd --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T14373.hs @@ -0,0 +1,7 @@ +module T14373 where + +data BigFam = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P deriving Enum + +{-# NOINLINE lateSwitch #-} + +lateSwitch P = "Cool" diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index 6ae4e1c..350b662 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -35,3 +35,4 @@ test('T10667', [ when((arch('powerpc64') or arch('powerpc64le')), compile, ['-g']) test('T12115', normal, compile, ['']) test('T12355', normal, compile, ['']) +test('T14373', normal, compile, ['']) From git at git.haskell.org Mon Dec 18 08:36:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 08:36:28 +0000 (UTC) Subject: [commit: ghc] wip/T14373: WIP: reorg (d3b2ae9) Message-ID: <20171218083628.7FF033A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/d3b2ae9fa6246061e426f3c4a285519277057a9c/ghc >--------------------------------------------------------------- commit d3b2ae9fa6246061e426f3c4a285519277057a9c Author: Gabor Greif Date: Sat Dec 16 16:41:48 2017 +0100 WIP: reorg >--------------------------------------------------------------- d3b2ae9fa6246061e426f3c4a285519277057a9c .../tests/codeGen/should_compile/{T14373.hs => T14373-common.hs} | 4 ---- testsuite/tests/codeGen/should_compile/T14373.hs | 5 +++-- testsuite/tests/codeGen/should_compile/all.T | 2 +- 3 files changed, 4 insertions(+), 7 deletions(-) diff --git a/testsuite/tests/codeGen/should_compile/T14373.hs b/testsuite/tests/codeGen/should_compile/T14373-common.hs similarity index 68% copy from testsuite/tests/codeGen/should_compile/T14373.hs copy to testsuite/tests/codeGen/should_compile/T14373-common.hs index a1c42dd..98015ce 100644 --- a/testsuite/tests/codeGen/should_compile/T14373.hs +++ b/testsuite/tests/codeGen/should_compile/T14373-common.hs @@ -1,7 +1,3 @@ module T14373 where data BigFam = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P deriving Enum - -{-# NOINLINE lateSwitch #-} - -lateSwitch P = "Cool" diff --git a/testsuite/tests/codeGen/should_compile/T14373.hs b/testsuite/tests/codeGen/should_compile/T14373.hs index a1c42dd..35434d1 100644 --- a/testsuite/tests/codeGen/should_compile/T14373.hs +++ b/testsuite/tests/codeGen/should_compile/T14373.hs @@ -1,7 +1,8 @@ -module T14373 where +{-# OPTIONS_GHC -ddump-cmm-from-stg -dsuppress-uniques #-} -data BigFam = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P deriving Enum +import T14373 {-# NOINLINE lateSwitch #-} + lateSwitch P = "Cool" diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index 350b662..b78a13e 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -35,4 +35,4 @@ test('T10667', [ when((arch('powerpc64') or arch('powerpc64le')), compile, ['-g']) test('T12115', normal, compile, ['']) test('T12355', normal, compile, ['']) -test('T14373', normal, compile, ['']) +test('T14373a', normal, compile, ['']) From git at git.haskell.org Mon Dec 18 08:36:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 08:36:31 +0000 (UTC) Subject: [commit: ghc] wip/T14373: WIP: works, but still too much (035a725) Message-ID: <20171218083631.B77863A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/035a725c5ef51a2fcf51a17b43057c6f2b50913c/ghc >--------------------------------------------------------------- commit 035a725c5ef51a2fcf51a17b43057c6f2b50913c Author: Gabor Greif Date: Sun Dec 17 12:31:25 2017 +0100 WIP: works, but still too much >--------------------------------------------------------------- 035a725c5ef51a2fcf51a17b43057c6f2b50913c testsuite/tests/codeGen/should_compile/T14373-common.hs | 3 --- testsuite/tests/codeGen/should_compile/T14373.hs | 9 ++------- testsuite/tests/codeGen/should_compile/{T14373.hs => T14373a.hs} | 6 ++---- testsuite/tests/codeGen/should_compile/all.T | 5 ++++- 4 files changed, 8 insertions(+), 15 deletions(-) diff --git a/testsuite/tests/codeGen/should_compile/T14373-common.hs b/testsuite/tests/codeGen/should_compile/T14373-common.hs deleted file mode 100644 index 98015ce..0000000 --- a/testsuite/tests/codeGen/should_compile/T14373-common.hs +++ /dev/null @@ -1,3 +0,0 @@ -module T14373 where - -data BigFam = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P deriving Enum diff --git a/testsuite/tests/codeGen/should_compile/T14373.hs b/testsuite/tests/codeGen/should_compile/T14373.hs index 35434d1..9ab2242 100644 --- a/testsuite/tests/codeGen/should_compile/T14373.hs +++ b/testsuite/tests/codeGen/should_compile/T14373.hs @@ -1,8 +1,3 @@ -{-# OPTIONS_GHC -ddump-cmm-from-stg -dsuppress-uniques #-} +module T14373 where -import T14373 - -{-# NOINLINE lateSwitch #-} - - -lateSwitch P = "Cool" +data BigFam = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P deriving (Enum, Show) diff --git a/testsuite/tests/codeGen/should_compile/T14373.hs b/testsuite/tests/codeGen/should_compile/T14373a.hs similarity index 51% copy from testsuite/tests/codeGen/should_compile/T14373.hs copy to testsuite/tests/codeGen/should_compile/T14373a.hs index 35434d1..7cce120 100644 --- a/testsuite/tests/codeGen/should_compile/T14373.hs +++ b/testsuite/tests/codeGen/should_compile/T14373a.hs @@ -1,8 +1,6 @@ -{-# OPTIONS_GHC -ddump-cmm-from-stg -dsuppress-uniques #-} - import T14373 {-# NOINLINE lateSwitch #-} - - lateSwitch P = "Cool" + +main = putStrLn $ lateSwitch P diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index b78a13e..4ee2dbf 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -35,4 +35,7 @@ test('T10667', [ when((arch('powerpc64') or arch('powerpc64le')), compile, ['-g']) test('T12115', normal, compile, ['']) test('T12355', normal, compile, ['']) -test('T14373a', normal, compile, ['']) +#test('T14373', [extra_files(['T14373.hs', 'T14373a.hs'])], +# multimod_compile, ['']) +test('T14373', [], + multimod_compile, ['T14373a', '-O2 -c -ddump-cmm-from-stg -dsuppress-uniques']) From git at git.haskell.org Mon Dec 18 08:36:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 08:36:34 +0000 (UTC) Subject: [commit: ghc] wip/T14373: WIP: something wrong, what does Travis say? (9c44e0b) Message-ID: <20171218083634.9ED0F3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/9c44e0b631022acb9468b522f1f9272225d3ef2e/ghc >--------------------------------------------------------------- commit 9c44e0b631022acb9468b522f1f9272225d3ef2e Author: Gabor Greif Date: Mon Dec 18 09:34:08 2017 +0100 WIP: something wrong, what does Travis say? >--------------------------------------------------------------- 9c44e0b631022acb9468b522f1f9272225d3ef2e compiler/codeGen/StgCmmExpr.hs | 46 +++++++++++++++++++++++------------------- 1 file changed, 25 insertions(+), 21 deletions(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 5bb2528..446e421 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -609,7 +609,7 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts ; let fam_sz = tyConFamilySize tycon bndr_reg = CmmLocal (idToReg dflags bndr) - tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg) + ptag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg) branches' = first succ <$> branches maxpt = mAX_PTR_TAG dflags (ptr, info) = partition ((< maxpt) . fst) branches' @@ -619,30 +619,34 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts -- See Note [tagging big families] ; if small || null info then -- Yes, bndr_reg has constr. tag in ls bits - emitSwitch tag_expr branches' mb_deflt 1 + emitSwitch ptag_expr branches' mb_deflt 1 (if small then fam_sz else maxpt) (pure ()) else -- No, get exact tag from info table when mAX_PTR_TAG do - infos_lbl <- newBlockId -- branch destination for - -- info pointer lookup - infos_scp <- getTickScope - - let catchall = (maxpt, (mkBranch infos_lbl, infos_scp)) - prelabel (Just (stmts, scp)) = - do lbl <- newBlockId - return ( Just (mkLabel lbl scp <*> stmts, scp) - , Just (mkBranch lbl, scp)) - prelabel _ = return (Nothing, Nothing) - - (mb_deflt, mb_branch) <- prelabel mb_deflt - emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt - (do emitLabel infos_lbl - let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) - tag_expr = getConstrTag dflags untagged_ptr - info0 = first pred <$> info - emitSwitch tag_expr info0 mb_branch - (maxpt - 1) (fam_sz - 1) (pure ())) + let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) + itag_expr = getConstrTag dflags untagged_ptr + info0 = first pred <$> info + if null ptr then + emitSwitch itag_expr info0 mb_deflt 0 (fam_sz - 1) (pure ()) + else do + infos_lbl <- newBlockId -- branch destination for + -- info pointer lookup + infos_scp <- getTickScope + + let catchall = (maxpt, (mkBranch infos_lbl, infos_scp)) + prelabel (Just (stmts, scp)) = + do lbl <- newBlockId + return ( Just (mkLabel lbl scp <*> stmts, scp) + , Just (mkBranch lbl, scp)) + prelabel _ = return (Nothing, Nothing) + + (mb_deflt, mb_branch) <- prelabel mb_deflt + + emitSwitch ptag_expr (catchall : ptr) mb_deflt 1 maxpt + (do emitLabel infos_lbl + emitSwitch itag_expr info0 mb_branch + (maxpt - 1) (fam_sz - 1) (pure ())) ; return AssignedDirectly } From git at git.haskell.org Mon Dec 18 12:40:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 12:40:18 +0000 (UTC) Subject: [commit: ghc] wip/T14373: Handle the case when ptr tag is telling no story (83c89b3) Message-ID: <20171218124018.8A1A73A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/83c89b3b5e47c90810c2d47ed39884d3ab439612/ghc >--------------------------------------------------------------- commit 83c89b3b5e47c90810c2d47ed39884d3ab439612 Author: Gabor Greif Date: Sat Dec 16 14:47:59 2017 +0100 Handle the case when ptr tag is telling no story e.g. when we only `\case Fifteenth -> ...`, and add a corresponding test. >--------------------------------------------------------------- 83c89b3b5e47c90810c2d47ed39884d3ab439612 compiler/codeGen/StgCmmExpr.hs | 46 ++++++++++++----------- testsuite/tests/codeGen/should_compile/T14373.hs | 3 ++ testsuite/tests/codeGen/should_compile/T14373a.hs | 6 +++ testsuite/tests/codeGen/should_compile/all.T | 4 ++ 4 files changed, 38 insertions(+), 21 deletions(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 5bb2528..446e421 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -609,7 +609,7 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts ; let fam_sz = tyConFamilySize tycon bndr_reg = CmmLocal (idToReg dflags bndr) - tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg) + ptag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg) branches' = first succ <$> branches maxpt = mAX_PTR_TAG dflags (ptr, info) = partition ((< maxpt) . fst) branches' @@ -619,30 +619,34 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts -- See Note [tagging big families] ; if small || null info then -- Yes, bndr_reg has constr. tag in ls bits - emitSwitch tag_expr branches' mb_deflt 1 + emitSwitch ptag_expr branches' mb_deflt 1 (if small then fam_sz else maxpt) (pure ()) else -- No, get exact tag from info table when mAX_PTR_TAG do - infos_lbl <- newBlockId -- branch destination for - -- info pointer lookup - infos_scp <- getTickScope - - let catchall = (maxpt, (mkBranch infos_lbl, infos_scp)) - prelabel (Just (stmts, scp)) = - do lbl <- newBlockId - return ( Just (mkLabel lbl scp <*> stmts, scp) - , Just (mkBranch lbl, scp)) - prelabel _ = return (Nothing, Nothing) - - (mb_deflt, mb_branch) <- prelabel mb_deflt - emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt - (do emitLabel infos_lbl - let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) - tag_expr = getConstrTag dflags untagged_ptr - info0 = first pred <$> info - emitSwitch tag_expr info0 mb_branch - (maxpt - 1) (fam_sz - 1) (pure ())) + let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) + itag_expr = getConstrTag dflags untagged_ptr + info0 = first pred <$> info + if null ptr then + emitSwitch itag_expr info0 mb_deflt 0 (fam_sz - 1) (pure ()) + else do + infos_lbl <- newBlockId -- branch destination for + -- info pointer lookup + infos_scp <- getTickScope + + let catchall = (maxpt, (mkBranch infos_lbl, infos_scp)) + prelabel (Just (stmts, scp)) = + do lbl <- newBlockId + return ( Just (mkLabel lbl scp <*> stmts, scp) + , Just (mkBranch lbl, scp)) + prelabel _ = return (Nothing, Nothing) + + (mb_deflt, mb_branch) <- prelabel mb_deflt + + emitSwitch ptag_expr (catchall : ptr) mb_deflt 1 maxpt + (do emitLabel infos_lbl + emitSwitch itag_expr info0 mb_branch + (maxpt - 1) (fam_sz - 1) (pure ())) ; return AssignedDirectly } diff --git a/testsuite/tests/codeGen/should_compile/T14373.hs b/testsuite/tests/codeGen/should_compile/T14373.hs new file mode 100644 index 0000000..9ab2242 --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T14373.hs @@ -0,0 +1,3 @@ +module T14373 where + +data BigFam = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P deriving (Enum, Show) diff --git a/testsuite/tests/codeGen/should_compile/T14373a.hs b/testsuite/tests/codeGen/should_compile/T14373a.hs new file mode 100644 index 0000000..7cce120 --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T14373a.hs @@ -0,0 +1,6 @@ +import T14373 + +{-# NOINLINE lateSwitch #-} +lateSwitch P = "Cool" + +main = putStrLn $ lateSwitch P diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index 6ae4e1c..4ee2dbf 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -35,3 +35,7 @@ test('T10667', [ when((arch('powerpc64') or arch('powerpc64le')), compile, ['-g']) test('T12115', normal, compile, ['']) test('T12355', normal, compile, ['']) +#test('T14373', [extra_files(['T14373.hs', 'T14373a.hs'])], +# multimod_compile, ['']) +test('T14373', [], + multimod_compile, ['T14373a', '-O2 -c -ddump-cmm-from-stg -dsuppress-uniques']) From git at git.haskell.org Mon Dec 18 15:47:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 15:47:38 +0000 (UTC) Subject: [commit: ghc] master: Add missing case to HsExpr.isMonadFailStmtContext (23b5b80) Message-ID: <20171218154738.A86243A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/23b5b80418e219f0c0c27f0e37a08ccdc0045e87/ghc >--------------------------------------------------------------- commit 23b5b80418e219f0c0c27f0e37a08ccdc0045e87 Author: Simon Peyton Jones Date: Mon Dec 18 11:55:16 2017 +0000 Add missing case to HsExpr.isMonadFailStmtContext This fixes Trac #14591 I took the opportunity to delete the dead code isMonadCompExpr >--------------------------------------------------------------- 23b5b80418e219f0c0c27f0e37a08ccdc0045e87 compiler/hsSyn/HsExpr.hs | 23 ++++++++++------------ .../mc20.hs => rename/should_fail/T14591.hs} | 7 ++----- testsuite/tests/rename/should_fail/T14591.stderr | 2 ++ testsuite/tests/rename/should_fail/all.T | 1 + 4 files changed, 15 insertions(+), 18 deletions(-) diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index fedaa44..de0e473 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -1978,7 +1978,8 @@ pprStmt (LetStmt (L _ binds)) = hsep [text "let", pprBinds binds] pprStmt (BodyStmt expr _ _ _) = ppr expr pprStmt (ParStmt stmtss _ _ _) = sep (punctuate (text " | ") (map ppr stmtss)) -pprStmt (TransStmt { trS_stmts = stmts, trS_by = by, trS_using = using, trS_form = form }) +pprStmt (TransStmt { trS_stmts = stmts, trS_by = by + , trS_using = using, trS_form = form }) = sep $ punctuate comma (map ppr stmts ++ [pprTransStmt by using form]) pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids @@ -2464,22 +2465,18 @@ isListCompExpr PArrComp = True isListCompExpr MonadComp = True isListCompExpr (ParStmtCtxt c) = isListCompExpr c isListCompExpr (TransStmtCtxt c) = isListCompExpr c -isListCompExpr _ = False - -isMonadCompExpr :: HsStmtContext id -> Bool -isMonadCompExpr MonadComp = True -isMonadCompExpr (ParStmtCtxt ctxt) = isMonadCompExpr ctxt -isMonadCompExpr (TransStmtCtxt ctxt) = isMonadCompExpr ctxt -isMonadCompExpr _ = False +isListCompExpr _ = False -- | Should pattern match failure in a 'HsStmtContext' be desugared using -- 'MonadFail'? isMonadFailStmtContext :: HsStmtContext id -> Bool -isMonadFailStmtContext MonadComp = True -isMonadFailStmtContext DoExpr = True -isMonadFailStmtContext MDoExpr = True -isMonadFailStmtContext GhciStmtCtxt = True -isMonadFailStmtContext _ = False +isMonadFailStmtContext MonadComp = True +isMonadFailStmtContext DoExpr = True +isMonadFailStmtContext MDoExpr = True +isMonadFailStmtContext GhciStmtCtxt = True +isMonadFailStmtContext (ParStmtCtxt ctxt) = isMonadFailStmtContext ctxt +isMonadFailStmtContext (TransStmtCtxt ctxt) = isMonadFailStmtContext ctxt +isMonadFailStmtContext _ = False -- ListComp, PArrComp, PatGuard, ArrowExpr matchSeparator :: HsMatchContext id -> SDoc matchSeparator (FunRhs {}) = text "=" diff --git a/testsuite/tests/typecheck/should_fail/mc20.hs b/testsuite/tests/rename/should_fail/T14591.hs similarity index 83% copy from testsuite/tests/typecheck/should_fail/mc20.hs copy to testsuite/tests/rename/should_fail/T14591.hs index efdfd5b..4431342 100644 --- a/testsuite/tests/typecheck/should_fail/mc20.hs +++ b/testsuite/tests/rename/should_fail/T14591.hs @@ -1,15 +1,12 @@ - -- Checks that the ordering constraint on the groupWith function is respected - {-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-} -module ShouldFail where +module T14591 where import GHC.Exts (groupWith) data Unorderable = Gnorf | Pinky | Brain - foo = [ () - | x <- [Gnorf, Brain] + | Gnorf <- [Gnorf, Brain] , then group by x using groupWith ] diff --git a/testsuite/tests/rename/should_fail/T14591.stderr b/testsuite/tests/rename/should_fail/T14591.stderr new file mode 100644 index 0000000..47e4df0 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T14591.stderr @@ -0,0 +1,2 @@ + +T14591.hs:11:23: error: Variable not in scope: x diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index 2a85d89..fb53d33 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -129,3 +129,4 @@ test('T13568', normal, multimod_compile_fail, ['T13568','-v0']) test('T13947', normal, compile_fail, ['']) test('T13847', normal, multimod_compile_fail, ['T13847','-v0']) test('T14307', normal, compile_fail, ['']) +test('T14591', normal, compile_fail, ['']) From git at git.haskell.org Mon Dec 18 15:47:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 15:47:41 +0000 (UTC) Subject: [commit: ghc] master: Tiny refactor: use mkTyVarNamePairs (1e64fc8) Message-ID: <20171218154741.727953A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1e64fc81295ac27c5e662576da3afacd42186a13/ghc >--------------------------------------------------------------- commit 1e64fc81295ac27c5e662576da3afacd42186a13 Author: Simon Peyton Jones Date: Mon Dec 18 12:01:58 2017 +0000 Tiny refactor: use mkTyVarNamePairs >--------------------------------------------------------------- 1e64fc81295ac27c5e662576da3afacd42186a13 compiler/typecheck/TcEnv.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index 21b895e..eac6d9f 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -403,7 +403,7 @@ tcExtendKindEnv extra_env thing_inside -- Scoped type and kind variables tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r tcExtendTyVarEnv tvs thing_inside - = tcExtendTyVarEnv2 [(tyVarName tv, tv) | tv <- tvs] thing_inside + = tcExtendTyVarEnv2 (mkTyVarNamePairs tvs) thing_inside tcExtendTyVarEnv2 :: [(Name,TcTyVar)] -> TcM r -> TcM r tcExtendTyVarEnv2 binds thing_inside From git at git.haskell.org Mon Dec 18 15:47:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 15:47:45 +0000 (UTC) Subject: [commit: ghc] master: Fix scoping of pattern-synonym existentials (f1fe5b4) Message-ID: <20171218154745.54B363A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f1fe5b4adf6a4094ecc600a28f64f7628903d017/ghc >--------------------------------------------------------------- commit f1fe5b4adf6a4094ecc600a28f64f7628903d017 Author: Simon Peyton Jones Date: Mon Dec 18 12:03:33 2017 +0000 Fix scoping of pattern-synonym existentials This patch fixes Trac #14998, where we eventually decided that the existential type variables of the signature of a pattern synonym should not scope over the pattern synonym. See Note [Pattern synonym existentials do not scope] in TcPatSyn. >--------------------------------------------------------------- f1fe5b4adf6a4094ecc600a28f64f7628903d017 compiler/basicTypes/PatSyn.hs | 2 +- compiler/typecheck/TcHsType.hs | 12 +-- compiler/typecheck/TcPatSyn.hs | 95 +++++++++++++++++++++++ compiler/typecheck/TcRnTypes.hs | 5 ++ compiler/typecheck/TcSigs.hs | 43 +--------- docs/users_guide/glasgow_exts.rst | 18 ++++- testsuite/tests/patsyn/should_fail/T11265.stderr | 2 +- testsuite/tests/patsyn/should_fail/T14498.hs | 32 ++++++++ testsuite/tests/patsyn/should_fail/T14498.stderr | 8 ++ testsuite/tests/patsyn/should_fail/T9161-1.stderr | 5 +- testsuite/tests/patsyn/should_fail/T9161-2.stderr | 5 +- testsuite/tests/patsyn/should_fail/all.T | 1 + testsuite/tests/polykinds/T5716.stderr | 10 +-- testsuite/tests/polykinds/T7433.stderr | 10 +-- 14 files changed, 182 insertions(+), 66 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f1fe5b4adf6a4094ecc600a28f64f7628903d017 From git at git.haskell.org Mon Dec 18 16:24:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 16:24:38 +0000 (UTC) Subject: [commit: ghc] master: Blackholes can be large objects (#14497) (fb1f0a4) Message-ID: <20171218162438.B467B3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fb1f0a46983a887057de647eaaae9e83b5ebebd1/ghc >--------------------------------------------------------------- commit fb1f0a46983a887057de647eaaae9e83b5ebebd1 Author: Simon Marlow Date: Mon Dec 18 11:23:16 2017 -0500 Blackholes can be large objects (#14497) Test Plan: validate Reviewers: bgamari, niteria, erikd, dfeuer Reviewed By: dfeuer Subscribers: Yuras, dfeuer, rwbarton, thomie, carter GHC Trac Issues: #14497 Differential Revision: https://phabricator.haskell.org/D4254 >--------------------------------------------------------------- fb1f0a46983a887057de647eaaae9e83b5ebebd1 rts/sm/Evac.c | 13 ++++++++++--- testsuite/tests/rts/T14497.hs | 13 +++++++++++++ .../IOError002.stdout => testsuite/tests/rts/T14497.stdout | 0 testsuite/tests/rts/all.T | 1 + 4 files changed, 24 insertions(+), 3 deletions(-) diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c index fb1af0f..526f063 100644 --- a/rts/sm/Evac.c +++ b/rts/sm/Evac.c @@ -898,9 +898,16 @@ evacuate_BLACKHOLE(StgClosure **p) bd = Bdescr((P_)q); - // blackholes can't be in a compact, or large - ASSERT((bd->flags & (BF_COMPACT | BF_LARGE)) == 0); - + // blackholes can't be in a compact + ASSERT((bd->flags & BF_COMPACT) == 0); + + // blackholes *can* be in a large object: when raiseAsync() creates an + // AP_STACK the payload might be large enough to create a large object. + // See #14497. + if (bd->flags & BF_LARGE) { + evacuate_large((P_)q); + return; + } if (bd->flags & BF_EVACUATED) { if (bd->gen_no < gct->evac_gen_no) { gct->failed_to_evac = true; diff --git a/testsuite/tests/rts/T14497.hs b/testsuite/tests/rts/T14497.hs new file mode 100644 index 0000000..b6473f7 --- /dev/null +++ b/testsuite/tests/rts/T14497.hs @@ -0,0 +1,13 @@ +module Main (main) where + +import System.Timeout + +fuc :: Integer -> Integer +fuc 0 = 1 +fuc n = n * fuc (n - 1) + +main :: IO () +main = do + let x = fuc 30000 + timeout 1000 (print x) + print (x > 0) diff --git a/libraries/base/tests/IO/IOError002.stdout b/testsuite/tests/rts/T14497.stdout similarity index 100% copy from libraries/base/tests/IO/IOError002.stdout copy to testsuite/tests/rts/T14497.stdout diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index d5eaa76..7c5b9c7 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -381,3 +381,4 @@ test('T12497', [ unless(opsys('mingw32'), skip) test('T12903', [when(opsys('mingw32'), skip)], compile_and_run, ['']) test('T13832', exit_code(1), compile_and_run, ['-threaded']) test('T13894', normal, compile_and_run, ['']) +test('T14497', normal, compile_and_run, ['-O']) From git at git.haskell.org Mon Dec 18 16:32:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 16:32:44 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Exit with non-zero exit code when tests fail (0302439) Message-ID: <20171218163244.E88653A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/030243953d522f2f8185ae417869a94d5f86210f/ghc >--------------------------------------------------------------- commit 030243953d522f2f8185ae417869a94d5f86210f Author: Ben Gamari Date: Thu Dec 14 17:08:36 2017 -0500 testsuite: Exit with non-zero exit code when tests fail >--------------------------------------------------------------- 030243953d522f2f8185ae417869a94d5f86210f testsuite/driver/runtests.py | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index db17f3b..74a152e 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -323,7 +323,14 @@ else: if args.junit: junit(t).write(args.junit) -cleanup_and_exit(0) +if len(t.unexpected_failures) > 0 or \ + len(t.unexpected_stat_failures) > 0 or \ + len(t.framework_failures) > 0: + exitcode = 1 +else: + exitcode = 0 + +cleanup_and_exit(exitcode) # Note [Running tests in /tmp] # From git at git.haskell.org Mon Dec 18 16:32:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 16:32:47 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Semigroup/Monoid compat for T3001-2 (8c9906c) Message-ID: <20171218163247.BB6233A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8c9906c5ce3f9ebd6417a1cdbe3e2a007c4cccd0/ghc >--------------------------------------------------------------- commit 8c9906c5ce3f9ebd6417a1cdbe3e2a007c4cccd0 Author: Ben Gamari Date: Thu Dec 14 17:26:43 2017 -0500 testsuite: Semigroup/Monoid compat for T3001-2 >--------------------------------------------------------------- 8c9906c5ce3f9ebd6417a1cdbe3e2a007c4cccd0 testsuite/tests/profiling/should_run/T3001-2.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/profiling/should_run/T3001-2.hs b/testsuite/tests/profiling/should_run/T3001-2.hs index 5a84dcc..17fa0c9 100644 --- a/testsuite/tests/profiling/should_run/T3001-2.hs +++ b/testsuite/tests/profiling/should_run/T3001-2.hs @@ -7,7 +7,7 @@ module Main (main) where -import Data.Monoid +import Data.Semigroup import Data.ByteString.Internal (inlinePerformIO) @@ -284,6 +284,9 @@ flush = Builder $ \ k buf@(Buffer p o u l) -> emptyBuilder :: Builder emptyBuilder = Builder id +instance Semigroup Builder where + (<>) = append + instance Monoid Builder where mempty = emptyBuilder mappend = append From git at git.haskell.org Mon Dec 18 17:27:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 17:27:28 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T12919' created Message-ID: <20171218172728.374DF3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T12919 Referencing: 5abaa92b73046bddcb7ef83f09704cc3c6dd13f7 From git at git.haskell.org Mon Dec 18 17:27:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 17:27:33 +0000 (UTC) Subject: [commit: ghc] wip/T12919: Quickly stub out optimization suggested by Richard (d475343) Message-ID: <20171218172733.DBB5A3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12919 Link : http://ghc.haskell.org/trac/ghc/changeset/d475343c9edec655a814746fb253d6805138f5b0/ghc >--------------------------------------------------------------- commit d475343c9edec655a814746fb253d6805138f5b0 Author: Ben Gamari Date: Fri Oct 6 15:30:33 2017 -0400 Quickly stub out optimization suggested by Richard >--------------------------------------------------------------- d475343c9edec655a814746fb253d6805138f5b0 compiler/typecheck/TcFlatten.hs | 50 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 093e723..6730d0b 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1133,6 +1133,56 @@ flatten_args :: [TyBinder] -> Kind -> TcTyCoVarSet -- function kind; kind's free -- The list of roles must be at least as long as the list of types. -- See Note [flatten_args] flatten_args orig_binders orig_inner_ki orig_fvs orig_roles orig_tys + -- Fast path: We needn't track a LiftingContext if we have no free variables + | null orig_binders && isEmptyVarSet orig_fvs + = go [] [] orig_binders orig_inner_ki orig_roles orig_tys + where + go :: [Xi] -- Xis accumulator, in reverse order + -> [Coercion] -- Coercions accumulator, in reverse order + -- These are in 1-to-1 correspondence + -> [TyBinder] -- Unsubsted binders of function's kind + -> Kind -- Unsubsted result kind of function (not a Pi-type) + -> [Role] -- Roles at which to flatten these ... + -> [Type] -- ... unflattened types + -> FlatM ([Xi], [Coercion], CoercionN) + go acc_xis acc_cos binders inner_ki _ [] + = return (reverse acc_xis, reverse acc_cos, kind_co) + where + final_kind = mkPiTys binders inner_ki + kind_co = mkReflCo Nominal final_kind + + go acc_xis acc_cos (binder:binders) inner_ki (role:roles) (ty:tys) + = do { (xi, co) <- case role of + Nominal -> setEqRel NomEq $ + if isNamedTyBinder binder + then noBogusCoercions $ flatten_one ty + else flatten_one ty + + Representational -> ASSERT( isAnonTyBinder binder ) + setEqRel ReprEq $ flatten_one ty + + Phantom -> -- See Note [Phantoms in the flattener] + ASSERT( isAnonTyBinder binder ) + do { ty <- liftTcS $ zonkTcType ty + ; return (ty, mkReflCo Phantom ty) } + + -- By Note [Flattening] invariant (F2), typeKind(xi) = typeKind(ty). + -- But, it's possible that xi will be used as an argument to a function + -- whose kind is different, if earlier arguments have been flattened + -- to new types. We thus need a coercion (kind_co :: old_kind ~ new_kind). + ; let kind_co = mkTcSymCo $ mkReflCo Nominal (tyBinderType binder) + casted_xi = xi `mkCastTy` kind_co + casted_co = co `mkTcCoherenceLeftCo` kind_co + + ; go (casted_xi : acc_xis) (casted_co : acc_cos) binders inner_ki roles tys } + + go _ _ _ _ _ _ = pprPanic "flatten_args wandered into deeper water than usual" + (vcat [ppr orig_binders, + ppr orig_inner_ki, + ppr (take 10 orig_roles), -- often infinite! + ppr orig_tys]) + +flatten_args orig_binders orig_inner_ki orig_fvs orig_roles orig_tys = go [] [] orig_lc orig_binders orig_inner_ki orig_roles orig_tys where orig_lc = emptyLiftingContext $ mkInScopeSet $ orig_fvs From git at git.haskell.org Mon Dec 18 17:27:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 17:27:31 +0000 (UTC) Subject: [commit: ghc] wip/T12919: Make it compile (114f79e) Message-ID: <20171218172731.0D2653A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12919 Link : http://ghc.haskell.org/trac/ghc/changeset/114f79ebc33d2ee035e37f6f23e06eec54abf6b1/ghc >--------------------------------------------------------------- commit 114f79ebc33d2ee035e37f6f23e06eec54abf6b1 Author: Ben Gamari Date: Fri Oct 6 15:33:19 2017 -0400 Make it compile >--------------------------------------------------------------- 114f79ebc33d2ee035e37f6f23e06eec54abf6b1 compiler/types/Coercion.hs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 39b4ff7..2b881f4 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1868,9 +1868,7 @@ buildCoercion orig_ty1 orig_ty2 = go orig_ty1 orig_ty2 = go ty1 ty2 `mkCoherenceRightCo` co go ty1@(TyVarTy tv1) _tyvarty - = ASSERT( case _tyvarty of - TyVarTy tv2 -> tv1 == tv2 - _ -> False ) + = ASSERT( case _tyvarty of TyVarTy tv2 -> tv1 == tv2; _ -> False ) mkNomReflCo ty1 go (FunTy arg1 res1) (FunTy arg2 res2) @@ -1898,9 +1896,7 @@ buildCoercion orig_ty1 orig_ty2 = go orig_ty1 orig_ty2 mkForAllCo tv1 kind_co (go ty1 ty2') go ty1@(LitTy lit1) _lit2 - = ASSERT( case _lit2 of - LitTy lit2 -> lit1 == lit2 - _ -> False ) + = ASSERT( case _lit2 of LitTy lit2 -> lit1 == lit2; _ -> False ) mkNomReflCo ty1 go (CoercionTy co1) (CoercionTy co2) From git at git.haskell.org Mon Dec 18 17:27:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 17:27:36 +0000 (UTC) Subject: [commit: ghc] wip/T12919: Second optimization (5abaa92) Message-ID: <20171218172736.AD4D03A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T12919 Link : http://ghc.haskell.org/trac/ghc/changeset/5abaa92b73046bddcb7ef83f09704cc3c6dd13f7/ghc >--------------------------------------------------------------- commit 5abaa92b73046bddcb7ef83f09704cc3c6dd13f7 Author: Ben Gamari Date: Fri Oct 6 17:16:50 2017 -0400 Second optimization >--------------------------------------------------------------- 5abaa92b73046bddcb7ef83f09704cc3c6dd13f7 compiler/typecheck/TcFlatten.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 6730d0b..3e7b998 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1183,6 +1183,7 @@ flatten_args orig_binders orig_inner_ki orig_fvs orig_roles orig_tys ppr orig_tys]) flatten_args orig_binders orig_inner_ki orig_fvs orig_roles orig_tys + -- Slow path: = go [] [] orig_lc orig_binders orig_inner_ki orig_roles orig_tys where orig_lc = emptyLiftingContext $ mkInScopeSet $ orig_fvs @@ -1200,7 +1201,10 @@ flatten_args orig_binders orig_inner_ki orig_fvs orig_roles orig_tys = return (reverse acc_xis, reverse acc_cos, kind_co) where final_kind = mkPiTys binders inner_ki - kind_co = liftCoSubst Nominal lc final_kind + kind_co + -- liftCoSubst only necessary if kind has free variables + | isEmptyVarSet orig_fvs = mkReflCo Nominal final_kind + | otherwise = liftCoSubst Nominal lc final_kind go acc_xis acc_cos lc (binder:binders) inner_ki (role:roles) (ty:tys) = do { (xi, co) <- case role of From git at git.haskell.org Mon Dec 18 17:38:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 17:38:17 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (244d144) Message-ID: <20171218173817.1A5893A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/244d1441bbe9a8d5e83015c749d1339b8f7c7319/ghc >--------------------------------------------------------------- commit 244d1441bbe9a8d5e83015c749d1339b8f7c7319 Author: Gabor Greif Date: Mon Dec 18 18:36:58 2017 +0100 Typos in comments >--------------------------------------------------------------- 244d1441bbe9a8d5e83015c749d1339b8f7c7319 compiler/basicTypes/MkId.hs | 2 +- compiler/simplCore/LiberateCase.hs | 2 +- compiler/typecheck/TcRnDriver.hs | 2 +- libraries/base/GHC/Read.hs | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 8a62e82..433f70a 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -100,7 +100,7 @@ There are several reasons why an Id might appear in the wiredInIds: * errorIds, defined in coreSyn/MkCore.hs. These error functions (e.g. rUNTIME_ERROR_ID) are wired in - becuase the desugarer generates code that mentions them directly + because the desugarer generates code that mentions them directly In all cases except ghcPrimIds, there is a definition site in a library module, which may be called (e.g. in higher order situations); diff --git a/compiler/simplCore/LiberateCase.hs b/compiler/simplCore/LiberateCase.hs index 342ad73..b484de3 100644 --- a/compiler/simplCore/LiberateCase.hs +++ b/compiler/simplCore/LiberateCase.hs @@ -192,7 +192,7 @@ Consider g = \y. SMALL...f... Then we *can* in principle do liberate-case on 'g' (small RHS) but not -for 'f' (too big). But doing so is not profitable, becuase duplicating +for 'f' (too big). But doing so is not profitable, because duplicating 'g' at its call site in 'f' doesn't get rid of any cases. So we just ask for the whole group to be small enough. diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 40b5efe..6ae299b 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -241,7 +241,7 @@ tcRnModuleTcRnM hsc_env hsc_src -- If the whole module is warned about or deprecated -- (via mod_deprec) record that in tcg_warns. If we do thereby add - -- a WarnAll, it will override any subseqent depracations added to tcg_warns + -- a WarnAll, it will override any subsequent deprecations added to tcg_warns let { tcg_env1 = case mod_deprec of Just (L _ txt) -> tcg_env { tcg_warns = WarnAll txt } Nothing -> tcg_env diff --git a/libraries/base/GHC/Read.hs b/libraries/base/GHC/Read.hs index 2d8ee3d..8160a2a 100644 --- a/libraries/base/GHC/Read.hs +++ b/libraries/base/GHC/Read.hs @@ -392,7 +392,7 @@ readSymField fieldName readVal = do -- Note [Why readField] -- --- Previousy, the code for automatically deriving Read instance (in +-- Previously, the code for automatically deriving Read instance (in -- typecheck/TcGenDeriv.hs) would generate inline code for parsing fields; -- this, however, turned out to produce massive amounts of intermediate code, -- and produced a considerable performance hit in the code generator. From git at git.haskell.org Mon Dec 18 21:38:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Dec 2017 21:38:42 +0000 (UTC) Subject: [commit: ghc] wip/T14373: cleanup (caef043) Message-ID: <20171218213842.1D4CA3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/caef043501b844352236e3e319e3ab904984e5bb/ghc >--------------------------------------------------------------- commit caef043501b844352236e3e319e3ab904984e5bb Author: Gabor Greif Date: Mon Dec 18 18:34:00 2017 +0100 cleanup >--------------------------------------------------------------- caef043501b844352236e3e319e3ab904984e5bb compiler/codeGen/StgCmmUtils.hs | 1 - testsuite/tests/codeGen/should_compile/all.T | 4 +--- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 0b77bc9..1c527d6 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -459,7 +459,6 @@ emitSwitch :: CmmExpr -- Tag to switch on -- First, three rather common cases in which there is no work to do emitSwitch _ [] (Just code) _ _ pj = emit (fst code) >> pj emitSwitch _ [(_,code)] Nothing _ _ pj = emit (fst code) >> pj -emitSwitch _ [] Nothing _ _ pj = pj -- Right, off we go emitSwitch tag_expr branches mb_deflt lo_tag hi_tag pj = do diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index 4ee2dbf..60140f3 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -35,7 +35,5 @@ test('T10667', [ when((arch('powerpc64') or arch('powerpc64le')), compile, ['-g']) test('T12115', normal, compile, ['']) test('T12355', normal, compile, ['']) -#test('T14373', [extra_files(['T14373.hs', 'T14373a.hs'])], -# multimod_compile, ['']) test('T14373', [], - multimod_compile, ['T14373a', '-O2 -c -ddump-cmm-from-stg -dsuppress-uniques']) + multimod_compile, ['T14373a', '-fasm -O2 -c -ddump-cmm-from-stg -dsuppress-uniques']) From git at git.haskell.org Tue Dec 19 13:36:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Dec 2017 13:36:33 +0000 (UTC) Subject: [commit: ghc] master: Get rid of some stuttering in comments and docs (a100763) Message-ID: <20171219133633.17F153A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a100763cc5c6c9736a00ca57b2ec3c721311eecb/ghc >--------------------------------------------------------------- commit a100763cc5c6c9736a00ca57b2ec3c721311eecb Author: Gabor Greif Date: Tue Dec 19 13:52:06 2017 +0100 Get rid of some stuttering in comments and docs >--------------------------------------------------------------- a100763cc5c6c9736a00ca57b2ec3c721311eecb compiler/basicTypes/RdrName.hs | 4 ++-- compiler/cmm/Debug.hs | 2 +- compiler/codeGen/StgCmmPrim.hs | 2 +- compiler/coreSyn/CoreSyn.hs | 6 +++--- compiler/coreSyn/CoreUtils.hs | 2 +- compiler/deSugar/DsListComp.hs | 2 +- compiler/hsSyn/HsBinds.hs | 4 ++-- compiler/main/DriverPipeline.hs | 2 +- compiler/main/HscTypes.hs | 2 +- compiler/main/SysTools.hs | 2 +- compiler/nativeGen/Dwarf.hs | 2 +- compiler/nativeGen/PIC.hs | 2 +- compiler/nativeGen/SPARC/CodeGen/Expand.hs | 2 +- compiler/nativeGen/SPARC/Regs.hs | 2 +- compiler/parser/Lexer.x | 2 +- compiler/prelude/primops.txt.pp | 2 +- compiler/rename/RnEnv.hs | 2 +- compiler/rename/RnNames.hs | 4 ++-- compiler/rename/RnPat.hs | 2 +- compiler/rename/RnSource.hs | 2 +- compiler/rename/RnTypes.hs | 2 +- compiler/simplCore/CSE.hs | 2 +- compiler/simplCore/CallArity.hs | 2 +- compiler/specialise/Rules.hs | 2 +- compiler/typecheck/FamInst.hs | 2 +- compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcCanonical.hs | 4 ++-- compiler/typecheck/TcEnv.hs | 2 +- compiler/typecheck/TcErrors.hs | 4 ++-- compiler/typecheck/TcFlatten.hs | 2 +- compiler/typecheck/TcInstDcls.hs | 4 ++-- compiler/typecheck/TcInteract.hs | 2 +- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcSMonad.hs | 2 +- compiler/typecheck/TcSigs.hs | 2 +- compiler/typecheck/TcTyDecls.hs | 2 +- compiler/typecheck/TcTypeNats.hs | 2 +- compiler/typecheck/TcUnify.hs | 2 +- compiler/types/FamInstEnv.hs | 2 +- docs/ghci/ghci.tex | 2 +- docs/rts/rts.tex | 2 +- docs/users_guide/glasgow_exts.rst | 6 +++--- libraries/base/GHC/IO.hs | 2 +- libraries/base/GHC/MVar.hs | 2 +- libraries/base/tests/memo001.hs | 2 +- libraries/ghc-prim/cbits/ctz.c | 2 +- libraries/integer-simple/GHC/Integer/Type.hs | 2 +- rts/Apply.cmm | 2 +- rts/PrimOps.cmm | 4 ++-- rts/StgCRun.c | 2 +- rts/ThreadPaused.c | 2 +- testsuite/tests/indexed-types/should_compile/PushedInAsGivens.hs | 2 +- 52 files changed, 63 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 a100763cc5c6c9736a00ca57b2ec3c721311eecb From git at git.haskell.org Tue Dec 19 15:29:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Dec 2017 15:29:49 +0000 (UTC) Subject: [commit: ghc] master: Rmove a call to mkStatePrimTy (ff1544d) Message-ID: <20171219152949.1ED313A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ff1544d6db26c16d801f9cf9197db6eede57d576/ghc >--------------------------------------------------------------- commit ff1544d6db26c16d801f9cf9197db6eede57d576 Author: Simon Peyton Jones Date: Tue Dec 19 10:37:13 2017 +0000 Rmove a call to mkStatePrimTy This is a tiny refactoring that removes one of the calls to mkStatePrimTy, in service to Trac #14596 >--------------------------------------------------------------- ff1544d6db26c16d801f9cf9197db6eede57d576 compiler/prelude/PrelRules.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index 8838c4a..db79589 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -40,7 +40,7 @@ import TysPrim import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon , unwrapNewTyCon_maybe, tyConDataCons ) import DataCon ( DataCon, dataConTagZ, dataConTyCon, dataConWorkId ) -import CoreUtils ( cheapEqExpr, exprIsHNF ) +import CoreUtils ( cheapEqExpr, exprIsHNF, exprType ) import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) @@ -932,9 +932,9 @@ dataToTagRule = a `mplus` b -- seq# :: forall a s . a -> State# s -> (# State# s, a #) seqRule :: RuleM CoreExpr seqRule = do - [Type ty_a, Type ty_s, a, s] <- getArgs + [Type ty_a, Type _ty_s, a, s] <- getArgs guard $ exprIsHNF a - return $ mkCoreUbxTup [mkStatePrimTy ty_s, ty_a] [s, a] + return $ mkCoreUbxTup [exprType s, ty_a] [s, a] -- spark# :: forall a s . a -> State# s -> (# State# s, a #) sparkRule :: RuleM CoreExpr From git at git.haskell.org Tue Dec 19 15:29:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Dec 2017 15:29:52 +0000 (UTC) Subject: [commit: ghc] master: Stop runRW# being magic (10ed319) Message-ID: <20171219152952.0B4503A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/10ed31980f30bf2a0091b6f4cef11e0f2f633f22/ghc >--------------------------------------------------------------- commit 10ed31980f30bf2a0091b6f4cef11e0f2f633f22 Author: Simon Peyton Jones Date: Tue Dec 19 10:35:27 2017 +0000 Stop runRW# being magic Triggered by thinking about Trac #14596, I found that runRW# does not need to be a "magic" wired-in Id, now that we have levity polymorphism. This patch stops it being wired-in. >--------------------------------------------------------------- 10ed31980f30bf2a0091b6f4cef11e0f2f633f22 compiler/basicTypes/MkId.hs | 67 ++--------------------------------------- compiler/coreSyn/CorePrep.hs | 43 +++++++++++++++++++++++++- compiler/prelude/PrelNames.hs | 4 ++- libraries/ghc-prim/GHC/Magic.hs | 5 ++- 4 files changed, 50 insertions(+), 69 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 10ed31980f30bf2a0091b6f4cef11e0f2f633f22 From git at git.haskell.org Wed Dec 20 10:32:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Dec 2017 10:32:05 +0000 (UTC) Subject: [commit: ghc] master: Sync up ghc-prim changelog from GHC 8.2 branch (71f96bb) Message-ID: <20171220103205.E8F5C3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/71f96bb349e1ef34f1d23fd49b0265813e90fd2c/ghc >--------------------------------------------------------------- commit 71f96bb349e1ef34f1d23fd49b0265813e90fd2c Author: Herbert Valerio Riedel Date: Wed Dec 20 08:10:59 2017 +0100 Sync up ghc-prim changelog from GHC 8.2 branch [skip ci] (cherry picked from commit 005656776be8a447785627d549ee393dad468ff6) >--------------------------------------------------------------- 71f96bb349e1ef34f1d23fd49b0265813e90fd2c libraries/ghc-prim/changelog.md | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md index b01bf8b..a2529ea 100644 --- a/libraries/ghc-prim/changelog.md +++ b/libraries/ghc-prim/changelog.md @@ -8,7 +8,13 @@ - Don't allocate a thunk for each unpacked UTF-8 character in `unpackCStringUtf8#` -## 0.5.1.0 +## 0.5.1.1 *November 2017* + +- Shipped with GHC 8.2.2 + +- Changed strictness properties of `catchRetry#` (#14171) + +## 0.5.1.0 *July 2017* - Shipped with GHC 8.2.1 From git at git.haskell.org Wed Dec 20 10:35:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Dec 2017 10:35:11 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Sync up ghc-prim changelog from GHC 8.2 branch (6b96ac4) Message-ID: <20171220103511.284C73A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/6b96ac4aa6770ca4462eaaaab586e1fa53035fed/ghc >--------------------------------------------------------------- commit 6b96ac4aa6770ca4462eaaaab586e1fa53035fed Author: Herbert Valerio Riedel Date: Wed Dec 20 08:10:59 2017 +0100 Sync up ghc-prim changelog from GHC 8.2 branch [skip ci] (cherry picked from commit 005656776be8a447785627d549ee393dad468ff6) >--------------------------------------------------------------- 6b96ac4aa6770ca4462eaaaab586e1fa53035fed libraries/ghc-prim/changelog.md | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md index b01bf8b..a2529ea 100644 --- a/libraries/ghc-prim/changelog.md +++ b/libraries/ghc-prim/changelog.md @@ -8,7 +8,13 @@ - Don't allocate a thunk for each unpacked UTF-8 character in `unpackCStringUtf8#` -## 0.5.1.0 +## 0.5.1.1 *November 2017* + +- Shipped with GHC 8.2.2 + +- Changed strictness properties of `catchRetry#` (#14171) + +## 0.5.1.0 *July 2017* - Shipped with GHC 8.2.1 From git at git.haskell.org Wed Dec 20 12:35:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Dec 2017 12:35:46 +0000 (UTC) Subject: [commit: ghc] wip/T14373: test that no nested switches generated (efed656) Message-ID: <20171220123546.E85873A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/efed6566078beace40443dd9acc2cdf73d0beb5c/ghc >--------------------------------------------------------------- commit efed6566078beace40443dd9acc2cdf73d0beb5c Author: Gabor Greif Date: Wed Dec 20 13:21:07 2017 +0100 test that no nested switches generated >--------------------------------------------------------------- efed6566078beace40443dd9acc2cdf73d0beb5c testsuite/tests/codeGen/should_compile/T14373b.hs | 8 ++++++++ testsuite/tests/codeGen/should_compile/all.T | 6 ++++-- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/codeGen/should_compile/T14373b.hs b/testsuite/tests/codeGen/should_compile/T14373b.hs new file mode 100644 index 0000000..fb94274 --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T14373b.hs @@ -0,0 +1,8 @@ +import T14373 + +{-# NOINLINE earlySwitch #-} +earlySwitch A = True +earlySwitch B = False +earlySwitch C = False + +main = print $ earlySwitch B diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index 60140f3..69ee2c7 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -35,5 +35,7 @@ test('T10667', [ when((arch('powerpc64') or arch('powerpc64le')), compile, ['-g']) test('T12115', normal, compile, ['']) test('T12355', normal, compile, ['']) -test('T14373', [], - multimod_compile, ['T14373a', '-fasm -O2 -c -ddump-cmm-from-stg -dsuppress-uniques']) +test('T14373a', [], + multimod_compile, ['T14373a', '-fasm -O2 -ddump-cmm-from-stg -dsuppress-uniques']) +test('T14373b', [], + multimod_compile, ['T14373b', '-fasm -O2 -ddump-cmm-from-stg -dsuppress-uniques']) From git at git.haskell.org Thu Dec 21 00:44:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 00:44:21 +0000 (UTC) Subject: [commit: ghc] master: Fix #14578 by checking isCompoundHsType in more places (1bd91a7) Message-ID: <20171221004421.940CE3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1bd91a7ac60eba3b0c019e2228f4b2b07f8cd5ad/ghc >--------------------------------------------------------------- commit 1bd91a7ac60eba3b0c019e2228f4b2b07f8cd5ad Author: Ryan Scott Date: Wed Dec 20 19:25:18 2017 -0500 Fix #14578 by checking isCompoundHsType in more places Summary: The `HsType` pretty-printer does not automatically insert parentheses where necessary for type applications, so a function `isCompoundHsType` was created in D4056 towards this purpose. However, it was not used in as many places as it ought to be, resulting in #14578. Test Plan: make test TEST=T14578 Reviewers: alanz, bgamari, simonpj Reviewed By: alanz, simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #14578 Differential Revision: https://phabricator.haskell.org/D4266 >--------------------------------------------------------------- 1bd91a7ac60eba3b0c019e2228f4b2b07f8cd5ad compiler/hsSyn/HsTypes.hs | 12 ++- compiler/hsSyn/HsUtils.hs | 8 +- testsuite/tests/deriving/should_compile/T14578.hs | 15 +++ .../tests/deriving/should_compile/T14578.stderr | 115 +++++++++++++++++++++ testsuite/tests/deriving/should_compile/all.T | 1 + 5 files changed, 145 insertions(+), 6 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 1bd91a7ac60eba3b0c019e2228f4b2b07f8cd5ad From git at git.haskell.org Thu Dec 21 00:44:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 00:44:24 +0000 (UTC) Subject: [commit: ghc] master: Fix #14588 by checking for more bang patterns (9caf40e) Message-ID: <20171221004424.C4BDD3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9caf40e9d7233a2a6e78a0c4f2d2f13acbf804dd/ghc >--------------------------------------------------------------- commit 9caf40e9d7233a2a6e78a0c4f2d2f13acbf804dd Author: Ryan Scott Date: Wed Dec 20 19:25:30 2017 -0500 Fix #14588 by checking for more bang patterns Summary: Commit 372995364c52eef15066132d7d1ea8b6760034e6 inadvertently removed a check in the parser which rejected let-bindings with bang patterns, leading to #14588. This fixes it by creating a `hintBangPat` function to perform this check, and sprinkling it in the right places. Test Plan: make test TEST=T14588 Reviewers: bgamari, alanz, simonpj Reviewed By: bgamari, simonpj Subscribers: rwbarton, thomie, mpickering, carter GHC Trac Issues: #14588 Differential Revision: https://phabricator.haskell.org/D4270 >--------------------------------------------------------------- 9caf40e9d7233a2a6e78a0c4f2d2f13acbf804dd compiler/parser/Parser.y | 3 +-- compiler/parser/RdrHsSyn.hs | 19 +++++++++++++------ testsuite/tests/parser/should_fail/T14588.hs | 3 +++ testsuite/tests/parser/should_fail/T14588.stderr | 4 ++++ testsuite/tests/parser/should_fail/all.T | 1 + 5 files changed, 22 insertions(+), 8 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 7ae653f..1b59390 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -2204,10 +2204,9 @@ decl_no_th :: { LHsDecl GhcPs } : sigdecl { $1 } | '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2) - -- Turn it all into an expression so that - -- checkPattern can check that bangs are enabled ; l = comb2 $1 $> }; (ann, r) <- checkValDef empty SrcStrict e Nothing $3 ; + hintBangPat (comb2 $1 $2) (unLoc e) ; -- Depending upon what the pattern looks like we might get either -- a FunBind or PatBind back from checkValDef. See Note -- [FunBind vs PatBind] diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 0c2b204..0f8e503 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -53,7 +53,7 @@ module RdrHsSyn ( checkValSigLhs, checkDoAndIfThenElse, checkRecordSyntax, - parseErrorSDoc, + parseErrorSDoc, hintBangPat, splitTilde, splitTildeApps, -- Help with processing exports @@ -855,11 +855,10 @@ checkAPat msg loc e0 = do SectionR (L lb (HsVar (L _ bang))) e -- (! x) | bang == bang_RDR - -> do { bang_on <- extension bangPatEnabled - ; if bang_on then do { e' <- checkLPat msg e - ; addAnnotation loc AnnBang lb - ; return (BangPat e') } - else parseErrorSDoc loc (text "Illegal bang-pattern (use BangPatterns):" $$ ppr e0) } + -> do { hintBangPat loc e0 + ; e' <- checkLPat msg e + ; addAnnotation loc AnnBang lb + ; return (BangPat e') } ELazyPat e -> checkLPat msg e >>= (return . LazyPat) EAsPat n e -> checkLPat msg e >>= (return . AsPat n) @@ -1556,6 +1555,14 @@ isImpExpQcWildcard _ = False parseErrorSDoc :: SrcSpan -> SDoc -> P a parseErrorSDoc span s = failSpanMsgP span s +-- | Hint about bang patterns, assuming @BangPatterns@ is off. +hintBangPat :: SrcSpan -> HsExpr GhcPs -> P () +hintBangPat span e = do + bang_on <- extension bangPatEnabled + unless bang_on $ + parseErrorSDoc span + (text "Illegal bang-pattern (use BangPatterns):" $$ ppr e) + data SumOrTuple = Sum ConTag Arity (LHsExpr GhcPs) | Tuple [LHsTupArg GhcPs] diff --git a/testsuite/tests/parser/should_fail/T14588.hs b/testsuite/tests/parser/should_fail/T14588.hs new file mode 100644 index 0000000..8a0bcec --- /dev/null +++ b/testsuite/tests/parser/should_fail/T14588.hs @@ -0,0 +1,3 @@ +module T14588 where + +main = print (let !x = 1 + 2 in x) diff --git a/testsuite/tests/parser/should_fail/T14588.stderr b/testsuite/tests/parser/should_fail/T14588.stderr new file mode 100644 index 0000000..cb64103 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T14588.stderr @@ -0,0 +1,4 @@ + +T14588.hs:3:19: error: + Illegal bang-pattern (use BangPatterns): + ! x diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T index abe3da9..483e5fe 100644 --- a/testsuite/tests/parser/should_fail/all.T +++ b/testsuite/tests/parser/should_fail/all.T @@ -102,3 +102,4 @@ test('T8501a', normal, compile_fail, ['']) test('T8501b', normal, compile_fail, ['']) test('T8501c', normal, compile_fail, ['']) test('T12610', normal, compile_fail, ['']) +test('T14588', normal, compile_fail, ['']) From git at git.haskell.org Thu Dec 21 00:44:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 00:44:27 +0000 (UTC) Subject: [commit: ghc] master: Remove hack put in place for #12512 (9cb289a) Message-ID: <20171221004427.900123A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9cb289abc582c9eb8337a2621baf58e35feeff46/ghc >--------------------------------------------------------------- commit 9cb289abc582c9eb8337a2621baf58e35feeff46 Author: Ryan Scott Date: Wed Dec 20 19:25:37 2017 -0500 Remove hack put in place for #12512 Summary: Previously, I added an ad hoc check for unboxed tuples and sums in standalone-derived instances to fix #12512, under the pretense that polymorphism over `UnboxedTupleRep` and `UnboxedSumRep` was a lie. But that is no longer the case, and so this ad hoc check can be removed entirely. Less code, and easier to understand. Test Plan: make test TEST=T12512 Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4271 >--------------------------------------------------------------- 9cb289abc582c9eb8337a2621baf58e35feeff46 compiler/typecheck/TcDeriv.hs | 12 +----------- testsuite/tests/deriving/should_fail/T12512.stderr | 6 ++++-- 2 files changed, 5 insertions(+), 13 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 33ce581..f0ddce0 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -638,12 +638,6 @@ deriveStandalone (L loc (DerivDecl deriv_ty deriv_strat' overlap_mode)) -> do warnUselessTypeable return Nothing - | isUnboxedTupleTyCon tc - -> bale_out $ unboxedTyConErr "tuple" - - | isUnboxedSumTyCon tc - -> bale_out $ unboxedTyConErr "sum" - | isAlgTyCon tc || isDataFamilyTyCon tc -- All other classes -> do { spec <- mkEqnHelp (fmap unLoc overlap_mode) tvs cls cls_tys tc tc_args @@ -973,7 +967,7 @@ mkEqnHelp overlap_mode tvs cls cls_tys tycon tc_args mtheta deriv_strat , denv_mtheta = mtheta , denv_strat = deriv_strat } ; flip runReaderT deriv_env $ - if isDataTyCon rep_tc then mkDataTypeEqn else mkNewTypeEqn } + if isNewTyCon rep_tc then mkNewTypeEqn else mkDataTypeEqn } where bale_out msg = failWithTc (derivingThingErr False cls cls_tys (mkTyConApp tycon tc_args) deriv_strat msg) @@ -1932,7 +1926,3 @@ derivingHiddenErr tc standaloneCtxt :: LHsSigType GhcRn -> SDoc standaloneCtxt ty = hang (text "In the stand-alone deriving instance for") 2 (quotes (ppr ty)) - -unboxedTyConErr :: String -> MsgDoc -unboxedTyConErr thing = - text "The last argument of the instance cannot be an unboxed" <+> text thing diff --git a/testsuite/tests/deriving/should_fail/T12512.stderr b/testsuite/tests/deriving/should_fail/T12512.stderr index a62cda6..78c49f4 100644 --- a/testsuite/tests/deriving/should_fail/T12512.stderr +++ b/testsuite/tests/deriving/should_fail/T12512.stderr @@ -1,10 +1,12 @@ T12512.hs:10:1: error: • Can't make a derived instance of ‘Wat1 (# a, b #)’: - The last argument of the instance cannot be an unboxed tuple + ‘Wat1’ is not a stock derivable class (Eq, Show, etc.) + Try enabling DeriveAnyClass • In the stand-alone deriving instance for ‘Wat1 (# a, b #)’ T12512.hs:13:1: error: • Can't make a derived instance of ‘Wat2 (# a | b #)’: - The last argument of the instance cannot be an unboxed sum + ‘Wat2’ is not a stock derivable class (Eq, Show, etc.) + Try enabling DeriveAnyClass • In the stand-alone deriving instance for ‘Wat2 (# a | b #)’ From git at git.haskell.org Thu Dec 21 00:44:30 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 00:44:30 +0000 (UTC) Subject: [commit: ghc] master: Document ScopedTypeVariables' interaction with nested foralls (b6304f8) Message-ID: <20171221004430.5ECAC3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b6304f8fd9b845466116874db4224f42acbc597d/ghc >--------------------------------------------------------------- commit b6304f8fd9b845466116874db4224f42acbc597d Author: Ryan Scott Date: Wed Dec 20 19:25:44 2017 -0500 Document ScopedTypeVariables' interaction with nested foralls Summary: This documents the status quo with regards to how `ScopedTypeVariables` brings into scope type variables that are quantified by nested `forall`s (that is to say, it doesn't). This takes the prose in https://ghc.haskell.org/trac/ghc/ticket/14288#comment:5 and enshrines it into the users' guide. Test Plan: Read it Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14288 Differential Revision: https://phabricator.haskell.org/D4272 >--------------------------------------------------------------- b6304f8fd9b845466116874db4224f42acbc597d docs/users_guide/glasgow_exts.rst | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 603dbc5..201aa77 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -9650,6 +9650,26 @@ This only happens if: the definition of "``g``", so "``x::a``" means "``x::forall a. a``" by Haskell's usual implicit quantification rules. +- The type variable is quantified by the single, syntactically visible, + outermost ``forall`` of the type signature. For example, GHC will reject + all of the following examples: :: + + f1 :: forall a. forall b. a -> [b] -> [b] + f1 _ (x:xs) = xs ++ [ x :: b ] + + f2 :: forall a. a -> forall b. [b] -> [b] + f2 _ (x:xs) = xs ++ [ x :: b ] + + type Foo = forall b. [b] -> [b] + + f3 :: Foo + f3 (x:xs) = xs ++ [ x :: b ] + + In ``f1`` and ``f2``, the type variable ``b`` is not quantified by the + outermost ``forall``, so it is not in scope over the bodies of the + functions. Neither is ``b`` in scope over the body of ``f3``, as the + ``forall`` is tucked underneath the ``Foo`` type synonym. + - The signature gives a type for a function binding or a bare variable binding, not a pattern binding. For example: :: From git at git.haskell.org Thu Dec 21 00:44:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 00:44:34 +0000 (UTC) Subject: [commit: ghc] master: Improve treatment of sectioned holes (4d41e92) Message-ID: <20171221004434.556FD3A5ED@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4d41e9212d1fdf109f2d0174d204644446f5874c/ghc >--------------------------------------------------------------- commit 4d41e9212d1fdf109f2d0174d204644446f5874c Author: Ryan Scott Date: Wed Dec 20 19:25:53 2017 -0500 Improve treatment of sectioned holes Summary: Previously, GHC was pretty-printing left-section holes incorrectly and not parsing right-sectioned holes at all. This patch fixes both problems. Test Plan: make test TEST=T14590 Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, mpickering, carter GHC Trac Issues: #14590 Differential Revision: https://phabricator.haskell.org/D4273 >--------------------------------------------------------------- 4d41e9212d1fdf109f2d0174d204644446f5874c compiler/hsSyn/HsExpr.hs | 4 + compiler/parser/Parser.y | 10 +- testsuite/tests/typecheck/should_compile/T14590.hs | 7 + .../tests/typecheck/should_compile/T14590.stderr | 264 +++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 283 insertions(+), 3 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 4d41e9212d1fdf109f2d0174d204644446f5874c From git at git.haskell.org Thu Dec 21 14:55:40 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 14:55:40 +0000 (UTC) Subject: [commit: ghc] master: Refactor coercion holes (a492af0) Message-ID: <20171221145540.8AF7A3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a492af06d3264530d134584f22ffb726a16c78ec/ghc >--------------------------------------------------------------- commit a492af06d3264530d134584f22ffb726a16c78ec Author: Simon Peyton Jones Date: Thu Dec 21 13:31:13 2017 +0000 Refactor coercion holes In fixing Trac #14584 I found that it would be /much/ more convenient if a "hole" in a coercion (much like a unification variable in a type) acutally had a CoVar associated with it rather than just a Unique. Then I can ask what the free variables of a coercion is, and get a set of CoVars including those as-yet-un-filled in holes. Once that is done, it makes no sense to stuff coercion holes inside UnivCo. They were there before so we could know the kind and role of a "hole" coercion, but once there is a CoVar we can get that info from the CoVar. So I removed HoleProv from UnivCoProvenance and added HoleCo to Coercion. In summary: * Add HoleCo to Coercion and remove HoleProv from UnivCoProvanance * Similarly in IfaceCoercion * Make CoercionHole have a CoVar in it, not a Unique * Make tyCoVarsOfCo return the free coercion-hole variables as well as the ordinary free CoVars. Similarly, remember to zonk the CoVar in a CoercionHole We could go further, and remove CoercionHole as a distinct type altogther, just collapsing it into HoleCo. But I have not done that yet. >--------------------------------------------------------------- a492af06d3264530d134584f22ffb726a16c78ec compiler/backpack/RnModIface.hs | 1 + compiler/coreSyn/CoreFVs.hs | 2 +- compiler/coreSyn/CoreLint.hs | 7 +++- compiler/iface/IfaceSyn.hs | 5 +-- compiler/iface/IfaceType.hs | 56 ++++++++++++-------------- compiler/iface/TcIface.hs | 5 +-- compiler/iface/ToIface.hs | 5 ++- compiler/typecheck/TcCanonical.hs | 2 +- compiler/typecheck/TcEnv.hs | 16 +++++--- compiler/typecheck/TcErrors.hs | 6 +-- compiler/typecheck/TcHsSyn.hs | 30 ++++++-------- compiler/typecheck/TcInteract.hs | 6 +-- compiler/typecheck/TcMType.hs | 75 +++++++++++++++++++--------------- compiler/typecheck/TcPluginM.hs | 4 +- compiler/typecheck/TcRnTypes.hs | 25 +++++++----- compiler/typecheck/TcSMonad.hs | 4 +- compiler/typecheck/TcTyDecls.hs | 2 +- compiler/typecheck/TcType.hs | 14 +++---- compiler/typecheck/TcUnify.hs | 19 +++++---- compiler/typecheck/TcValidity.hs | 4 +- compiler/types/Coercion.hs | 42 +++++++++----------- compiler/types/FamInstEnv.hs | 2 +- compiler/types/OptCoercion.hs | 7 ++-- compiler/types/TyCoRep.hs | 84 +++++++++++++++++++++++---------------- compiler/types/Type.hs | 19 +++++---- 25 files changed, 234 insertions(+), 208 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 a492af06d3264530d134584f22ffb726a16c78ec From git at git.haskell.org Thu Dec 21 14:55:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 14:55:44 +0000 (UTC) Subject: [commit: ghc] master: Fix floating of equalities (f5cf9d1) Message-ID: <20171221145544.F2C073A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f5cf9d1a1b198edc929e1fa96c6d841d182fe766/ghc >--------------------------------------------------------------- commit f5cf9d1a1b198edc929e1fa96c6d841d182fe766 Author: Simon Peyton Jones Date: Thu Dec 21 14:13:54 2017 +0000 Fix floating of equalities This rather subtle patch fixes Trac #14584. The problem was that we'd allowed a coercion, bound in a nested scope, to escape into an outer scope. The main changes are * TcSimplify.floatEqualities takes more care when floating equalities to make sure we don't float one out that mentions a locally-bound coercion. See Note [What prevents a constraint from floating] * TcSimplify.emitResidualConstraints (which emits the residual constraints in simplifyInfer) now avoids burying the constraints for escaping CoVars inside the implication constraint. * Since I had do to this stuff with CoVars, I moved the fancy footwork about not quantifying over CoVars from TcMType.quantifyTyVars to its caller TcSimplify.decideQuantifiedTyVars. I think its other callers don't need to worry about all this CoVar stuff. This turned out to be surprisigly tricky, and took me a solid day to get right. I think the result is reasonably neat, though, and well documented with Notes. >--------------------------------------------------------------- f5cf9d1a1b198edc929e1fa96c6d841d182fe766 compiler/typecheck/TcMType.hs | 19 +- compiler/typecheck/TcSMonad.hs | 7 +- compiler/typecheck/TcSimplify.hs | 294 ++++++++++++++------- .../tests/indexed-types/should_fail/T13877.stderr | 10 +- testsuite/tests/partial-sigs/should_fail/T14584.hs | 56 ++++ .../tests/partial-sigs/should_fail/T14584.stderr | 21 ++ .../tests/partial-sigs/should_fail/T14584a.hs | 16 ++ .../tests/partial-sigs/should_fail/T14584a.stderr | 24 ++ testsuite/tests/partial-sigs/should_fail/all.T | 2 + .../tests/typecheck/should_fail/VtaFail.stderr | 6 - 10 files changed, 339 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 f5cf9d1a1b198edc929e1fa96c6d841d182fe766 From git at git.haskell.org Thu Dec 21 14:55:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 14:55:48 +0000 (UTC) Subject: [commit: ghc] master: Simplify HsPatSynDetails (584cbd4) Message-ID: <20171221145548.5854A3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/584cbd4a19887497776ce1f61c15df652b8b2ea4/ghc >--------------------------------------------------------------- commit 584cbd4a19887497776ce1f61c15df652b8b2ea4 Author: Simon Peyton Jones Date: Wed Dec 20 15:36:49 2017 +0000 Simplify HsPatSynDetails This is a pure refactoring. Use HsConDetails to implement HsPatSynDetails, instead of defining a whole new data type. Less code, fewer types, all good. >--------------------------------------------------------------- 584cbd4a19887497776ce1f61c15df652b8b2ea4 compiler/deSugar/DsMeta.hs | 18 +++++++------- compiler/hsSyn/Convert.hs | 6 ++--- compiler/hsSyn/HsBinds.hs | 53 ++++------------------------------------ compiler/hsSyn/HsUtils.hs | 2 +- compiler/parser/Parser.y | 6 ++--- compiler/rename/RnBinds.hs | 14 +++++------ compiler/rename/RnSource.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 18 ++++++++++---- compiler/typecheck/TcInteract.hs | 3 ++- compiler/typecheck/TcPatSyn.hs | 17 ++++++------- 10 files changed, 52 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 584cbd4a19887497776ce1f61c15df652b8b2ea4 From git at git.haskell.org Thu Dec 21 14:55:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 14:55:52 +0000 (UTC) Subject: [commit: ghc] master: Check for bogus quantified tyvars in partial type sigs (72938f5) Message-ID: <20171221145552.9236D3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/72938f5890dac81afad52bf58175c1e29ffbc6dd/ghc >--------------------------------------------------------------- commit 72938f5890dac81afad52bf58175c1e29ffbc6dd Author: Simon Peyton Jones Date: Wed Dec 20 15:41:02 2017 +0000 Check for bogus quantified tyvars in partial type sigs This fixes Trac #14479. Not difficult. See Note [Quantification and partial signatures] Wrinkle 4, in TcSimplify. >--------------------------------------------------------------- 72938f5890dac81afad52bf58175c1e29ffbc6dd compiler/typecheck/TcBinds.hs | 54 ++++++++++------- compiler/typecheck/TcSimplify.hs | 69 ++++++++++++++-------- testsuite/tests/partial-sigs/should_fail/T14479.hs | 9 +++ .../tests/partial-sigs/should_fail/T14479.stderr | 10 ++++ testsuite/tests/partial-sigs/should_fail/all.T | 1 + 5 files changed, 96 insertions(+), 47 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 72938f5890dac81afad52bf58175c1e29ffbc6dd From git at git.haskell.org Thu Dec 21 17:33:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 17:33:51 +0000 (UTC) Subject: [commit: ghc] wip/T14373: Add note about mechanics of double switching (5719218) Message-ID: <20171221173351.BF6963A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14373 Link : http://ghc.haskell.org/trac/ghc/changeset/57192187a2c086945897259847e3605bd9fea6b9/ghc >--------------------------------------------------------------- commit 57192187a2c086945897259847e3605bd9fea6b9 Author: Gabor Greif Date: Thu Dec 21 18:19:33 2017 +0100 Add note about mechanics of double switching for big families >--------------------------------------------------------------- 57192187a2c086945897259847e3605bd9fea6b9 compiler/codeGen/StgCmmExpr.hs | 54 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 446e421..663afdc 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -623,6 +623,7 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts (if small then fam_sz else maxpt) (pure ()) else -- No, get exact tag from info table when mAX_PTR_TAG + -- See Note [double switching for big families] do let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg) itag_expr = getConstrTag dflags untagged_ptr @@ -653,6 +654,57 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts cgAlts _ _ _ _ = panic "cgAlts" -- UbxTupAlt and PolyAlt have only one alternative +-- Note [double switching for big families] +-- +-- Generally, switching on big family alternatives now +-- is done by two nested switch statements. The outer +-- looks at the pointer tag and the inner dereferences the +-- pointer and switches on the info table tag. +-- +-- We can handle a simple case first, namely when none +-- of the case alternatives mention a constructor having +-- a pointer tag of 1..mAX_PTR_TAG-1. In this case we +-- simply emit a switch on the info table tag. +-- Note that the other simple case is when all mentioned +-- alternatives lie in 1..mAX_PTR_TAG-1, in which case we can +-- switch on the ptr tag only, just like in the small family case. +-- +-- There are two intricacies with a nested switch: +-- a) Both should branch to the same default alternative, and as such +-- avoid duplicate codegen of potentially heavy code. The outer +-- switch generates the actual code with a prepended fresh label, +-- while the inner one only generates a jump to that label. +-- b) Where to codegen the inner switch's code? It would be nice to +-- leave the codegen to the mAX_PTR_TAG-numbered branch of the +-- outer switch, but we don't have a c-- statement for this purpose. +-- So we just emit a branch to a fresh label, and pass the +-- code-emission action to the outer switch's emitter as +-- pre-join-label code. What we end up with is: +-- +-- switch [1..7] (R1 & 7) -- on ptr tag +-- 1 --> lbl0 +-- 2 --> lbl1 +-- ... +-- 6 --> lbl5 +-- 7 --> fallbackLbl_info +-- +-- +-- fallbackLbl_info: +-- switch [6..20] (R1->infoTag) +-- 6 --> lbl6 +-- 7 --> lbl7 +-- ... +-- 19 --> lbl19 +-- +-- +-- joinLbl: -- lbl0 .. lbl19 all finally branch here +-- +-- +-- Note that the joinLbl is internal to the 'emitSwitch', +-- so we now have a tail argument to 'emitSwitch' which generates +-- some custom code before that label. One can pass 'pure ()' to +-- avoid this. + -- Note [alg-alt heap check] -- @@ -690,6 +742,8 @@ cgAlts _ _ _ _ = panic "cgAlts" -- tricky part is that the default case needs (logical) duplication. -- To do this we emit an extra label for it and branch to that from -- the second switch. This avoids duplicated codegen. See Trac #14373. +-- See Note [double switching for big families] for the mechanics +-- involved. -- -- Also see Note [Data constructor dynamic tags] From git at git.haskell.org Thu Dec 21 17:37:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 17:37:27 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (bcb519c) Message-ID: <20171221173727.7C5E73A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bcb519c5f81497bab42304db9ef956d51548479b/ghc >--------------------------------------------------------------- commit bcb519c5f81497bab42304db9ef956d51548479b Author: Gabor Greif Date: Thu Dec 21 18:36:21 2017 +0100 Typos in comments >--------------------------------------------------------------- bcb519c5f81497bab42304db9ef956d51548479b compiler/simplCore/CSE.hs | 2 +- compiler/simplCore/SimplUtils.hs | 4 ++-- compiler/typecheck/TcSimplify.hs | 2 +- testsuite/tests/typecheck/should_compile/T2497.hs | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/simplCore/CSE.hs b/compiler/simplCore/CSE.hs index 085ca3c..919f61a 100644 --- a/compiler/simplCore/CSE.hs +++ b/compiler/simplCore/CSE.hs @@ -544,7 +544,7 @@ to transform W y z -> e2 In the simplifier we use cheapEqExpr, because it is called a lot. -But here in CSE we use the full eqExpr. After all, two alterantives usually +But here in CSE we use the full eqExpr. After all, two alternatives usually differ near the root, so it probably isn't expensive to compare the full alternative. It seems like the same kind of thing that CSE is supposed to be doing, which is why I put it here. diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index 3f42b03..dfe8b62 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -2093,7 +2093,7 @@ mkCase1 dflags scrut bndr alts_ty alts = mkCase2 dflags scrut bndr alts_ty alts mkCase2 dflags scrut bndr alts_ty alts | -- See Note [Scrutinee Constant Folding] - case alts of -- Not if there is just a DEFAULT alterantive + case alts of -- Not if there is just a DEFAULT alternative [(DEFAULT,_,_)] -> False _ -> True , gopt Opt_CaseFolding dflags @@ -2150,7 +2150,7 @@ mkCase2 dflags scrut bndr alts_ty alts add_default :: [CoreAlt] -> [CoreAlt] -- TagToEnum may change a boolean True/False set of alternatives - -- to LitAlt 0#/1# alterantives. But literal alternatives always + -- to LitAlt 0#/1# alternatives. But literal alternatives always -- have a DEFAULT (I think). So add it. add_default ((LitAlt {}, bs, rhs) : alts) = (DEFAULT, bs, rhs) : alts add_default alts = alts diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index af04abe..8001fd6 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1231,7 +1231,7 @@ Reasons: fail spuriously, thereby obfuscating the original insoluble error. Trac #14000 is an example -I tried an alterantive approach: simply failM, after emitting the +I tried an alternative approach: simply failM, after emitting the residual implication constraint; the exception will be caught in TcBinds.tcPolyBinds, which gives all the binders in the group the type (forall a. a). But that didn't work with -fdefer-type-errors, because diff --git a/testsuite/tests/typecheck/should_compile/T2497.hs b/testsuite/tests/typecheck/should_compile/T2497.hs index 6f76395..55c390d 100644 --- a/testsuite/tests/typecheck/should_compile/T2497.hs +++ b/testsuite/tests/typecheck/should_compile/T2497.hs @@ -6,7 +6,7 @@ foo x = x {-# NOINLINE [1] foo #-} -- Trac #2497; test should compile without language --- pragmas to swith on the forall +-- pragmas to switch on the forall {-# RULES "id" forall (x :: a). foo x = x #-} From git at git.haskell.org Thu Dec 21 18:39:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 18:39:38 +0000 (UTC) Subject: [commit: ghc] master: Comments only [skip ci] (05551d0) Message-ID: <20171221183938.05F6B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/05551d00eabaea2734f9ddb5521a2e15233e9ee9/ghc >--------------------------------------------------------------- commit 05551d00eabaea2734f9ddb5521a2e15233e9ee9 Author: Richard Eisenberg Date: Thu Dec 21 13:38:35 2017 -0500 Comments only [skip ci] This fixes a typo and elaborates the Note [TyVarBndrs ...] in TyCoRep, which was previously subtly wrong about Required ForAllTys. >--------------------------------------------------------------- 05551d00eabaea2734f9ddb5521a2e15233e9ee9 compiler/typecheck/TcSimplify.hs | 2 +- compiler/types/TyCoRep.hs | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 8001fd6..56d6c78 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -749,7 +749,7 @@ ctsPreds cts = [ ctEvPred ev | ct <- bagToList cts ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider f = e -where f's type is infeered to be something like (a, Proxy k (Int |> co)) +where f's type is inferred to be something like (a, Proxy k (Int |> co)) and we have an as-yet-unsolved, or perhaps insoluble, constraint [W] co :: Type ~ k We can't form types like (forall co. blah), so we can't generalise over diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index b7d92a2..64e1068 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -486,7 +486,8 @@ This table summarises the visibility rules: | tvis :: ArgFlag | tvis = Inferred: f :: forall {a}. type Arg not allowed: f | tvis = Specified: f :: forall a. type Arg optional: f or f @Int -| tvis = Required: Illegal: See Note [No Required TyBinder in terms] +| tvis = Required: T :: forall k -> type Arg required: T * +| This last form is illegal in terms: See Note [No Required TyBinder in terms] | | TvBndr k cvis :: TyConBinder, in the TyConBinders of a TyCon | cvis :: TyConBndrVis From git at git.haskell.org Thu Dec 21 23:12:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 23:12:09 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Reintegrate lost `ghc-prim` post-release changelog entries (4d99a66) Message-ID: <20171221231209.027103A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/4d99a665986f66f403ad49f7d91a1fc069870274/ghc >--------------------------------------------------------------- commit 4d99a665986f66f403ad49f7d91a1fc069870274 Author: Herbert Valerio Riedel Date: Fri Dec 22 00:04:19 2017 +0100 Reintegrate lost `ghc-prim` post-release changelog entries These changelog entries didn't make the original ghc 8.2.1 release and were produced as part of my post-release documentation process... >--------------------------------------------------------------- 4d99a665986f66f403ad49f7d91a1fc069870274 libraries/ghc-prim/changelog.md | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md index 047720d..d0b06a2 100644 --- a/libraries/ghc-prim/changelog.md +++ b/libraries/ghc-prim/changelog.md @@ -10,7 +10,35 @@ - Added to `GHC.Prim`: - isPinnedByteArray# :: MutableByteArray# s -> Int# + fabsDouble# :: Double# -> Double# + fabsFloat# :: Float# -> Float# + isByteArrayPinned# :: ByteArray# -> Int# + isMutableByteArrayPinned# :: MutableByteArray# s -> Int# + anyToAddr# :: a -> State# (RealWorld) -> (# State# (RealWorld),Addr# #) + +- New primitives for compact regions in `GHC.Prim`: + + Compact# + compactNew# + compactResize# + compactContains# + compactContainsAny# + compactGetFirstBlock# + compactGetNextBlock# + compactAllocateBlock# + compactFixupPointers# + compactAdd# + compactAddWithSharing# + compactSize# + +- Generalised `noDuplicate#` from + + noDuplicate# :: State# (RealWorld) -> State# (RealWorld) + + to + + noDuplicate# :: State# s -> State# s + ## 0.5.0.0 From git at git.haskell.org Thu Dec 21 23:13:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 23:13:41 +0000 (UTC) Subject: [commit: ghc] master: Sync `ghc-prim` changelog from GHC 8.2 (fc257e4) Message-ID: <20171221231341.C007B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fc257e4b60169f2b0f3b0bdef049c90565d8d305/ghc >--------------------------------------------------------------- commit fc257e4b60169f2b0f3b0bdef049c90565d8d305 Author: Herbert Valerio Riedel Date: Fri Dec 22 00:04:19 2017 +0100 Sync `ghc-prim` changelog from GHC 8.2 (cherry picked from commit 4d99a665986f66f403ad49f7d91a1fc069870274) >--------------------------------------------------------------- fc257e4b60169f2b0f3b0bdef049c90565d8d305 libraries/ghc-prim/changelog.md | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md index a2529ea..6248b2f 100644 --- a/libraries/ghc-prim/changelog.md +++ b/libraries/ghc-prim/changelog.md @@ -20,7 +20,35 @@ - Added to `GHC.Prim`: - isPinnedByteArray# :: MutableByteArray# s -> Int# + fabsDouble# :: Double# -> Double# + fabsFloat# :: Float# -> Float# + isByteArrayPinned# :: ByteArray# -> Int# + isMutableByteArrayPinned# :: MutableByteArray# s -> Int# + anyToAddr# :: a -> State# (RealWorld) -> (# State# (RealWorld),Addr# #) + +- New primitives for compact regions in `GHC.Prim`: + + Compact# + compactNew# + compactResize# + compactContains# + compactContainsAny# + compactGetFirstBlock# + compactGetNextBlock# + compactAllocateBlock# + compactFixupPointers# + compactAdd# + compactAddWithSharing# + compactSize# + +- Generalised `noDuplicate#` from + + noDuplicate# :: State# (RealWorld) -> State# (RealWorld) + + to + + noDuplicate# :: State# s -> State# s + ## 0.5.0.0 From git at git.haskell.org Thu Dec 21 23:16:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Dec 2017 23:16:09 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Sync `ghc-prim` changelog from GHC 8.2, again (504b706) Message-ID: <20171221231609.965B13A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/504b7065d81ada8c2e1bf89bdf6cdc15966fa61c/ghc >--------------------------------------------------------------- commit 504b7065d81ada8c2e1bf89bdf6cdc15966fa61c Author: Herbert Valerio Riedel Date: Fri Dec 22 00:04:19 2017 +0100 Sync `ghc-prim` changelog from GHC 8.2, again [skip ci] (cherry picked from commit 4d99a665986f66f403ad49f7d91a1fc069870274) >--------------------------------------------------------------- 504b7065d81ada8c2e1bf89bdf6cdc15966fa61c libraries/ghc-prim/changelog.md | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md index a2529ea..6248b2f 100644 --- a/libraries/ghc-prim/changelog.md +++ b/libraries/ghc-prim/changelog.md @@ -20,7 +20,35 @@ - Added to `GHC.Prim`: - isPinnedByteArray# :: MutableByteArray# s -> Int# + fabsDouble# :: Double# -> Double# + fabsFloat# :: Float# -> Float# + isByteArrayPinned# :: ByteArray# -> Int# + isMutableByteArrayPinned# :: MutableByteArray# s -> Int# + anyToAddr# :: a -> State# (RealWorld) -> (# State# (RealWorld),Addr# #) + +- New primitives for compact regions in `GHC.Prim`: + + Compact# + compactNew# + compactResize# + compactContains# + compactContainsAny# + compactGetFirstBlock# + compactGetNextBlock# + compactAllocateBlock# + compactFixupPointers# + compactAdd# + compactAddWithSharing# + compactSize# + +- Generalised `noDuplicate#` from + + noDuplicate# :: State# (RealWorld) -> State# (RealWorld) + + to + + noDuplicate# :: State# s -> State# s + ## 0.5.0.0 From git at git.haskell.org Fri Dec 22 00:02:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:19 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T13861' created Message-ID: <20171222000219.79A0C3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T13861 Referencing: 793a94f072d6e34c3b4c17346b50a565426aab82 From git at git.haskell.org Fri Dec 22 00:02:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:22 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: first working version (cd73c7e) Message-ID: <20171222000222.6DDC83A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/cd73c7eed75f01b40091acc22af782a461cf3efc/ghc >--------------------------------------------------------------- commit cd73c7eed75f01b40091acc22af782a461cf3efc Author: Gabor Greif Date: Sat Jul 29 16:42:37 2017 +0200 WIP: first working version >--------------------------------------------------------------- cd73c7eed75f01b40091acc22af782a461cf3efc compiler/simplStg/StgCse.hs | 50 +++++++++++++++++++++++++++++++++++++-------- 1 file changed, 42 insertions(+), 8 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 6e89617..23186ef 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilies, ViewPatterns, LambdaCase #-} {-| Note [CSE for Stg] @@ -83,6 +83,9 @@ import Data.Maybe (fromMaybe) import TrieMap import NameEnv import Control.Monad( (>=>) ) +import Data.Function (on) +import Name (NamedThing (..), getOccString, mkFCallName) +import Unique(Uniquable(..), mkUniqueGrimily) -------------- -- The Trie -- @@ -110,9 +113,40 @@ instance TrieMap StgArgMap where newtype ConAppMap a = CAM { un_cam :: DNameEnv (ListMap StgArgMap a) } +newtype LaxDataCon = Lax DataCon + +unLax (Lax dc) = dc +{- +instance Eq LaxDataCon where +-- (==) = (==) `on` dataConTag . unLax + Lax dcl == Lax dcr | dcl == dcr = True + | True {- ((==) `on` dataConTag) dcl dcr + && ((&&) `on` isVanillaDataCon) dcl dcr + && ((==) `on` length {- FIXME? -} . dataConOrigArgTys) dcl dcr -} + = error $ show (getOccString dcl, getOccString dcr) -- True + | otherwise = False +-} +{- +instance Ord LaxDataCon where + l@(Lax dcl) `compare` r@(Lax dcr) = if l == r then EQ else dcl `compare` dcr +-} + +instance NamedThing LaxDataCon where + --getName = getName . unLax + getName (Lax dc) | isVanillaDataCon dc && not hasStrict && not unpacked = mkFCallName uniq "%%%HALLO" + where uniq = mkUniqueGrimily . negate $ dataConTag dc * 10000 + length (dataConOrigArgTys dc) + hasStrict = any (\case HsLazy -> False; _ -> True) (dataConImplBangs dc) + unpacked = isUnboxedTupleCon dc || isUnboxedSumCon dc + getName (Lax dc) = getName dc + +instance Uniquable LaxDataCon where + getUnique = error "Uniquable" -- mkUniqueGrimily . dataConTag . unLax + + instance TrieMap ConAppMap where - type Key ConAppMap = (DataCon, [StgArg]) + type Key ConAppMap = (LaxDataCon, [StgArg]) emptyTM = CAM emptyTM + --lookupTM ((getOccString -> "Just"), args) = error (show ("args", length args)) lookupTM (dataCon, args) = un_cam >.> lkDNamed dataCon >=> lookupTM args alterTM (dataCon, args) f m = m { un_cam = un_cam m |> xtDNamed dataCon |>> alterTM args f } @@ -179,13 +213,13 @@ initEnv in_scope = CseEnv , ce_in_scope = in_scope } -envLookup :: DataCon -> [OutStgArg] -> CseEnv -> Maybe OutId +envLookup :: LaxDataCon -> [OutStgArg] -> CseEnv -> Maybe OutId envLookup dataCon args env = lookupTM (dataCon, args') (ce_conAppMap env) where args' = map go args -- See Note [Trivial case scrutinee] go (StgVarArg v ) = StgVarArg (fromMaybe v $ lookupVarEnv (ce_bndrMap env) v) go (StgLitArg lit) = StgLitArg lit -addDataCon :: OutId -> DataCon -> [OutStgArg] -> CseEnv -> CseEnv +addDataCon :: OutId -> LaxDataCon -> [OutStgArg] -> CseEnv -> CseEnv -- do not bother with nullary data constructors, they are static anyways addDataCon _ _ [] env = env addDataCon bndr dataCon args env = env { ce_conAppMap = new_env } @@ -308,7 +342,7 @@ stgCseExpr env (StgCase scrut bndr ty alts) -- A constructor application. -- To be removed by a variable use when found in the CSE environment stgCseExpr env (StgConApp dataCon args tys) - | Just bndr' <- envLookup dataCon args' env + | Just bndr' <- envLookup (Lax dataCon) args' env = StgApp bndr' [] | otherwise = StgConApp dataCon args' tys @@ -332,7 +366,7 @@ stgCseExpr env (StgLetNoEscape binds body) stgCseAlt :: CseEnv -> OutId -> InStgAlt -> OutStgAlt stgCseAlt env case_bndr (DataAlt dataCon, args, rhs) = let (env1, args') = substBndrs env args - env2 = addDataCon case_bndr dataCon (map StgVarArg args') env1 + env2 = addDataCon case_bndr (Lax dataCon) (map StgVarArg args') env1 -- see note [Case 2: CSEing case binders] rhs' = stgCseExpr env2 rhs in (DataAlt dataCon, args', rhs') @@ -367,11 +401,11 @@ stgCsePairs env0 ((b,e):pairs) -- If it is a constructor application, either short-cut it or extend the environment stgCseRhs :: CseEnv -> OutId -> InStgRhs -> (Maybe (OutId, OutStgRhs), CseEnv) stgCseRhs env bndr (StgRhsCon ccs dataCon args) - | Just other_bndr <- envLookup dataCon args' env + | Just other_bndr <- envLookup (Lax dataCon) args' env = let env' = addSubst bndr other_bndr env in (Nothing, env') | otherwise - = let env' = addDataCon bndr dataCon args' env + = let env' = addDataCon bndr (Lax dataCon) args' env -- see note [Case 1: CSEing allocated closures] pair = (bndr, StgRhsCon ccs dataCon args') in (Just pair, env') From git at git.haskell.org Fri Dec 22 00:02:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:25 +0000 (UTC) Subject: [commit: ghc] wip/T13861: test Right -> Just (d4a36d3) Message-ID: <20171222000225.8F9313A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/d4a36d382ab510e3770bab2515a2a3850c96029a/ghc >--------------------------------------------------------------- commit d4a36d382ab510e3770bab2515a2a3850c96029a Author: Gabor Greif Date: Sat Jul 29 16:43:04 2017 +0200 test Right -> Just >--------------------------------------------------------------- d4a36d382ab510e3770bab2515a2a3850c96029a .../simplStg/should_run/{T9291.hs => T13861.hs} | 39 ++++++++++++++-------- 1 file changed, 26 insertions(+), 13 deletions(-) diff --git a/testsuite/tests/simplStg/should_run/T9291.hs b/testsuite/tests/simplStg/should_run/T13861.hs similarity index 59% copy from testsuite/tests/simplStg/should_run/T9291.hs copy to testsuite/tests/simplStg/should_run/T13861.hs index db2ce75..90a5d67 100644 --- a/testsuite/tests/simplStg/should_run/T9291.hs +++ b/testsuite/tests/simplStg/should_run/T13861.hs @@ -1,16 +1,24 @@ -{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MagicHash, BangPatterns #-} import GHC.Exts import Unsafe.Coerce -foo :: Either Int a -> Either Bool a -foo (Right x) = Right x -foo _ = Left True +foo :: Either Int a -> Maybe a +foo (Right x) = Just x +foo _ = Nothing {-# NOINLINE foo #-} -bar :: a -> (Either Int a, Either Bool a) -bar x = (Right x, Right x) +bar :: a -> (Either Int a, Maybe a) +bar x = (Right x, Just x) {-# NOINLINE bar #-} +data E a b = L a | R !b + +foo' :: E Int a -> Maybe a +foo' (R x) = Just x +foo' _ = Nothing +{-# NOINLINE foo' #-} + + nested :: Either Int (Either Int a) -> Either Bool (Either Bool a) nested (Right (Right x)) = Right (Right x) nested _ = Left True @@ -41,13 +49,18 @@ test x = do (same $! r1) $! r2 let r3 = foo r1 (same $! r1) $! r3 - let (r4,_) = bar r1 - let r5 = nested r4 - (same $! r4) $! r5 - let (T _ r6 r7) = rec1 x - (same $! r6) $! r7 - let s1@(S _ s2) = rec2 x - (same $! s1) $! s2 + let (r30, r31) = (R 'l', foo' r30) + (same $! r30) $! r31 + -- let (r4,_) = bar r1 + -- let r5 = nested r4 + -- (same $! r4) $! r5 + -- let (T _ r6 r7) = rec1 x + -- (same $! r6) $! r7 + -- let s1@(S _ s2) = rec2 x + -- (same $! s1) $! s2 + case r3 of + Just b -> print ("YAY", b) + Nothing -> print "BAD" {-# NOINLINE test #-} main = test "foo" From git at git.haskell.org Fri Dec 22 00:02:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:28 +0000 (UTC) Subject: [commit: ghc] wip/T13861: enable more tests (1ba6a16) Message-ID: <20171222000228.9B3293A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/1ba6a1693be9338d3f53ba9dd4250359388a4690/ghc >--------------------------------------------------------------- commit 1ba6a1693be9338d3f53ba9dd4250359388a4690 Author: Gabor Greif Date: Sat Jul 29 17:36:57 2017 +0200 enable more tests >--------------------------------------------------------------- 1ba6a1693be9338d3f53ba9dd4250359388a4690 testsuite/tests/simplStg/should_run/T13861.hs | 31 +++++++++++++++-------- testsuite/tests/simplStg/should_run/T13861.stdout | 8 ++++++ 2 files changed, 28 insertions(+), 11 deletions(-) diff --git a/testsuite/tests/simplStg/should_run/T13861.hs b/testsuite/tests/simplStg/should_run/T13861.hs index 90a5d67..89b9318 100644 --- a/testsuite/tests/simplStg/should_run/T13861.hs +++ b/testsuite/tests/simplStg/should_run/T13861.hs @@ -18,20 +18,26 @@ foo' (R x) = Just x foo' _ = Nothing {-# NOINLINE foo' #-} +baz :: [a] -> Maybe a +baz [] = Nothing +baz [a] = Just a +baz _ = Nothing +{-# NOINLINE baz #-} -nested :: Either Int (Either Int a) -> Either Bool (Either Bool a) -nested (Right (Right x)) = Right (Right x) + +nested :: Either Int (Either Int a) -> Either Bool (Maybe a) +nested (Right (Right x)) = Right (Just x) nested _ = Left True {-# NOINLINE nested #-} -- CSE in a recursive group -data Tree x = T x (Either Int (Tree x)) (Either Bool (Tree x)) +data Tree x = T x (Either Int (Tree x)) (Maybe (Tree x)) rec1 :: x -> Tree x rec1 x = let t = T x r1 r2 r1 = Right t - r2 = Right t + r2 = Just t in t {-# NOINLINE rec1 #-} @@ -51,13 +57,16 @@ test x = do (same $! r1) $! r3 let (r30, r31) = (R 'l', foo' r30) (same $! r30) $! r31 - -- let (r4,_) = bar r1 - -- let r5 = nested r4 - -- (same $! r4) $! r5 - -- let (T _ r6 r7) = rec1 x - -- (same $! r6) $! r7 - -- let s1@(S _ s2) = rec2 x - -- (same $! s1) $! s2 + + let (r40, r41) = (['l'], baz r40) + (same $! r40) $! r41 + let (r4,_) = bar r1 + let r5 = nested r4 + (same $! r4) $! r5 + let (T _ r6 r7) = rec1 x + (same $! r6) $! r7 + let s1@(S _ s2) = rec2 x + (same $! s1) $! s2 case r3 of Just b -> print ("YAY", b) Nothing -> print "BAD" diff --git a/testsuite/tests/simplStg/should_run/T13861.stdout b/testsuite/tests/simplStg/should_run/T13861.stdout new file mode 100644 index 0000000..3127164 --- /dev/null +++ b/testsuite/tests/simplStg/should_run/T13861.stdout @@ -0,0 +1,8 @@ +yes +yes +no +no +yes +yes +no +("YAY","foo") From git at git.haskell.org Fri Dec 22 00:02:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:31 +0000 (UTC) Subject: [commit: ghc] wip/T13861: more to fix (2244911) Message-ID: <20171222000231.687753A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/2244911e624610068318ca5021256895ae65f1f8/ghc >--------------------------------------------------------------- commit 2244911e624610068318ca5021256895ae65f1f8 Author: Gabor Greif Date: Sat Jul 29 23:05:24 2017 +0200 more to fix >--------------------------------------------------------------- 2244911e624610068318ca5021256895ae65f1f8 compiler/simplStg/StgCse.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index f39ef51..4bfdc42 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -115,8 +115,8 @@ newtype ConAppMap a = CAM { un_cam :: DNameEnv (ListMap StgArgMap a) } newtype LaxDataCon = Lax DataCon instance NamedThing LaxDataCon where - getName (Lax dc) | isVanillaDataCon dc && not hasStrict && not unpacked = mkFCallName uniq "%%%HALLO" -- FIXME - where uniq = mkUniqueGrimily . negate $ dataConTag dc * 10000 + length (dataConOrigArgTys dc) + getName (Lax dc) | isVanillaDataCon dc && not hasStrict && not unpacked = mkFCallName uniq "" -- FIXME: is there a better way? + where uniq = mkUniqueGrimily . negate $ dataConTag dc * 1048576 + length (dataConOrigArgTys dc) -- FIXME hasStrict = any (\case HsLazy -> False; _ -> True) (dataConImplBangs dc) unpacked = isUnboxedTupleCon dc || isUnboxedSumCon dc getName (Lax dc) = getName dc From git at git.haskell.org Fri Dec 22 00:02:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:34 +0000 (UTC) Subject: [commit: ghc] wip/T13861: better comment out some lines that gen warnings (9b4e21a) Message-ID: <20171222000234.305E13A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/9b4e21a962f7805798d348f4a0df25932bf7bbca/ghc >--------------------------------------------------------------- commit 9b4e21a962f7805798d348f4a0df25932bf7bbca Author: Gabor Greif Date: Sun Jul 30 18:15:19 2017 +0200 better comment out some lines that gen warnings >--------------------------------------------------------------- 9b4e21a962f7805798d348f4a0df25932bf7bbca compiler/simplStg/StgCse.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 85695da..d758f48 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -1,5 +1,4 @@ {-# LANGUAGE TypeFamilies, LambdaCase #-} -{-# OPTIONS_GHC -Wno-unused-matches -Wno-missing-signatures #-} {-| Note [CSE for Stg] @@ -126,15 +125,15 @@ instance NamedThing LaxDataCon where instance TrieMap ConAppMap where type Key ConAppMap = (LaxDataCon, [StgArg]) emptyTM = CAM emptyTM - lookupTM (dataCon, args) | traceLookup dataCon = undefined + --lookupTM (dataCon, args) | traceLookup dataCon = undefined lookupTM (dataCon, args) = un_cam >.> lkDNamed dataCon >=> lookupTM args alterTM (dataCon, args) f m = m { un_cam = un_cam m |> xtDNamed dataCon |>> alterTM args f } foldTM k = un_cam >.> foldTM (foldTM k) mapTM f = un_cam >.> mapTM (mapTM f) >.> CAM -traceLookup (Lax dc) = pprTrace "lookupTM" (ppr dc) False -{-# NOINLINE traceLookup #-} +--traceLookup (Lax dc) = pprTrace "lookupTM" (ppr dc) False +--{-# NOINLINE traceLookup #-} ----------------- -- The CSE Env -- From git at git.haskell.org Fri Dec 22 00:02:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:39 +0000 (UTC) Subject: [commit: ghc] wip/T13861: Add T13861 (5a558ae) Message-ID: <20171222000239.C8A223A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/5a558aee8ce9e03fae9316fee989a6179ec3833f/ghc >--------------------------------------------------------------- commit 5a558aee8ce9e03fae9316fee989a6179ec3833f Author: Gabor Greif Date: Sat Jul 29 22:11:01 2017 +0200 Add T13861 >--------------------------------------------------------------- 5a558aee8ce9e03fae9316fee989a6179ec3833f testsuite/tests/simplStg/should_run/all.T | 2 ++ 1 file changed, 2 insertions(+) diff --git a/testsuite/tests/simplStg/should_run/all.T b/testsuite/tests/simplStg/should_run/all.T index d3aa937..6ca2e6b 100644 --- a/testsuite/tests/simplStg/should_run/all.T +++ b/testsuite/tests/simplStg/should_run/all.T @@ -10,6 +10,8 @@ def f( name, opts ): setTestOpts(f) test('T9291', normal, compile_and_run, ['']) +test('T13861', normal, compile_and_run, ['']) + test('T13536', normal, compile_and_run, ['']) test('T13536a', From git at git.haskell.org Fri Dec 22 00:02:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:48 +0000 (UTC) Subject: [commit: ghc] wip/T13861: disable the nullary constr subst for now (06cf168) Message-ID: <20171222000248.452D83A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/06cf168ce84ae59ed11f4169c489f16c37dab2c5/ghc >--------------------------------------------------------------- commit 06cf168ce84ae59ed11f4169c489f16c37dab2c5 Author: Gabor Greif Date: Mon Jul 31 09:13:10 2017 +0200 disable the nullary constr subst for now >--------------------------------------------------------------- 06cf168ce84ae59ed11f4169c489f16c37dab2c5 compiler/simplStg/StgCse.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index d758f48..1b98265 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -203,9 +203,9 @@ envLookup dataCon args env = lookupTM (dataCon, args') (ce_conAppMap env) addDataCon :: OutId -> LaxDataCon -> [OutStgArg] -> CseEnv -> CseEnv -- do not bother with nullary data constructors, they are static anyways -addDataCon bndr dataCon [] env = env { ce_conAppMap = new_env } - where new_env = alterTM (dataCon, []) (\case Nothing -> pure bndr; p -> p) (ce_conAppMap env) ---addDataCon _ _ [] env = env +--addDataCon bndr dataCon [] env = env { ce_conAppMap = new_env } +-- where new_env = alterTM (dataCon, []) (\case Nothing -> pure bndr; p -> p) (ce_conAppMap env) +addDataCon _ _ [] env = env addDataCon bndr dataCon args env = env { ce_conAppMap = new_env } where new_env = insertTM (dataCon, args) bndr (ce_conAppMap env) From git at git.haskell.org Fri Dec 22 00:02:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:45 +0000 (UTC) Subject: [commit: ghc] wip/T13861: clean up (ba67d83) Message-ID: <20171222000245.68FA33A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/ba67d83a3301b053b29a08cb58a0bd7e5563b2da/ghc >--------------------------------------------------------------- commit ba67d83a3301b053b29a08cb58a0bd7e5563b2da Author: Gabor Greif Date: Sat Jul 29 22:21:53 2017 +0200 clean up >--------------------------------------------------------------- ba67d83a3301b053b29a08cb58a0bd7e5563b2da compiler/simplStg/StgCse.hs | 32 +++++--------------------------- 1 file changed, 5 insertions(+), 27 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 23186ef..f39ef51 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeFamilies, ViewPatterns, LambdaCase #-} +{-# LANGUAGE TypeFamilies, LambdaCase #-} {-| Note [CSE for Stg] @@ -83,16 +83,15 @@ import Data.Maybe (fromMaybe) import TrieMap import NameEnv import Control.Monad( (>=>) ) -import Data.Function (on) -import Name (NamedThing (..), getOccString, mkFCallName) -import Unique(Uniquable(..), mkUniqueGrimily) +import Name (NamedThing (..), mkFCallName) +import Unique (mkUniqueGrimily) -------------- -- The Trie -- -------------- -- A lookup trie for data constructor applications, i.e. --- keys of type `(DataCon, [StgArg])`, following the patterns in TrieMap. +-- keys of type `(LaxDataCon, [StgArg])`, following the patterns in TrieMap. data StgArgMap a = SAM { sam_var :: DVarEnv a @@ -115,38 +114,17 @@ newtype ConAppMap a = CAM { un_cam :: DNameEnv (ListMap StgArgMap a) } newtype LaxDataCon = Lax DataCon -unLax (Lax dc) = dc -{- -instance Eq LaxDataCon where --- (==) = (==) `on` dataConTag . unLax - Lax dcl == Lax dcr | dcl == dcr = True - | True {- ((==) `on` dataConTag) dcl dcr - && ((&&) `on` isVanillaDataCon) dcl dcr - && ((==) `on` length {- FIXME? -} . dataConOrigArgTys) dcl dcr -} - = error $ show (getOccString dcl, getOccString dcr) -- True - | otherwise = False --} -{- -instance Ord LaxDataCon where - l@(Lax dcl) `compare` r@(Lax dcr) = if l == r then EQ else dcl `compare` dcr --} - instance NamedThing LaxDataCon where - --getName = getName . unLax - getName (Lax dc) | isVanillaDataCon dc && not hasStrict && not unpacked = mkFCallName uniq "%%%HALLO" + getName (Lax dc) | isVanillaDataCon dc && not hasStrict && not unpacked = mkFCallName uniq "%%%HALLO" -- FIXME where uniq = mkUniqueGrimily . negate $ dataConTag dc * 10000 + length (dataConOrigArgTys dc) hasStrict = any (\case HsLazy -> False; _ -> True) (dataConImplBangs dc) unpacked = isUnboxedTupleCon dc || isUnboxedSumCon dc getName (Lax dc) = getName dc -instance Uniquable LaxDataCon where - getUnique = error "Uniquable" -- mkUniqueGrimily . dataConTag . unLax - instance TrieMap ConAppMap where type Key ConAppMap = (LaxDataCon, [StgArg]) emptyTM = CAM emptyTM - --lookupTM ((getOccString -> "Just"), args) = error (show ("args", length args)) lookupTM (dataCon, args) = un_cam >.> lkDNamed dataCon >=> lookupTM args alterTM (dataCon, args) f m = m { un_cam = un_cam m |> xtDNamed dataCon |>> alterTM args f } From git at git.haskell.org Fri Dec 22 00:02:37 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:37 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: debugging (90bbf84) Message-ID: <20171222000237.00D0E3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/90bbf84120015ab6a90db822f9d705ef5d2e2a5f/ghc >--------------------------------------------------------------- commit 90bbf84120015ab6a90db822f9d705ef5d2e2a5f Author: Gabor Greif Date: Sun Jul 30 13:22:28 2017 +0200 WIP: debugging >--------------------------------------------------------------- 90bbf84120015ab6a90db822f9d705ef5d2e2a5f compiler/simplStg/StgCse.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 4bfdc42..1a3d507 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -115,7 +115,7 @@ newtype ConAppMap a = CAM { un_cam :: DNameEnv (ListMap StgArgMap a) } newtype LaxDataCon = Lax DataCon instance NamedThing LaxDataCon where - getName (Lax dc) | isVanillaDataCon dc && not hasStrict && not unpacked = mkFCallName uniq "" -- FIXME: is there a better way? + getName (Lax dc) | False && isVanillaDataCon dc && not hasStrict && not unpacked = mkFCallName uniq "" -- FIXME: is there a better way? where uniq = mkUniqueGrimily . negate $ dataConTag dc * 1048576 + length (dataConOrigArgTys dc) -- FIXME hasStrict = any (\case HsLazy -> False; _ -> True) (dataConImplBangs dc) unpacked = isUnboxedTupleCon dc || isUnboxedSumCon dc @@ -125,12 +125,16 @@ instance NamedThing LaxDataCon where instance TrieMap ConAppMap where type Key ConAppMap = (LaxDataCon, [StgArg]) emptyTM = CAM emptyTM + lookupTM (dataCon, args) | traceLookup dataCon = undefined lookupTM (dataCon, args) = un_cam >.> lkDNamed dataCon >=> lookupTM args alterTM (dataCon, args) f m = m { un_cam = un_cam m |> xtDNamed dataCon |>> alterTM args f } foldTM k = un_cam >.> foldTM (foldTM k) mapTM f = un_cam >.> mapTM (mapTM f) >.> CAM +traceLookup (Lax dc) = pprTrace "lookupTM" (ppr dc) False +{-# NOINLINE traceLookup #-} + ----------------- -- The CSE Env -- ----------------- @@ -199,7 +203,9 @@ envLookup dataCon args env = lookupTM (dataCon, args') (ce_conAppMap env) addDataCon :: OutId -> LaxDataCon -> [OutStgArg] -> CseEnv -> CseEnv -- do not bother with nullary data constructors, they are static anyways -addDataCon _ _ [] env = env +addDataCon bndr dataCon [] env = env { ce_conAppMap = new_env } + where new_env = alterTM (dataCon, []) (\case Nothing -> pure bndr; p -> p) (ce_conAppMap env) +--addDataCon _ _ [] env = env addDataCon bndr dataCon args env = env { ce_conAppMap = new_env } where new_env = insertTM (dataCon, args) bndr (ce_conAppMap env) From git at git.haskell.org Fri Dec 22 00:02:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:42 +0000 (UTC) Subject: [commit: ghc] wip/T13861: suppress some warnings for now and enable the optsn (671e97e) Message-ID: <20171222000242.963EC3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/671e97e3b2ec6704fbe66186c01f2f7c5a84f7d4/ghc >--------------------------------------------------------------- commit 671e97e3b2ec6704fbe66186c01f2f7c5a84f7d4 Author: Gabor Greif Date: Sun Jul 30 17:47:09 2017 +0200 suppress some warnings for now and enable the optsn >--------------------------------------------------------------- 671e97e3b2ec6704fbe66186c01f2f7c5a84f7d4 compiler/simplStg/StgCse.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 1a3d507..85695da 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies, LambdaCase #-} +{-# OPTIONS_GHC -Wno-unused-matches -Wno-missing-signatures #-} {-| Note [CSE for Stg] @@ -115,7 +116,7 @@ newtype ConAppMap a = CAM { un_cam :: DNameEnv (ListMap StgArgMap a) } newtype LaxDataCon = Lax DataCon instance NamedThing LaxDataCon where - getName (Lax dc) | False && isVanillaDataCon dc && not hasStrict && not unpacked = mkFCallName uniq "" -- FIXME: is there a better way? + getName (Lax dc) | isVanillaDataCon dc && not hasStrict && not unpacked = mkFCallName uniq "" -- FIXME: is there a better way? where uniq = mkUniqueGrimily . negate $ dataConTag dc * 1048576 + length (dataConOrigArgTys dc) -- FIXME hasStrict = any (\case HsLazy -> False; _ -> True) (dataConImplBangs dc) unpacked = isUnboxedTupleCon dc || isUnboxedSumCon dc From git at git.haskell.org Fri Dec 22 00:02:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:51 +0000 (UTC) Subject: [commit: ghc] wip/T13861: add TODOs (6d30495) Message-ID: <20171222000251.144783A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/6d3049543ed9bb684b0c207aaf877502676516cb/ghc >--------------------------------------------------------------- commit 6d3049543ed9bb684b0c207aaf877502676516cb Author: Gabor Greif Date: Mon Jul 31 12:04:07 2017 +0200 add TODOs >--------------------------------------------------------------- 6d3049543ed9bb684b0c207aaf877502676516cb compiler/simplStg/StgCse.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 1b98265..3b989a0 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -13,6 +13,12 @@ There are two types of common code occurrences that we aim for, see note [Case 1: CSEing allocated closures] and note [Case 2: CSEing case binders] below. +TODOs: +- rerun occurrence analysis +- dumping of STG misses binder +- does not look up in scope to find low-hanging fruit +- can we dedup info tables for representationally equal data constructors? + Note [Case 1: CSEing allocated closures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -203,9 +209,9 @@ envLookup dataCon args env = lookupTM (dataCon, args') (ce_conAppMap env) addDataCon :: OutId -> LaxDataCon -> [OutStgArg] -> CseEnv -> CseEnv -- do not bother with nullary data constructors, they are static anyways ---addDataCon bndr dataCon [] env = env { ce_conAppMap = new_env } --- where new_env = alterTM (dataCon, []) (\case Nothing -> pure bndr; p -> p) (ce_conAppMap env) -addDataCon _ _ [] env = env +addDataCon bndr dataCon [] env = env { ce_conAppMap = new_env } + where new_env = alterTM (dataCon, []) (\case Nothing -> pure bndr; p -> p) (ce_conAppMap env) +--addDataCon _ _ [] env = env addDataCon bndr dataCon args env = env { ce_conAppMap = new_env } where new_env = insertTM (dataCon, args) bndr (ce_conAppMap env) From git at git.haskell.org Fri Dec 22 00:02:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:59 +0000 (UTC) Subject: [commit: ghc] wip/T13861: add more test cases (1bee0e8) Message-ID: <20171222000259.7722F3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/1bee0e8895a8a452e72714f0bf960903629ba738/ghc >--------------------------------------------------------------- commit 1bee0e8895a8a452e72714f0bf960903629ba738 Author: Gabor Greif Date: Mon Jul 31 12:08:29 2017 +0200 add more test cases >--------------------------------------------------------------- 1bee0e8895a8a452e72714f0bf960903629ba738 testsuite/tests/simplStg/should_run/T13861.hs | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/simplStg/should_run/T13861.hs b/testsuite/tests/simplStg/should_run/T13861.hs index 89b9318..4f7e9e0 100644 --- a/testsuite/tests/simplStg/should_run/T13861.hs +++ b/testsuite/tests/simplStg/should_run/T13861.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE MagicHash, BangPatterns #-} +{-# LANGUAGE MagicHash, BangPatterns, TypeOperators, GADTs #-} import GHC.Exts +import Data.Type.Equality import Unsafe.Coerce foo :: Either Int a -> Maybe a @@ -50,6 +51,13 @@ rec2 x = in s1 {-# NOINLINE rec2 #-} + +eq1 :: a :~: b -> [a] +eq1 Refl = [] +{-# NOINLINE eq1 #-} + + + test x = do let (r1,r2) = bar x (same $! r1) $! r2 @@ -60,6 +68,13 @@ test x = do let (r40, r41) = (['l'], baz r40) (same $! r40) $! r41 + let (r42, r43) = ([], eq1 r42) + (same $! r42) $! r43 + let (r44, r45) = ("ab", eq1 r44) + (same $! r44) $! r45 + let (r46, r47) = (Refl, eq1 r46) + (same $! r46) $! r47 + let (r4,_) = bar r1 let r5 = nested r4 (same $! r4) $! r5 From git at git.haskell.org Fri Dec 22 00:02:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:53 +0000 (UTC) Subject: [commit: ghc] wip/T13861: debugging (5058f4c) Message-ID: <20171222000253.D77A53A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/5058f4c22df1782d0ba1290535ab91217333239f/ghc >--------------------------------------------------------------- commit 5058f4c22df1782d0ba1290535ab91217333239f Author: Gabor Greif Date: Sat Aug 12 16:30:37 2017 +0200 debugging >--------------------------------------------------------------- 5058f4c22df1782d0ba1290535ab91217333239f compiler/simplStg/StgCse.hs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 3b989a0..263f184 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -14,6 +14,7 @@ note [Case 1: CSEing allocated closures] and note [Case 2: CSEing case binders] below. TODOs: +- vanilla for unpacked tuples? - rerun occurrence analysis - dumping of STG misses binder - does not look up in scope to find low-hanging fruit @@ -89,8 +90,8 @@ import Data.Maybe (fromMaybe) import TrieMap import NameEnv import Control.Monad( (>=>) ) -import Name (NamedThing (..), mkFCallName) -import Unique (mkUniqueGrimily) +import Name (NamedThing (..), mkFCallName, nameUnique) +import Unique (mkUniqueGrimily, getKey) -------------- -- The Trie -- @@ -121,25 +122,28 @@ newtype ConAppMap a = CAM { un_cam :: DNameEnv (ListMap StgArgMap a) } newtype LaxDataCon = Lax DataCon instance NamedThing LaxDataCon where - getName (Lax dc) | isVanillaDataCon dc && not hasStrict && not unpacked = mkFCallName uniq "" -- FIXME: is there a better way? + getName (Lax dc) | long && isVanillaDataCon dc && not hasStrict && not unpacked = mkFCallName uniq "" -- FIXME: is there a better way? where uniq = mkUniqueGrimily . negate $ dataConTag dc * 1048576 + length (dataConOrigArgTys dc) -- FIXME hasStrict = any (\case HsLazy -> False; _ -> True) (dataConImplBangs dc) unpacked = isUnboxedTupleCon dc || isUnboxedSumCon dc + long = length (dataConOrigArgTys dc) > 2 getName (Lax dc) = getName dc instance TrieMap ConAppMap where type Key ConAppMap = (LaxDataCon, [StgArg]) emptyTM = CAM emptyTM - --lookupTM (dataCon, args) | traceLookup dataCon = undefined + lookupTM (dataCon, args) | traceLookup dataCon = undefined lookupTM (dataCon, args) = un_cam >.> lkDNamed dataCon >=> lookupTM args alterTM (dataCon, args) f m = m { un_cam = un_cam m |> xtDNamed dataCon |>> alterTM args f } foldTM k = un_cam >.> foldTM (foldTM k) mapTM f = un_cam >.> mapTM (mapTM f) >.> CAM ---traceLookup (Lax dc) = pprTrace "lookupTM" (ppr dc) False ---{-# NOINLINE traceLookup #-} +traceLookup l@(Lax dc) = pprTrace "lookupTM" (ppr dc <> (if getKey u < 0 then text " -" else text " ") <> ppr u') False + where u = nameUnique . getName $ l + u' = mkUniqueGrimily (abs(getKey u)) +{-# NOINLINE traceLookup #-} ----------------- -- The CSE Env -- From git at git.haskell.org Fri Dec 22 00:02:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:02:56 +0000 (UTC) Subject: [commit: ghc] wip/T13861: ooops (1990632) Message-ID: <20171222000256.A7A9C3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/199063287da7f635092bc0f0ae220dc030888288/ghc >--------------------------------------------------------------- commit 199063287da7f635092bc0f0ae220dc030888288 Author: Gabor Greif Date: Mon Jul 31 12:09:51 2017 +0200 ooops >--------------------------------------------------------------- 199063287da7f635092bc0f0ae220dc030888288 testsuite/tests/simplStg/should_run/T13861.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/simplStg/should_run/T13861.hs b/testsuite/tests/simplStg/should_run/T13861.hs index 4f7e9e0..4645348 100644 --- a/testsuite/tests/simplStg/should_run/T13861.hs +++ b/testsuite/tests/simplStg/should_run/T13861.hs @@ -68,9 +68,9 @@ test x = do let (r40, r41) = (['l'], baz r40) (same $! r40) $! r41 - let (r42, r43) = ([], eq1 r42) + let (r42, r43) = ([], baz r42) (same $! r42) $! r43 - let (r44, r45) = ("ab", eq1 r44) + let (r44, r45) = ("ab", baz r44) (same $! r44) $! r45 let (r46, r47) = (Refl, eq1 r46) (same $! r46) $! r47 From git at git.haskell.org Fri Dec 22 00:03:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:03:02 +0000 (UTC) Subject: [commit: ghc] wip/T13861: the nullary constructors are the troublesome ones (9fee1f0) Message-ID: <20171222000302.519F23A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/9fee1f0af82d5d7aa3cd85785b9e7711e3a02a08/ghc >--------------------------------------------------------------- commit 9fee1f0af82d5d7aa3cd85785b9e7711e3a02a08 Author: Gabor Greif Date: Mon Aug 21 00:19:45 2017 +0200 the nullary constructors are the troublesome ones >--------------------------------------------------------------- 9fee1f0af82d5d7aa3cd85785b9e7711e3a02a08 compiler/simplStg/StgCse.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index f1dc186..88a2c7d 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -92,7 +92,7 @@ import TrieMap import NameEnv import Control.Monad( (>=>) ) import Name (NamedThing (..), mkFCallName, nameUnique) -import Unique (mkUniqueGrimily, getKey) +import Unique (mkUniqueGrimily, getKey, getUnique) -------------- -- The Trie -- @@ -127,7 +127,7 @@ instance NamedThing LaxDataCon where where uniq = mkUniqueGrimily . negate $ dataConTag dc * 1048576 + length (dataConOrigArgTys dc) -- FIXME hasStrict = any (\case HsLazy -> False; _ -> True) (dataConImplBangs dc) unpacked = isUnboxedTupleCon dc || isUnboxedSumCon dc - long = length (dataConOrigArgTys dc) > 1 + long = True -- length (dataConOrigArgTys dc) > 0 getName (Lax dc) = getName dc @@ -341,11 +341,13 @@ stgCseExpr env (StgCase scrut bndr ty alts) -- A constructor application. -- To be removed by a variable use when found in the CSE environment stgCseExpr env (StgConApp dataCon args tys) - | Just bndr' <- envLookup (Lax dataCon) args' env - = StgApp bndr' [] + | Just bndr' <- envLookup dc args' env + = (if getKey u < 0 then pprTrace "stgCseExpr" (ppr dataCon) else id) $ StgApp bndr' [] | otherwise = StgConApp dataCon args' tys where args' = substArgs env args + dc = Lax dataCon + u = getUnique (getName dc) -- Let bindings -- The binding might be removed due to CSE (we do not want trivial bindings on From git at git.haskell.org Fri Dec 22 00:03:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:03:08 +0000 (UTC) Subject: [commit: ghc] wip/T13861: fix stage 2 warnings (ae1a850) Message-ID: <20171222000308.00FAF3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/ae1a85018c82b965bfa134666679381f327aa9ef/ghc >--------------------------------------------------------------- commit ae1a85018c82b965bfa134666679381f327aa9ef Author: Gabor Greif Date: Mon Aug 14 14:12:49 2017 +0200 fix stage 2 warnings >--------------------------------------------------------------- ae1a85018c82b965bfa134666679381f327aa9ef compiler/simplStg/StgCse.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 263f184..65b5cb8 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -133,13 +133,14 @@ instance NamedThing LaxDataCon where instance TrieMap ConAppMap where type Key ConAppMap = (LaxDataCon, [StgArg]) emptyTM = CAM emptyTM - lookupTM (dataCon, args) | traceLookup dataCon = undefined + lookupTM (dataCon, _) | traceLookup dataCon = undefined lookupTM (dataCon, args) = un_cam >.> lkDNamed dataCon >=> lookupTM args alterTM (dataCon, args) f m = m { un_cam = un_cam m |> xtDNamed dataCon |>> alterTM args f } foldTM k = un_cam >.> foldTM (foldTM k) mapTM f = un_cam >.> mapTM (mapTM f) >.> CAM +traceLookup :: LaxDataCon -> Bool traceLookup l@(Lax dc) = pprTrace "lookupTM" (ppr dc <> (if getKey u < 0 then text " -" else text " ") <> ppr u') False where u = nameUnique . getName $ l u' = mkUniqueGrimily (abs(getKey u)) From git at git.haskell.org Fri Dec 22 00:03:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:03:10 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: more debugging, reduce to nullary, no compex (8e74002) Message-ID: <20171222000310.BEF233A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/8e740024219bbd888d3b408c19b0312d9e8681ff/ghc >--------------------------------------------------------------- commit 8e740024219bbd888d3b408c19b0312d9e8681ff Author: Gabor Greif Date: Tue Aug 29 11:44:56 2017 +0200 WIP: more debugging, reduce to nullary, no compex >--------------------------------------------------------------- 8e740024219bbd888d3b408c19b0312d9e8681ff compiler/simplStg/StgCse.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index bfa02b2..0842a4f 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -127,7 +127,7 @@ instance NamedThing LaxDataCon where where uniq = mkUniqueGrimily . negate $ dataConTag dc * 1048576 + length (dataConOrigArgTys dc) -- FIXME hasStrict = any (\case HsLazy -> False; _ -> True) (dataConImplBangs dc) unpacked = isUnboxedTupleCon dc || isUnboxedSumCon dc - long = True -- length (dataConOrigArgTys dc) > 0 + long = null $ dataConOrigArgTys dc -- True -- length (dataConOrigArgTys dc) > 0 getName (Lax dc) = getName dc @@ -340,11 +340,11 @@ stgCseExpr env (StgCase scrut bndr ty alts) -- A constructor application. -- To be removed by a variable use when found in the CSE environment -stgCseExpr env (StgConApp dataCon args tys) +stgCseExpr env orig@(StgConApp dataCon args tys) | Just bndr' <- envLookup dc args' env = (if getKey u < 0 then pprTrace "stgCseExpr" (ppr dataCon <+> text (show $ length (dataConOrigArgTys dataCon))) else id) $ StgApp bndr' [] | otherwise - = StgConApp dataCon args' tys + = orig -- StgConApp dataCon args' tys where args' = substArgs env args dc = Lax dataCon u = getUnique (getName dc) From git at git.haskell.org Fri Dec 22 00:03:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:03:13 +0000 (UTC) Subject: [commit: ghc] wip/T13861: back out this change, it worsens things (685e911) Message-ID: <20171222000313.86BAC3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/685e9111d36fbd3e8c155d6c24a827421799770e/ghc >--------------------------------------------------------------- commit 685e9111d36fbd3e8c155d6c24a827421799770e Author: Gabor Greif Date: Thu Aug 31 16:00:33 2017 +0200 back out this change, it worsens things >--------------------------------------------------------------- 685e9111d36fbd3e8c155d6c24a827421799770e compiler/simplStg/StgCse.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 0842a4f..e777e3a 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -344,7 +344,7 @@ stgCseExpr env orig@(StgConApp dataCon args tys) | Just bndr' <- envLookup dc args' env = (if getKey u < 0 then pprTrace "stgCseExpr" (ppr dataCon <+> text (show $ length (dataConOrigArgTys dataCon))) else id) $ StgApp bndr' [] | otherwise - = orig -- StgConApp dataCon args' tys + = StgConApp dataCon args' tys where args' = substArgs env args dc = Lax dataCon u = getUnique (getName dc) From git at git.haskell.org Fri Dec 22 00:03:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:03:16 +0000 (UTC) Subject: [commit: ghc] wip/T13861: more debugging (00f8f41) Message-ID: <20171222000316.4A9353A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/00f8f41bb5e3ac3caa562b07cc642350944992a5/ghc >--------------------------------------------------------------- commit 00f8f41bb5e3ac3caa562b07cc642350944992a5 Author: Gabor Greif Date: Mon Aug 14 17:46:24 2017 +0200 more debugging >--------------------------------------------------------------- 00f8f41bb5e3ac3caa562b07cc642350944992a5 compiler/simplStg/StgCse.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 65b5cb8..f1dc186 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies, LambdaCase #-} +{-# OPTIONS -Wno-error=unused-imports -Wno-error=unused-top-binds #-} {-| Note [CSE for Stg] @@ -126,14 +127,14 @@ instance NamedThing LaxDataCon where where uniq = mkUniqueGrimily . negate $ dataConTag dc * 1048576 + length (dataConOrigArgTys dc) -- FIXME hasStrict = any (\case HsLazy -> False; _ -> True) (dataConImplBangs dc) unpacked = isUnboxedTupleCon dc || isUnboxedSumCon dc - long = length (dataConOrigArgTys dc) > 2 + long = length (dataConOrigArgTys dc) > 1 getName (Lax dc) = getName dc instance TrieMap ConAppMap where type Key ConAppMap = (LaxDataCon, [StgArg]) emptyTM = CAM emptyTM - lookupTM (dataCon, _) | traceLookup dataCon = undefined + --lookupTM (dataCon, _) | traceLookup dataCon = undefined lookupTM (dataCon, args) = un_cam >.> lkDNamed dataCon >=> lookupTM args alterTM (dataCon, args) f m = m { un_cam = un_cam m |> xtDNamed dataCon |>> alterTM args f } @@ -141,9 +142,12 @@ instance TrieMap ConAppMap where mapTM f = un_cam >.> mapTM (mapTM f) >.> CAM traceLookup :: LaxDataCon -> Bool +traceLookup _ = False +{- traceLookup l@(Lax dc) = pprTrace "lookupTM" (ppr dc <> (if getKey u < 0 then text " -" else text " ") <> ppr u') False where u = nameUnique . getName $ l u' = mkUniqueGrimily (abs(getKey u)) +-} {-# NOINLINE traceLookup #-} ----------------- From git at git.haskell.org Fri Dec 22 00:03:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:03:19 +0000 (UTC) Subject: [commit: ghc] wip/T13861: Simplify mrStr (1fd74fc) Message-ID: <20171222000319.130773A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/1fd74fcc798e4da07fdefb8d02dff479abe27d34/ghc >--------------------------------------------------------------- commit 1fd74fcc798e4da07fdefb8d02dff479abe27d34 Author: Gabor Greif Date: Tue Sep 5 17:13:46 2017 +0200 Simplify mrStr >--------------------------------------------------------------- 1fd74fcc798e4da07fdefb8d02dff479abe27d34 compiler/cmm/CmmType.hs | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/compiler/cmm/CmmType.hs b/compiler/cmm/CmmType.hs index cb15dc7..a696401 100644 --- a/compiler/cmm/CmmType.hs +++ b/compiler/cmm/CmmType.hs @@ -177,14 +177,7 @@ instance Outputable Width where ppr rep = ptext (mrStr rep) mrStr :: Width -> LitString -mrStr W8 = sLit("W8") -mrStr W16 = sLit("W16") -mrStr W32 = sLit("W32") -mrStr W64 = sLit("W64") -mrStr W128 = sLit("W128") -mrStr W256 = sLit("W256") -mrStr W512 = sLit("W512") -mrStr W80 = sLit("W80") +mrStr = sLit . show -------- Common Widths ------------ From git at git.haskell.org Fri Dec 22 00:03:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:03:05 +0000 (UTC) Subject: [commit: ghc] wip/T13861: also show constructor arity (f266c73) Message-ID: <20171222000305.312E63A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/f266c73af3bdbbd01b28987b17821019452f6b47/ghc >--------------------------------------------------------------- commit f266c73af3bdbbd01b28987b17821019452f6b47 Author: Gabor Greif Date: Fri Aug 25 15:59:07 2017 +0200 also show constructor arity >--------------------------------------------------------------- f266c73af3bdbbd01b28987b17821019452f6b47 compiler/simplStg/StgCse.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 88a2c7d..bfa02b2 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -342,7 +342,7 @@ stgCseExpr env (StgCase scrut bndr ty alts) -- To be removed by a variable use when found in the CSE environment stgCseExpr env (StgConApp dataCon args tys) | Just bndr' <- envLookup dc args' env - = (if getKey u < 0 then pprTrace "stgCseExpr" (ppr dataCon) else id) $ StgApp bndr' [] + = (if getKey u < 0 then pprTrace "stgCseExpr" (ppr dataCon <+> text (show $ length (dataConOrigArgTys dataCon))) else id) $ StgApp bndr' [] | otherwise = StgConApp dataCon args' tys where args' = substArgs env args From git at git.haskell.org Fri Dec 22 00:03:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:03:21 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: cleverer tagging? (f23c042) Message-ID: <20171222000321.D98803A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/f23c0423f05d26e081b47f6382fe8f2a4610b022/ghc >--------------------------------------------------------------- commit f23c0423f05d26e081b47f6382fe8f2a4610b022 Author: Gabor Greif Date: Tue Oct 17 00:21:06 2017 +0200 WIP: cleverer tagging? >--------------------------------------------------------------- f23c0423f05d26e081b47f6382fe8f2a4610b022 compiler/codeGen/StgCmmClosure.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 1da1f70..6daedba 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -354,7 +354,8 @@ type DynTag = Int -- The tag on a *pointer* -- * big, otherwise. -- -- Small families can have the constructor tag in the tag bits. --- Big families only use the tag value 1 to represent evaluatedness. +-- Big families only use the tag value 1..mAX_PTR_TAG to represent +-- evaluatedness, the last one lumping together all overflowing ones. -- We don't have very many tag bits: for example, we have 2 bits on -- x86-32 and 3 bits on x86-64. @@ -364,10 +365,12 @@ isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags tagForCon :: DynFlags -> DataCon -> DynTag tagForCon dflags con | isSmallFamily dflags fam_size = con_tag - | otherwise = 1 + | con_tag < max_tag = con_tag + | otherwise = max_tag where con_tag = dataConTag con -- NB: 1-indexed fam_size = tyConFamilySize (dataConTyCon con) + max_tag = mAX_PTR_TAG dflags tagForArity :: DynFlags -> RepArity -> DynTag tagForArity dflags arity From git at git.haskell.org Fri Dec 22 00:03:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:03:24 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: debugging, we can get the family size! (63c09d3) Message-ID: <20171222000324.CE7C13A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/63c09d399684598e52f6596ab62f7860a1b1cbd8/ghc >--------------------------------------------------------------- commit 63c09d399684598e52f6596ab62f7860a1b1cbd8 Author: Gabor Greif Date: Tue Oct 17 02:00:26 2017 +0200 WIP: debugging, we can get the family size! >--------------------------------------------------------------- 63c09d399684598e52f6596ab62f7860a1b1cbd8 compiler/simplStg/StgCse.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index e777e3a..02b3891 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -93,6 +93,7 @@ import NameEnv import Control.Monad( (>=>) ) import Name (NamedThing (..), mkFCallName, nameUnique) import Unique (mkUniqueGrimily, getKey, getUnique) +import TyCon (tyConFamilySize) -------------- -- The Trie -- @@ -127,7 +128,7 @@ instance NamedThing LaxDataCon where where uniq = mkUniqueGrimily . negate $ dataConTag dc * 1048576 + length (dataConOrigArgTys dc) -- FIXME hasStrict = any (\case HsLazy -> False; _ -> True) (dataConImplBangs dc) unpacked = isUnboxedTupleCon dc || isUnboxedSumCon dc - long = null $ dataConOrigArgTys dc -- True -- length (dataConOrigArgTys dc) > 0 + long = dataConTag dc < 7 && (null $ dataConOrigArgTys dc) -- True -- length (dataConOrigArgTys dc) > 0 getName (Lax dc) = getName dc @@ -342,7 +343,7 @@ stgCseExpr env (StgCase scrut bndr ty alts) -- To be removed by a variable use when found in the CSE environment stgCseExpr env orig@(StgConApp dataCon args tys) | Just bndr' <- envLookup dc args' env - = (if getKey u < 0 then pprTrace "stgCseExpr" (ppr dataCon <+> text (show $ length (dataConOrigArgTys dataCon))) else id) $ StgApp bndr' [] + = (if getKey u < 0 then pprTrace "stgCseExpr" (ppr dataCon <+> text (show $ length (dataConOrigArgTys dataCon)) <+> (text . show $ tyConFamilySize (dataConTyCon dataCon))) else id) $ StgApp bndr' [] | otherwise = StgConApp dataCon args' tys where args' = substArgs env args From git at git.haskell.org Fri Dec 22 00:03:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:03:28 +0000 (UTC) Subject: [commit: ghc] wip/T13861: Merge branch 'wip/cross-constr-cse' into wip/T13861 (793a94f) Message-ID: <20171222000328.AB0CA3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/793a94f072d6e34c3b4c17346b50a565426aab82/ghc >--------------------------------------------------------------- commit 793a94f072d6e34c3b4c17346b50a565426aab82 Merge: 5719218 63c09d3 Author: Gabor Greif Date: Fri Dec 22 00:58:52 2017 +0100 Merge branch 'wip/cross-constr-cse' into wip/T13861 Conflicts: compiler/codeGen/StgCmmClosure.hs >--------------------------------------------------------------- 793a94f072d6e34c3b4c17346b50a565426aab82 compiler/cmm/CmmType.hs | 9 +-- compiler/simplStg/StgCse.hs | 60 +++++++++++--- testsuite/tests/simplStg/should_run/T13861.hs | 95 +++++++++++++++++++++++ testsuite/tests/simplStg/should_run/T13861.stdout | 8 ++ testsuite/tests/simplStg/should_run/all.T | 2 + 5 files changed, 154 insertions(+), 20 deletions(-) From git at git.haskell.org Fri Dec 22 00:51:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 00:51:25 +0000 (UTC) Subject: [commit: ghc] wip/T13861: travis compilation (5823ac7) Message-ID: <20171222005125.192333A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/5823ac7a18d0645a96d1febc75560f27d0577adc/ghc >--------------------------------------------------------------- commit 5823ac7a18d0645a96d1febc75560f27d0577adc Author: Gabor Greif Date: Fri Dec 22 01:50:44 2017 +0100 travis compilation >--------------------------------------------------------------- 5823ac7a18d0645a96d1febc75560f27d0577adc compiler/simplStg/StgCse.hs | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 02b3891..670a3ad 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -91,7 +91,7 @@ import Data.Maybe (fromMaybe) import TrieMap import NameEnv import Control.Monad( (>=>) ) -import Name (NamedThing (..), mkFCallName, nameUnique) +import Name (NamedThing (..), mkFCallName) import Unique (mkUniqueGrimily, getKey, getUnique) import TyCon (tyConFamilySize) @@ -135,21 +135,12 @@ instance NamedThing LaxDataCon where instance TrieMap ConAppMap where type Key ConAppMap = (LaxDataCon, [StgArg]) emptyTM = CAM emptyTM - --lookupTM (dataCon, _) | traceLookup dataCon = undefined lookupTM (dataCon, args) = un_cam >.> lkDNamed dataCon >=> lookupTM args alterTM (dataCon, args) f m = m { un_cam = un_cam m |> xtDNamed dataCon |>> alterTM args f } foldTM k = un_cam >.> foldTM (foldTM k) mapTM f = un_cam >.> mapTM (mapTM f) >.> CAM -traceLookup :: LaxDataCon -> Bool -traceLookup _ = False -{- -traceLookup l@(Lax dc) = pprTrace "lookupTM" (ppr dc <> (if getKey u < 0 then text " -" else text " ") <> ppr u') False - where u = nameUnique . getName $ l - u' = mkUniqueGrimily (abs(getKey u)) --} -{-# NOINLINE traceLookup #-} ----------------- -- The CSE Env -- @@ -341,7 +332,7 @@ stgCseExpr env (StgCase scrut bndr ty alts) -- A constructor application. -- To be removed by a variable use when found in the CSE environment -stgCseExpr env orig@(StgConApp dataCon args tys) +stgCseExpr env (StgConApp dataCon args tys) | Just bndr' <- envLookup dc args' env = (if getKey u < 0 then pprTrace "stgCseExpr" (ppr dataCon <+> text (show $ length (dataConOrigArgTys dataCon)) <+> (text . show $ tyConFamilySize (dataConTyCon dataCon))) else id) $ StgApp bndr' [] | otherwise From git at git.haskell.org Fri Dec 22 11:38:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 11:38:11 +0000 (UTC) Subject: [commit: ghc] wip/T13861: take out the doorstops (4ddb842) Message-ID: <20171222113811.690663A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/4ddb8421ef34ad9c15492ec894d554c9083b9045/ghc >--------------------------------------------------------------- commit 4ddb8421ef34ad9c15492ec894d554c9083b9045 Author: Gabor Greif Date: Fri Dec 22 12:23:07 2017 +0100 take out the doorstops consider everything for CSE >--------------------------------------------------------------- 4ddb8421ef34ad9c15492ec894d554c9083b9045 compiler/simplStg/StgCse.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 670a3ad..9b3bb26 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -128,7 +128,7 @@ instance NamedThing LaxDataCon where where uniq = mkUniqueGrimily . negate $ dataConTag dc * 1048576 + length (dataConOrigArgTys dc) -- FIXME hasStrict = any (\case HsLazy -> False; _ -> True) (dataConImplBangs dc) unpacked = isUnboxedTupleCon dc || isUnboxedSumCon dc - long = dataConTag dc < 7 && (null $ dataConOrigArgTys dc) -- True -- length (dataConOrigArgTys dc) > 0 + long = True -- length (dataConOrigArgTys dc) > 0 getName (Lax dc) = getName dc @@ -209,10 +209,8 @@ envLookup dataCon args env = lookupTM (dataCon, args') (ce_conAppMap env) go (StgLitArg lit) = StgLitArg lit addDataCon :: OutId -> LaxDataCon -> [OutStgArg] -> CseEnv -> CseEnv --- do not bother with nullary data constructors, they are static anyways addDataCon bndr dataCon [] env = env { ce_conAppMap = new_env } where new_env = alterTM (dataCon, []) (\case Nothing -> pure bndr; p -> p) (ce_conAppMap env) ---addDataCon _ _ [] env = env addDataCon bndr dataCon args env = env { ce_conAppMap = new_env } where new_env = insertTM (dataCon, args) bndr (ce_conAppMap env) From git at git.haskell.org Fri Dec 22 11:38:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 11:38:14 +0000 (UTC) Subject: [commit: ghc] wip/T13861: trace less (25628d1) Message-ID: <20171222113814.357713A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/25628d1824f84fddd10baad3225524237ffd1b48/ghc >--------------------------------------------------------------- commit 25628d1824f84fddd10baad3225524237ffd1b48 Author: Gabor Greif Date: Fri Dec 22 12:26:38 2017 +0100 trace less >--------------------------------------------------------------- 25628d1824f84fddd10baad3225524237ffd1b48 compiler/simplStg/StgCse.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 9b3bb26..3712956 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -332,7 +332,7 @@ stgCseExpr env (StgCase scrut bndr ty alts) -- To be removed by a variable use when found in the CSE environment stgCseExpr env (StgConApp dataCon args tys) | Just bndr' <- envLookup dc args' env - = (if getKey u < 0 then pprTrace "stgCseExpr" (ppr dataCon <+> text (show $ length (dataConOrigArgTys dataCon)) <+> (text . show $ tyConFamilySize (dataConTyCon dataCon))) else id) $ StgApp bndr' [] + = StgApp bndr' [] | otherwise = StgConApp dataCon args' tys where args' = substArgs env args From git at git.haskell.org Fri Dec 22 14:32:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 14:32:57 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: status quo (4c209ef) Message-ID: <20171222143257.2170B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/4c209ef3b3c236b554ebbfec4b5400f6795be7d3/ghc >--------------------------------------------------------------- commit 4c209ef3b3c236b554ebbfec4b5400f6795be7d3 Author: Gabor Greif Date: Fri Dec 22 14:26:35 2017 +0100 WIP: status quo two responses not totally understood yet >--------------------------------------------------------------- 4c209ef3b3c236b554ebbfec4b5400f6795be7d3 testsuite/tests/simplStg/should_run/T13861.hs | 20 ++++++++++---------- testsuite/tests/simplStg/should_run/T13861.stdout | 3 +++ 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/testsuite/tests/simplStg/should_run/T13861.hs b/testsuite/tests/simplStg/should_run/T13861.hs index 4645348..2cb12cc 100644 --- a/testsuite/tests/simplStg/should_run/T13861.hs +++ b/testsuite/tests/simplStg/should_run/T13861.hs @@ -60,28 +60,28 @@ eq1 Refl = [] test x = do let (r1,r2) = bar x - (same $! r1) $! r2 + (same $! r1) $! r2 -- yes let r3 = foo r1 - (same $! r1) $! r3 + (same $! r1) $! r3 -- yes let (r30, r31) = (R 'l', foo' r30) - (same $! r30) $! r31 + (same $! r30) $! r31 -- no, strictness let (r40, r41) = (['l'], baz r40) - (same $! r40) $! r41 + (same $! r40) $! r41 -- no, arity mismatch let (r42, r43) = ([], baz r42) - (same $! r42) $! r43 + (same $! r42) $! r43 -- no, WHY? let (r44, r45) = ("ab", baz r44) - (same $! r44) $! r45 + (same $! r44) $! r45 -- no, arity mismatch let (r46, r47) = (Refl, eq1 r46) - (same $! r46) $! r47 + (same $! r46) $! r47 -- no, WHY? let (r4,_) = bar r1 let r5 = nested r4 - (same $! r4) $! r5 + (same $! r4) $! r5 -- yes let (T _ r6 r7) = rec1 x - (same $! r6) $! r7 + (same $! r6) $! r7 -- yes let s1@(S _ s2) = rec2 x - (same $! s1) $! s2 + (same $! s1) $! s2 -- no, not supported case r3 of Just b -> print ("YAY", b) Nothing -> print "BAD" diff --git a/testsuite/tests/simplStg/should_run/T13861.stdout b/testsuite/tests/simplStg/should_run/T13861.stdout index 3127164..50228bd 100644 --- a/testsuite/tests/simplStg/should_run/T13861.stdout +++ b/testsuite/tests/simplStg/should_run/T13861.stdout @@ -2,6 +2,9 @@ yes yes no no +no +no +no yes yes no From git at git.haskell.org Fri Dec 22 17:14:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 17:14:01 +0000 (UTC) Subject: [commit: ghc] master: relnotes: Fix typo in pattern synonym example (6549706) Message-ID: <20171222171401.DE5343A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6549706ffe47a18edb22e810d7e136a72891c161/ghc >--------------------------------------------------------------- commit 6549706ffe47a18edb22e810d7e136a72891c161 Author: Ben Gamari Date: Wed Dec 20 22:59:28 2017 -0500 relnotes: Fix typo in pattern synonym example >--------------------------------------------------------------- 6549706ffe47a18edb22e810d7e136a72891c161 docs/users_guide/8.4.1-notes.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst index 6ad4cc5..963e8d9 100644 --- a/docs/users_guide/8.4.1-notes.rst +++ b/docs/users_guide/8.4.1-notes.rst @@ -60,11 +60,11 @@ Language error, and explicitly bidirectional pattern synonyms should be used in their stead. That is, instead of using this (which is an error): :: - data StrictJust a = Just !a + pattern StrictJust a = Just !a Use this: :: - data StrictJust a <- Just !a where + pattern StrictJust a <- Just !a where StrictJust !a = Just a - GADTs with kind-polymorphic type arguments now require :ghc-flag:`-XTypeInType`. From git at git.haskell.org Fri Dec 22 17:14:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 17:14:05 +0000 (UTC) Subject: [commit: ghc] master: Bump Cabal submodule (e237e1f) Message-ID: <20171222171405.2F2453A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e237e1f132d0c0e1d9bf24d21cf688110305fb28/ghc >--------------------------------------------------------------- commit e237e1f132d0c0e1d9bf24d21cf688110305fb28 Author: Ben Gamari Date: Thu Dec 21 15:04:05 2017 -0500 Bump Cabal submodule >--------------------------------------------------------------- e237e1f132d0c0e1d9bf24d21cf688110305fb28 libraries/Cabal | 2 +- utils/ghc-cabal/Main.hs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 97c66f2..3f20e1f 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 97c66f2c7698f0aea4277acb66b918b7341b3d01 +Subproject commit 3f20e1faf9bc86ecb154ccf3e8b913bff14b9264 diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs index 440ab0b..f330ce0 100644 --- a/utils/ghc-cabal/Main.hs +++ b/utils/ghc-cabal/Main.hs @@ -95,11 +95,11 @@ runDefaultMain gpdFile <- defaultPackageDesc verbosity gpd <- readPackageDescription verbosity gpdFile case buildType (flattenPackageDescription gpd) of - Just Configure -> defaultMainWithHooks autoconfUserHooks + Configure -> defaultMainWithHooks autoconfUserHooks -- time has a "Custom" Setup.hs, but it's actually Configure -- plus a "./Setup test" hook. However, Cabal is also -- "Custom", but doesn't have a configure script. - Just Custom -> + Custom -> do configureExists <- doesFileExist "configure" if configureExists then defaultMainWithHooks autoconfUserHooks @@ -266,7 +266,7 @@ generate directory distdir config_args writePersistBuildConfig distdir lbi hooked_bi <- - if (buildType pd0 == Just Configure) || (buildType pd0 == Just Custom) + if (buildType pd0 == Configure) || (buildType pd0 == Custom) then do maybe_infoFile <- defaultHookedPackageDesc case maybe_infoFile of From git at git.haskell.org Fri Dec 22 17:14:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 17:14:08 +0000 (UTC) Subject: [commit: ghc] master: MkIface: Ensure syntactic compatibility with ghc 8.0.1 (c88564d) Message-ID: <20171222171408.553F43A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c88564dd7f41c66cee6420723131375f453631c1/ghc >--------------------------------------------------------------- commit c88564dd7f41c66cee6420723131375f453631c1 Author: Ben Gamari Date: Mon Dec 18 17:16:22 2017 -0500 MkIface: Ensure syntactic compatibility with ghc 8.0.1 Prior to 8.0.2 MultiWayIf syntax required that the -> token be indented relative to the guard. >--------------------------------------------------------------- c88564dd7f41c66cee6420723131375f453631c1 compiler/iface/MkIface.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 6d696d9..bb19a9e 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -1275,11 +1275,11 @@ checkOptimHash hsc_env iface = do new_hash <- liftIO $ fingerprintOptFlags (hsc_dflags hsc_env) putNameLiterally if | old_hash == new_hash - -> up_to_date (text "Optimisation flags unchanged") + -> up_to_date (text "Optimisation flags unchanged") | gopt Opt_IgnoreOptimChanges (hsc_dflags hsc_env) - -> up_to_date (text "Optimisation flags changed; ignoring") + -> up_to_date (text "Optimisation flags changed; ignoring") | otherwise - -> out_of_date_hash "Optimisation flags changed" + -> out_of_date_hash "Optimisation flags changed" (text " Optimisation flags have changed") old_hash new_hash @@ -1290,11 +1290,11 @@ checkHpcHash hsc_env iface = do new_hash <- liftIO $ fingerprintHpcFlags (hsc_dflags hsc_env) putNameLiterally if | old_hash == new_hash - -> up_to_date (text "HPC flags unchanged") + -> up_to_date (text "HPC flags unchanged") | gopt Opt_IgnoreHpcChanges (hsc_dflags hsc_env) - -> up_to_date (text "HPC flags changed; ignoring") + -> up_to_date (text "HPC flags changed; ignoring") | otherwise - -> out_of_date_hash "HPC flags changed" + -> out_of_date_hash "HPC flags changed" (text " HPC flags have changed") old_hash new_hash From git at git.haskell.org Fri Dec 22 17:44:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 17:44:52 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: relnotes: Remove note about -split-sections on Windows (93e6ddd) Message-ID: <20171222174452.B9C2C3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/93e6ddd774d069eb3b81cb3ba9a9efcc98794a92/ghc >--------------------------------------------------------------- commit 93e6ddd774d069eb3b81cb3ba9a9efcc98794a92 Author: Ben Gamari Date: Thu Dec 21 15:02:28 2017 -0500 relnotes: Remove note about -split-sections on Windows Split-sections unfortunately isn't yet working. >--------------------------------------------------------------- 93e6ddd774d069eb3b81cb3ba9a9efcc98794a92 docs/users_guide/8.4.1-notes.rst | 3 --- 1 file changed, 3 deletions(-) diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst index 25c49cd..efd3b98 100644 --- a/docs/users_guide/8.4.1-notes.rst +++ b/docs/users_guide/8.4.1-notes.rst @@ -254,9 +254,6 @@ Compiler performance for recursive types not shaped like cons-lists, and allows ``null`` to terminate for more (but not all) infinitely large structures. -- :ghc-flag:`-fsplit-sections` is now supported on x86_64 Windows and is on by default. - See :ghc-ticket:`12913`. - - Configure on Windows now supports the ``--enable-distro-toolchain`` ``configure`` flag, which can be used to build a GHC using compilers on your ``PATH`` instead of using the bundled bindist. See :ghc-ticket:`13792` From git at git.haskell.org Fri Dec 22 17:44:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 17:44:55 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: relnotes: Note GCC compatibility constraint (7fd99ed) Message-ID: <20171222174455.831973A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/7fd99ed1ab053f4fa08d9be1b54350d362206ec8/ghc >--------------------------------------------------------------- commit 7fd99ed1ab053f4fa08d9be1b54350d362206ec8 Author: Ben Gamari Date: Wed Dec 20 14:06:10 2017 -0500 relnotes: Note GCC compatibility constraint >--------------------------------------------------------------- 7fd99ed1ab053f4fa08d9be1b54350d362206ec8 docs/users_guide/8.4.1-notes.rst | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst index 6ad4cc5..25c49cd 100644 --- a/docs/users_guide/8.4.1-notes.rst +++ b/docs/users_guide/8.4.1-notes.rst @@ -7,6 +7,10 @@ The significant changes to the various parts of the compiler are listed in the following sections. There have also been numerous bug fixes and performance improvements over the 8.2.1 release. +.. note:: + + This compiling this release requires GCC 4.7 or newer due to + :ghc-ticket:`14244`. Highlights ---------- From git at git.haskell.org Fri Dec 22 17:44:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 17:44:58 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: Bump Cabal submodule (c6cf13c) Message-ID: <20171222174458.4DB6A3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/c6cf13ca63f3a11a8da7c7e3bd69e673a8df5440/ghc >--------------------------------------------------------------- commit c6cf13ca63f3a11a8da7c7e3bd69e673a8df5440 Author: Ben Gamari Date: Thu Dec 21 15:04:05 2017 -0500 Bump Cabal submodule (cherry picked from commit e237e1f132d0c0e1d9bf24d21cf688110305fb28) >--------------------------------------------------------------- c6cf13ca63f3a11a8da7c7e3bd69e673a8df5440 libraries/Cabal | 2 +- utils/ghc-cabal/Main.hs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 97c66f2..3f20e1f 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 97c66f2c7698f0aea4277acb66b918b7341b3d01 +Subproject commit 3f20e1faf9bc86ecb154ccf3e8b913bff14b9264 diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs index 440ab0b..f330ce0 100644 --- a/utils/ghc-cabal/Main.hs +++ b/utils/ghc-cabal/Main.hs @@ -95,11 +95,11 @@ runDefaultMain gpdFile <- defaultPackageDesc verbosity gpd <- readPackageDescription verbosity gpdFile case buildType (flattenPackageDescription gpd) of - Just Configure -> defaultMainWithHooks autoconfUserHooks + Configure -> defaultMainWithHooks autoconfUserHooks -- time has a "Custom" Setup.hs, but it's actually Configure -- plus a "./Setup test" hook. However, Cabal is also -- "Custom", but doesn't have a configure script. - Just Custom -> + Custom -> do configureExists <- doesFileExist "configure" if configureExists then defaultMainWithHooks autoconfUserHooks @@ -266,7 +266,7 @@ generate directory distdir config_args writePersistBuildConfig distdir lbi hooked_bi <- - if (buildType pd0 == Just Configure) || (buildType pd0 == Just Custom) + if (buildType pd0 == Configure) || (buildType pd0 == Custom) then do maybe_infoFile <- defaultHookedPackageDesc case maybe_infoFile of From git at git.haskell.org Fri Dec 22 17:45:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 17:45:01 +0000 (UTC) Subject: [commit: ghc] ghc-8.4: MkIface: Ensure syntactic compatibility with ghc 8.0.1 (f3f60b0) Message-ID: <20171222174501.1AB5B3A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.4 Link : http://ghc.haskell.org/trac/ghc/changeset/f3f60b04bc198891e342faa66255e7e31068ec57/ghc >--------------------------------------------------------------- commit f3f60b04bc198891e342faa66255e7e31068ec57 Author: Ben Gamari Date: Mon Dec 18 17:16:22 2017 -0500 MkIface: Ensure syntactic compatibility with ghc 8.0.1 Prior to 8.0.2 MultiWayIf syntax required that the -> token be indented relative to the guard. See #10807. >--------------------------------------------------------------- f3f60b04bc198891e342faa66255e7e31068ec57 compiler/iface/MkIface.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 6d696d9..bb19a9e 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -1275,11 +1275,11 @@ checkOptimHash hsc_env iface = do new_hash <- liftIO $ fingerprintOptFlags (hsc_dflags hsc_env) putNameLiterally if | old_hash == new_hash - -> up_to_date (text "Optimisation flags unchanged") + -> up_to_date (text "Optimisation flags unchanged") | gopt Opt_IgnoreOptimChanges (hsc_dflags hsc_env) - -> up_to_date (text "Optimisation flags changed; ignoring") + -> up_to_date (text "Optimisation flags changed; ignoring") | otherwise - -> out_of_date_hash "Optimisation flags changed" + -> out_of_date_hash "Optimisation flags changed" (text " Optimisation flags have changed") old_hash new_hash @@ -1290,11 +1290,11 @@ checkHpcHash hsc_env iface = do new_hash <- liftIO $ fingerprintHpcFlags (hsc_dflags hsc_env) putNameLiterally if | old_hash == new_hash - -> up_to_date (text "HPC flags unchanged") + -> up_to_date (text "HPC flags unchanged") | gopt Opt_IgnoreHpcChanges (hsc_dflags hsc_env) - -> up_to_date (text "HPC flags changed; ignoring") + -> up_to_date (text "HPC flags changed; ignoring") | otherwise - -> out_of_date_hash "HPC flags changed" + -> out_of_date_hash "HPC flags changed" (text " HPC flags have changed") old_hash new_hash From git at git.haskell.org Fri Dec 22 21:16:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Dec 2017 21:16:38 +0000 (UTC) Subject: [commit: ghc] wip/T13861: don't inline 'same', this way one of the mysteries is resolved (f949c69) Message-ID: <20171222211638.9E9B63A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/f949c690c456cc51078e39619554be645384b83c/ghc >--------------------------------------------------------------- commit f949c690c456cc51078e39619554be645384b83c Author: Gabor Greif Date: Fri Dec 22 22:16:11 2017 +0100 don't inline 'same', this way one of the mysteries is resolved >--------------------------------------------------------------- f949c690c456cc51078e39619554be645384b83c testsuite/tests/simplStg/should_run/T13861.hs | 1 + testsuite/tests/simplStg/should_run/T13861.stdout | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/simplStg/should_run/T13861.hs b/testsuite/tests/simplStg/should_run/T13861.hs index 2cb12cc..4130a51 100644 --- a/testsuite/tests/simplStg/should_run/T13861.hs +++ b/testsuite/tests/simplStg/should_run/T13861.hs @@ -93,3 +93,4 @@ same :: a -> b -> IO () same x y = case reallyUnsafePtrEquality# (unsafeCoerce x) y of 1# -> putStrLn "yes" _ -> putStrLn "no" +{-# NOINLINE same #-} diff --git a/testsuite/tests/simplStg/should_run/T13861.stdout b/testsuite/tests/simplStg/should_run/T13861.stdout index 50228bd..40aa293 100644 --- a/testsuite/tests/simplStg/should_run/T13861.stdout +++ b/testsuite/tests/simplStg/should_run/T13861.stdout @@ -2,7 +2,7 @@ yes yes no no -no +yes no no yes From git at git.haskell.org Sat Dec 23 09:10:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 23 Dec 2017 09:10:13 +0000 (UTC) Subject: [commit: ghc] master: Add GHC 8.6.1 release notes (d7d0aa3) Message-ID: <20171223091013.6C4B63A5EE@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d7d0aa316f9d23d73ae617e0cc1b147907667ef4/ghc >--------------------------------------------------------------- commit d7d0aa316f9d23d73ae617e0cc1b147907667ef4 Author: Tamar Christina Date: Sat Dec 23 09:06:30 2017 +0000 Add GHC 8.6.1 release notes >--------------------------------------------------------------- d7d0aa316f9d23d73ae617e0cc1b147907667ef4 docs/users_guide/8.6.1-notes.rst | 85 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 85 insertions(+) diff --git a/docs/users_guide/8.6.1-notes.rst b/docs/users_guide/8.6.1-notes.rst new file mode 100644 index 0000000..ad5c5af --- /dev/null +++ b/docs/users_guide/8.6.1-notes.rst @@ -0,0 +1,85 @@ +.. _release-8-6-1: + +Release notes for version 8.6.1 +=============================== + +The significant changes to the various parts of the compiler are listed in the +following sections. There have also been numerous bug fixes and performance +improvements over the 8.4.1 release. + + +Highlights +---------- + +The highlights, since the 8.4.1 release, are: + +- Many, many bug fixes. + + +Full details +------------ + +Language +~~~~~~~~ + + +Compiler +~~~~~~~~ + + +Runtime system +~~~~~~~~~~~~~~ + + +Template Haskell +~~~~~~~~~~~~~~~~ + + +``ghc`` library +~~~~~~~~~~~~~~~ + + +``base`` library +~~~~~~~~~~~~~~~~ + + +Build system +~~~~~~~~~~~~ + + +Included libraries +------------------ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Deppendency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + compiler/ghc.cabal: The compiler itself + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable From git at git.haskell.org Mon Dec 25 15:49:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Dec 2017 15:49:47 +0000 (UTC) Subject: [commit: ghc] master: aclocal.m4: add minimal support for nios2 architecture (02aaeab) Message-ID: <20171225154947.126DE3A5EF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/02aaeabd585124f1394a3ad251b39b4ff368339b/ghc >--------------------------------------------------------------- commit 02aaeabd585124f1394a3ad251b39b4ff368339b Author: Sergei Trofimovich Date: Mon Dec 25 15:46:06 2017 +0000 aclocal.m4: add minimal support for nios2 architecture With this change unregisterised port can already produce minimal executables: ELF 32-bit LSB executable, Altera Nios II, version 1 (SYSV), dynamically linked, interpreter /lib/ld-linux-nios2.so.1 Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 02aaeabd585124f1394a3ad251b39b4ff368339b aclocal.m4 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/aclocal.m4 b/aclocal.m4 index 5dc618d..5989a13 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -217,7 +217,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS], mipsel) test -z "[$]2" || eval "[$]2=ArchMipsel" ;; - hppa|hppa1_1|ia64|m68k|rs6000|s390|s390x|sh4|vax) + hppa|hppa1_1|ia64|m68k|nios2|rs6000|s390|s390x|sh4|vax) test -z "[$]2" || eval "[$]2=ArchUnknown" ;; *) @@ -1848,6 +1848,9 @@ case "$1" in mips*) $2="mips" ;; + nios2) + $2="nios2" + ;; powerpc64le*) $2="powerpc64le" ;; From git at git.haskell.org Tue Dec 26 12:29:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 Dec 2017 12:29:46 +0000 (UTC) Subject: [commit: ghc] master: Compute InScopeSet in substInteractiveContext (e19b646) Message-ID: <20171226122946.9E0923A5EF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e19b6464cc8ea498775074a680f91d3e5b5636d3/ghc >--------------------------------------------------------------- commit e19b6464cc8ea498775074a680f91d3e5b5636d3 Author: Bartosz Nitka Date: Tue Dec 26 12:28:39 2017 +0000 Compute InScopeSet in substInteractiveContext It doesn't look like we keep any sets of free variables of the types of Ids handy, so we just have to build them when doing a substitution. Test Plan: buildbot + run testsuite with debug Reviewers: simonmar, simonpj, austin, bgamari Reviewed By: simonpj Subscribers: carter, rwbarton, thomie GHC Trac Issues: #11371 Differential Revision: https://phabricator.haskell.org/D3431 >--------------------------------------------------------------- e19b6464cc8ea498775074a680f91d3e5b5636d3 compiler/main/HscTypes.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 16c8002..165f860 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -1711,8 +1711,13 @@ substInteractiveContext ictxt at InteractiveContext{ ic_tythings = tts } subst | isEmptyTCvSubst subst = ictxt | otherwise = ictxt { ic_tythings = map subst_ty tts } where - subst_ty (AnId id) = AnId $ id `setIdType` substTyUnchecked subst (idType id) - subst_ty tt = tt + subst_ty (AnId id) + = AnId $ id `setIdType` substTyAddInScope subst (idType id) + -- Variables in the interactive context *can* mention free type variables + -- because of the runtime debugger. Otherwise you'd expect all + -- variables bound in the interactive context to be closed. + subst_ty tt + = tt instance Outputable InteractiveImport where ppr (IIModule m) = char '*' <> ppr m From git at git.haskell.org Tue Dec 26 21:11:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 Dec 2017 21:11:39 +0000 (UTC) Subject: [commit: ghc] master: Fix #14618 by applying a subst in deeplyInstantiate (722a658) Message-ID: <20171226211139.1A2703A5F3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/722a6584bb338bc77ad978d14113b3b8e6a45cab/ghc >--------------------------------------------------------------- commit 722a6584bb338bc77ad978d14113b3b8e6a45cab Author: Richard Eisenberg Date: Tue Dec 26 14:23:40 2017 -0500 Fix #14618 by applying a subst in deeplyInstantiate Previously, we were inexplicably not applying an instantiating substitution to arguments in non-prenex types. It's amazing this has been around for so long! I guess there aren't a lot of non-prenex types around. test case: typecheck/should_fail/T14618 >--------------------------------------------------------------- 722a6584bb338bc77ad978d14113b3b8e6a45cab compiler/typecheck/Inst.hs | 7 ++++--- testsuite/tests/typecheck/should_fail/T14618.hs | 11 +++++++++++ .../tests/typecheck/should_fail/T14618.stderr | 23 ++++++++++++++++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 4 files changed, 39 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index 6d656fe..9da96c4 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -257,8 +257,9 @@ deeply_instantiate :: CtOrigin deeply_instantiate orig subst ty | Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe ty = do { (subst', tvs') <- newMetaTyVarsX subst tvs - ; ids1 <- newSysLocalIds (fsLit "di") (substTys subst' arg_tys) - ; let theta' = substTheta subst' theta + ; let arg_tys' = substTys subst' arg_tys + theta' = substTheta subst' theta + ; ids1 <- newSysLocalIds (fsLit "di") arg_tys' ; wrap1 <- instCall orig (mkTyVarTys tvs') theta' ; traceTc "Instantiating (deeply)" (vcat [ text "origin" <+> pprCtOrigin orig , text "type" <+> ppr ty @@ -271,7 +272,7 @@ deeply_instantiate orig subst ty <.> wrap2 <.> wrap1 <.> mkWpEvVarApps ids1, - mkFunTys arg_tys rho2) } + mkFunTys arg_tys' rho2) } | otherwise = do { let ty' = substTy subst ty diff --git a/testsuite/tests/typecheck/should_fail/T14618.hs b/testsuite/tests/typecheck/should_fail/T14618.hs new file mode 100644 index 0000000..da30d7a --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14618.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE RankNTypes #-} + +module T14618 where + +safeCoerce :: a -> b +safeCoerce = f' + where + f :: d -> forall c. d + f x = x + + f' = f diff --git a/testsuite/tests/typecheck/should_fail/T14618.stderr b/testsuite/tests/typecheck/should_fail/T14618.stderr new file mode 100644 index 0000000..8faa64c --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14618.stderr @@ -0,0 +1,23 @@ + +T14618.hs:6:14: error: + • Couldn't match type ‘a’ with ‘b’ + ‘a’ is a rigid type variable bound by + the type signature for: + safeCoerce :: forall a b. a -> b + at T14618.hs:5:1-20 + ‘b’ is a rigid type variable bound by + the type signature for: + safeCoerce :: forall a b. a -> b + at T14618.hs:5:1-20 + Expected type: a -> b + Actual type: b -> b + • In the expression: f' + In an equation for ‘safeCoerce’: + safeCoerce + = f' + where + f :: d -> forall c. d + f x = x + f' = f + • Relevant bindings include + safeCoerce :: a -> b (bound at T14618.hs:6:1) diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 553e10a..b1a0e75 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -462,3 +462,4 @@ test('T14325', normal, compile_fail, ['']) test('T14350', normal, compile_fail, ['']) test('T14390', normal, compile_fail, ['']) test('MissingExportList03', normal, compile_fail, ['']) +test('T14618', normal, compile_fail, ['']) From git at git.haskell.org Wed Dec 27 18:48:29 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Dec 2017 18:48:29 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: don't reenter WHNF thing for re-tagging (1a721b6) Message-ID: <20171227184829.D87AE3A5F3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/1a721b64ca5cac62d754e81f691954638c80f4cb/ghc >--------------------------------------------------------------- commit 1a721b64ca5cac62d754e81f691954638c80f4cb Author: Gabor Greif Date: Wed Dec 27 19:47:50 2017 +0100 WIP: don't reenter WHNF thing for re-tagging this is a very crude test. How to make it more robust? >--------------------------------------------------------------- 1a721b64ca5cac62d754e81f691954638c80f4cb compiler/codeGen/StgCmmClosure.hs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index ce0f623..034a641 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP, RecordWildCards #-} - +{-# LANGUAGE CPP, RecordWildCards, StandaloneDeriving #-} +{-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- -- Stg to C-- code generation: @@ -223,8 +223,13 @@ data LambdaFormInfo -- always a value, needs evaluation | LFLetNoEscape -- See LetNoEscape module for precise description + deriving Show - +deriving instance Show TopLevelFlag +deriving instance Show OneShotInfo +deriving instance Show ArgDescr +deriving instance Show StandardFormInfo +instance Show DataCon where show _ = "" ------------------------- -- StandardFormInfo tells whether this thunk has one of -- a small number of standard forms @@ -586,6 +591,10 @@ getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt +getCallMethod _ name id (LFUnknown False) 0 _v_args cg_loc _self_loop_info + | occNameString (nameOccName name) == "wild" + = pprTrace "getCallMethod" (ppr id <+> ppr cg_loc) ReturnIt + getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt -- n_args=0 because it'd be ill-typed to apply a saturated From git at git.haskell.org Wed Dec 27 19:57:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Dec 2017 19:57:10 +0000 (UTC) Subject: [commit: ghc] wip/T13861: this is not needed any more (5be324d) Message-ID: <20171227195710.B9D583A5F3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/5be324d36e30924d73bcc68ad078aca3b193ea2b/ghc >--------------------------------------------------------------- commit 5be324d36e30924d73bcc68ad078aca3b193ea2b Author: Gabor Greif Date: Wed Dec 27 20:56:51 2017 +0100 this is not needed any more should fix Travis >--------------------------------------------------------------- 5be324d36e30924d73bcc68ad078aca3b193ea2b compiler/simplStg/StgCse.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 3712956..82a36d5 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -337,7 +337,6 @@ stgCseExpr env (StgConApp dataCon args tys) = StgConApp dataCon args' tys where args' = substArgs env args dc = Lax dataCon - u = getUnique (getName dc) -- Let bindings -- The binding might be removed due to CSE (we do not want trivial bindings on From git at git.haskell.org Wed Dec 27 20:15:37 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Dec 2017 20:15:37 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: add another test [ci skip] (c2c396c) Message-ID: <20171227201537.6BA893A5F3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/c2c396c36a5b6332efb67f7621fa0cb53974e0c9/ghc >--------------------------------------------------------------- commit c2c396c36a5b6332efb67f7621fa0cb53974e0c9 Author: Gabor Greif Date: Wed Dec 27 21:15:17 2017 +0100 WIP: add another test [ci skip] >--------------------------------------------------------------- c2c396c36a5b6332efb67f7621fa0cb53974e0c9 testsuite/tests/simplStg/should_run/T13861.hs | 9 +++++++-- testsuite/tests/simplStg/should_run/T13861.stdout | 1 + 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/simplStg/should_run/T13861.hs b/testsuite/tests/simplStg/should_run/T13861.hs index 4130a51..fed0e7a 100644 --- a/testsuite/tests/simplStg/should_run/T13861.hs +++ b/testsuite/tests/simplStg/should_run/T13861.hs @@ -56,6 +56,9 @@ eq1 :: a :~: b -> [a] eq1 Refl = [] {-# NOINLINE eq1 #-} +eq2 :: a :~: b -> b :~: a +eq2 Refl = Refl +{-# NOINLINE eq2 #-} test x = do @@ -69,11 +72,13 @@ test x = do let (r40, r41) = (['l'], baz r40) (same $! r40) $! r41 -- no, arity mismatch let (r42, r43) = ([], baz r42) - (same $! r42) $! r43 -- no, WHY? + (same $! r42) $! r43 -- yes let (r44, r45) = ("ab", baz r44) (same $! r44) $! r45 -- no, arity mismatch let (r46, r47) = (Refl, eq1 r46) - (same $! r46) $! r47 -- no, WHY? + (same $! r46) $! r47 -- no, GADT + let (r48, r49) = (Refl, eq2 r48) + (same $! r48) $! r49 -- no, GADT let (r4,_) = bar r1 let r5 = nested r4 diff --git a/testsuite/tests/simplStg/should_run/T13861.stdout b/testsuite/tests/simplStg/should_run/T13861.stdout index 40aa293..d1124c6 100644 --- a/testsuite/tests/simplStg/should_run/T13861.stdout +++ b/testsuite/tests/simplStg/should_run/T13861.stdout @@ -5,6 +5,7 @@ no yes no no +no yes yes no From git at git.haskell.org Wed Dec 27 22:31:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Dec 2017 22:31:41 +0000 (UTC) Subject: [commit: ghc] wip/T13861: Typos in comments [ci skip] (3b2fc5e) Message-ID: <20171227223141.D53C13A5F3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/3b2fc5e64eccf82d43d38f35045eac3f8f11d942/ghc >--------------------------------------------------------------- commit 3b2fc5e64eccf82d43d38f35045eac3f8f11d942 Author: Gabor Greif Date: Wed Dec 27 23:31:21 2017 +0100 Typos in comments [ci skip] >--------------------------------------------------------------- 3b2fc5e64eccf82d43d38f35045eac3f8f11d942 compiler/coreSyn/MkCore.hs | 2 +- compiler/prelude/primops.txt.pp | 2 +- compiler/typecheck/TcTyClsDecls.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index c8f7366..72b6abf 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -180,7 +180,7 @@ mk_val_app fun arg arg_ty res_ty -- -- This is Dangerous. But this is the only place we play this -- game, mk_val_app returns an expression that does not have - -- have a free wild-id. So the only thing that can go wrong + -- a free wild-id. So the only thing that can go wrong -- is if you take apart this case expression, and pass a -- fragment of it as the fun part of a 'mk_val_app'. diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index d6c06b1..1f4b574 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2728,7 +2728,7 @@ binder-swap on the case, to give \z. case x of y -> let v = dataToTag# x in ... Now FloatOut might float that v-binding outside the \z. But that is -bad because that might mean x gest evaluated much too early! (CorePrep +bad because that might mean x gets evaluated much too early! (CorePrep adds an eval to a dataToTag# call, to ensure that the argument really is evaluated; see CorePrep Note [dataToTag magic].) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 113fb9d..bef1c06 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -2871,7 +2871,7 @@ checkFamFlag tc_name Haskell 2010 is supposed to reject class C a where op :: Eq a => a -> a -where the method type costrains only the class variable(s). (The extension +where the method type constrains only the class variable(s). (The extension -XConstrainedClassMethods switches off this check.) But regardless we should not reject class C a where From git at git.haskell.org Thu Dec 28 09:25:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Dec 2017 09:25:02 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments [ci skip] (f2db228) Message-ID: <20171228092502.21C663A5F4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f2db228bd1fc8295581080ac25d378be72e7b600/ghc >--------------------------------------------------------------- commit f2db228bd1fc8295581080ac25d378be72e7b600 Author: Gabor Greif Date: Wed Dec 27 23:31:21 2017 +0100 Typos in comments [ci skip] >--------------------------------------------------------------- f2db228bd1fc8295581080ac25d378be72e7b600 compiler/coreSyn/MkCore.hs | 2 +- compiler/prelude/primops.txt.pp | 2 +- compiler/typecheck/TcTyClsDecls.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index c8f7366..72b6abf 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -180,7 +180,7 @@ mk_val_app fun arg arg_ty res_ty -- -- This is Dangerous. But this is the only place we play this -- game, mk_val_app returns an expression that does not have - -- have a free wild-id. So the only thing that can go wrong + -- a free wild-id. So the only thing that can go wrong -- is if you take apart this case expression, and pass a -- fragment of it as the fun part of a 'mk_val_app'. diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 414a136..333694d 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2728,7 +2728,7 @@ binder-swap on the case, to give \z. case x of y -> let v = dataToTag# x in ... Now FloatOut might float that v-binding outside the \z. But that is -bad because that might mean x gest evaluated much too early! (CorePrep +bad because that might mean x gets evaluated much too early! (CorePrep adds an eval to a dataToTag# call, to ensure that the argument really is evaluated; see CorePrep Note [dataToTag magic].) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 24faaa0..4625fb2 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -2883,7 +2883,7 @@ checkFamFlag tc_name Haskell 2010 is supposed to reject class C a where op :: Eq a => a -> a -where the method type costrains only the class variable(s). (The extension +where the method type constrains only the class variable(s). (The extension -XConstrainedClassMethods switches off this check.) But regardless we should not reject class C a where From git at git.haskell.org Thu Dec 28 09:59:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Dec 2017 09:59:57 +0000 (UTC) Subject: [commit: ghc] branch 'wip/Txxxxx' created Message-ID: <20171228095957.5A5803A5F4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/Txxxxx Referencing: 51a1bf064328fc625fdef59262784ab04eb2fec1 From git at git.haskell.org Thu Dec 28 10:00:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Dec 2017 10:00:00 +0000 (UTC) Subject: [commit: ghc] wip/Txxxxx: WIP: don't reenter WHNF thing for re-tagging (8789365) Message-ID: <20171228100000.227B13A5F4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/Txxxxx Link : http://ghc.haskell.org/trac/ghc/changeset/878936583905e3f1506fa65dbd86549f82ef4aa3/ghc >--------------------------------------------------------------- commit 878936583905e3f1506fa65dbd86549f82ef4aa3 Author: Gabor Greif Date: Wed Dec 27 19:47:50 2017 +0100 WIP: don't reenter WHNF thing for re-tagging this is a very crude test. How to make it more robust? >--------------------------------------------------------------- 878936583905e3f1506fa65dbd86549f82ef4aa3 compiler/codeGen/StgCmmClosure.hs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 2501ec9..feb9987 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP, RecordWildCards #-} - +{-# LANGUAGE CPP, RecordWildCards, StandaloneDeriving #-} +{-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- -- Stg to C-- code generation: @@ -223,8 +223,13 @@ data LambdaFormInfo -- always a value, needs evaluation | LFLetNoEscape -- See LetNoEscape module for precise description + deriving Show - +deriving instance Show TopLevelFlag +deriving instance Show OneShotInfo +deriving instance Show ArgDescr +deriving instance Show StandardFormInfo +instance Show DataCon where show _ = "" ------------------------- -- StandardFormInfo tells whether this thunk has one of -- a small number of standard forms @@ -581,6 +586,10 @@ getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt +getCallMethod _ name id (LFUnknown False) 0 _v_args cg_loc _self_loop_info + | occNameString (nameOccName name) == "wild" + = pprTrace "getCallMethod" (ppr id <+> ppr cg_loc) ReturnIt + getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt -- n_args=0 because it'd be ill-typed to apply a saturated From git at git.haskell.org Thu Dec 28 10:00:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Dec 2017 10:00:02 +0000 (UTC) Subject: [commit: ghc] wip/Txxxxx: WIP: cleanups (51a1bf0) Message-ID: <20171228100002.E6AB03A5F4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/Txxxxx Link : http://ghc.haskell.org/trac/ghc/changeset/51a1bf064328fc625fdef59262784ab04eb2fec1/ghc >--------------------------------------------------------------- commit 51a1bf064328fc625fdef59262784ab04eb2fec1 Author: Gabor Greif Date: Thu Dec 28 10:58:55 2017 +0100 WIP: cleanups and add TODO (also this should be more performant, by consing less) >--------------------------------------------------------------- 51a1bf064328fc625fdef59262784ab04eb2fec1 compiler/codeGen/StgCmmClosure.hs | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index feb9987..39d156f 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP, RecordWildCards, StandaloneDeriving #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE CPP, RecordWildCards #-} + ----------------------------------------------------------------------------- -- -- Stg to C-- code generation: @@ -223,13 +223,8 @@ data LambdaFormInfo -- always a value, needs evaluation | LFLetNoEscape -- See LetNoEscape module for precise description - deriving Show -deriving instance Show TopLevelFlag -deriving instance Show OneShotInfo -deriving instance Show ArgDescr -deriving instance Show StandardFormInfo -instance Show DataCon where show _ = "" + ------------------------- -- StandardFormInfo tells whether this thunk has one of -- a small number of standard forms @@ -586,9 +581,9 @@ getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt -getCallMethod _ name id (LFUnknown False) 0 _v_args cg_loc _self_loop_info - | occNameString (nameOccName name) == "wild" - = pprTrace "getCallMethod" (ppr id <+> ppr cg_loc) ReturnIt +getCallMethod _ name _ (LFUnknown False) 0 _v_args cg_loc _self_loop_info + | occNameString (nameOccName name) == "wild" -- TODO: make this robust + = ReturnIt -- seems to come from case, must be (tagged) WHNF already getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt From git at git.haskell.org Thu Dec 28 11:00:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Dec 2017 11:00:41 +0000 (UTC) Subject: [commit: ghc] wip/Txxxxx: WIP: ooops (afca6e4) Message-ID: <20171228110041.F10733A5F4@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/Txxxxx Link : http://ghc.haskell.org/trac/ghc/changeset/afca6e491dc36a39734d6d3fd85465acf648530b/ghc >--------------------------------------------------------------- commit afca6e491dc36a39734d6d3fd85465acf648530b Author: Gabor Greif Date: Thu Dec 28 12:00:23 2017 +0100 WIP: ooops >--------------------------------------------------------------- afca6e491dc36a39734d6d3fd85465acf648530b compiler/codeGen/StgCmmClosure.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 39d156f..bc9bb65 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -581,7 +581,7 @@ getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt -getCallMethod _ name _ (LFUnknown False) 0 _v_args cg_loc _self_loop_info +getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | occNameString (nameOccName name) == "wild" -- TODO: make this robust = ReturnIt -- seems to come from case, must be (tagged) WHNF already From git at git.haskell.org Thu Dec 28 15:17:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Dec 2017 15:17:35 +0000 (UTC) Subject: [commit: nofib] master: add missing import (07a9396) Message-ID: <20171228151735.C80D03A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/07a93962fa89ec58059c07d4f430645a486423c6/nofib >--------------------------------------------------------------- commit 07a93962fa89ec58059c07d4f430645a486423c6 Author: Gabor Greif Date: Thu Dec 28 16:11:40 2017 +0100 add missing import >--------------------------------------------------------------- 07a93962fa89ec58059c07d4f430645a486423c6 gc/cacheprof/Main.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/gc/cacheprof/Main.hs b/gc/cacheprof/Main.hs index ab9998c..7964034 100644 --- a/gc/cacheprof/Main.hs +++ b/gc/cacheprof/Main.hs @@ -34,6 +34,7 @@ import Data.Char import Data.List import System.IO import System.Environment +import System.Exit import Arch_x86 import Generics From git at git.haskell.org Fri Dec 29 12:28:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Dec 2017 12:28:00 +0000 (UTC) Subject: [commit: ghc] wip/T13861: check that 'quux' is the identity (86511f3) Message-ID: <20171229122800.EBC5B3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/86511f33de49acabb2ffc2e08932db9f74d35312/ghc >--------------------------------------------------------------- commit 86511f33de49acabb2ffc2e08932db9f74d35312 Author: Gabor Greif Date: Fri Dec 29 07:52:57 2017 +0100 check that 'quux' is the identity >--------------------------------------------------------------- 86511f33de49acabb2ffc2e08932db9f74d35312 testsuite/tests/simplStg/should_run/T13861.hs | 10 ++++++++++ testsuite/tests/simplStg/should_run/T13861.stdout | 1 + 2 files changed, 11 insertions(+) diff --git a/testsuite/tests/simplStg/should_run/T13861.hs b/testsuite/tests/simplStg/should_run/T13861.hs index fed0e7a..d09b973 100644 --- a/testsuite/tests/simplStg/should_run/T13861.hs +++ b/testsuite/tests/simplStg/should_run/T13861.hs @@ -26,6 +26,14 @@ baz _ = Nothing {-# NOINLINE baz #-} +data Boo = Tru | Fal + +quux True = Fal +quux False = Tru +{-# NOINLINE quux #-} + + + nested :: Either Int (Either Int a) -> Either Bool (Maybe a) nested (Right (Right x)) = Right (Just x) nested _ = Left True @@ -79,6 +87,8 @@ test x = do (same $! r46) $! r47 -- no, GADT let (r48, r49) = (Refl, eq2 r48) (same $! r48) $! r49 -- no, GADT + let (r50, r51) = (True, quux r50) + (same $! r50) $! r51 -- yes, quux is identity let (r4,_) = bar r1 let r5 = nested r4 diff --git a/testsuite/tests/simplStg/should_run/T13861.stdout b/testsuite/tests/simplStg/should_run/T13861.stdout index d1124c6..0a6ddab 100644 --- a/testsuite/tests/simplStg/should_run/T13861.stdout +++ b/testsuite/tests/simplStg/should_run/T13861.stdout @@ -8,5 +8,6 @@ no no yes yes +yes no ("YAY","foo") From git at git.haskell.org Fri Dec 29 12:28:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Dec 2017 12:28:03 +0000 (UTC) Subject: [commit: ghc] wip/T13861: make 'quux'' test 3 to 2 (46fcad9) Message-ID: <20171229122803.B86913A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/46fcad9c42535417769db4a410dbb3f5d7505c01/ghc >--------------------------------------------------------------- commit 46fcad9c42535417769db4a410dbb3f5d7505c01 Author: Gabor Greif Date: Fri Dec 29 08:30:59 2017 +0100 make 'quux'' test 3 to 2 >--------------------------------------------------------------- 46fcad9c42535417769db4a410dbb3f5d7505c01 testsuite/tests/simplStg/should_run/T13861.hs | 11 +++++++++-- testsuite/tests/simplStg/should_run/T13861.stdout | 2 ++ 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/simplStg/should_run/T13861.hs b/testsuite/tests/simplStg/should_run/T13861.hs index d09b973..9345a4a 100644 --- a/testsuite/tests/simplStg/should_run/T13861.hs +++ b/testsuite/tests/simplStg/should_run/T13861.hs @@ -26,12 +26,15 @@ baz _ = Nothing {-# NOINLINE baz #-} -data Boo = Tru | Fal +data Boo = Tru | Fal | Dunno quux True = Fal quux False = Tru {-# NOINLINE quux #-} +quux' Fal = True +quux' _ = False +{-# NOINLINE quux' #-} nested :: Either Int (Either Int a) -> Either Bool (Maybe a) @@ -88,7 +91,11 @@ test x = do let (r48, r49) = (Refl, eq2 r48) (same $! r48) $! r49 -- no, GADT let (r50, r51) = (True, quux r50) - (same $! r50) $! r51 -- yes, quux is identity + (same $! r50) $! r51 -- yes, quux is STG identity + let (r52, r53) = (Tru, quux' r52) + (same $! r52) $! r53 -- no, quux' is not STG identity on 'Tru' + let (r54, r55) = (Fal, quux' r54) + (same $! r54) $! r55 -- yes, quux' is STG identity on 'Fal' let (r4,_) = bar r1 let r5 = nested r4 diff --git a/testsuite/tests/simplStg/should_run/T13861.stdout b/testsuite/tests/simplStg/should_run/T13861.stdout index 0a6ddab..2e3ae8c 100644 --- a/testsuite/tests/simplStg/should_run/T13861.stdout +++ b/testsuite/tests/simplStg/should_run/T13861.stdout @@ -7,6 +7,8 @@ no no no yes +no +yes yes yes no From git at git.haskell.org Fri Dec 29 12:28:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Dec 2017 12:28:09 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: detect lumping opportunities (5478046) Message-ID: <20171229122809.4CFA03A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/547804604206554cf6b0e532f5d9e0659149021c/ghc >--------------------------------------------------------------- commit 547804604206554cf6b0e532f5d9e0659149021c Author: Gabor Greif Date: Fri Dec 29 11:26:31 2017 +0100 WIP: detect lumping opportunities >--------------------------------------------------------------- 547804604206554cf6b0e532f5d9e0659149021c compiler/simplStg/StgCse.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 82a36d5..0fab9f2 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -410,13 +410,16 @@ stgCseRhs env bndr (StgRhsClosure ccs info occs upd args body) mkStgCase :: StgExpr -> OutId -> AltType -> [StgAlt] -> StgExpr mkStgCase scrut bndr ty alts | all isBndr alts = scrut + | Just alts' <- grouped alts = StgCase scrut bndr ty alts' | otherwise = StgCase scrut bndr ty alts where -- see Note [All alternatives are the binder] isBndr (_, _, StgApp f []) = f == bndr isBndr _ = False - + -- see Note [Lumping alternatives together] + grouped alts | any isBndr alts = pprTrace "mkStgCase" (ppr alts) Nothing + grouped _ = Nothing -- Utilities From git at git.haskell.org Fri Dec 29 12:28:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Dec 2017 12:28:06 +0000 (UTC) Subject: [commit: ghc] wip/T13861: test whether two STG equiv alts get joined (167f1b6) Message-ID: <20171229122806.7EE663A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/167f1b6badae1a6a8bc17d5202c3388657345b0a/ghc >--------------------------------------------------------------- commit 167f1b6badae1a6a8bc17d5202c3388657345b0a Author: Gabor Greif Date: Fri Dec 29 09:37:03 2017 +0100 test whether two STG equiv alts get joined >--------------------------------------------------------------- 167f1b6badae1a6a8bc17d5202c3388657345b0a testsuite/tests/simplStg/should_run/T13861.hs | 8 ++++++++ testsuite/tests/simplStg/should_run/T13861.stdout | 1 + 2 files changed, 9 insertions(+) diff --git a/testsuite/tests/simplStg/should_run/T13861.hs b/testsuite/tests/simplStg/should_run/T13861.hs index 9345a4a..6442dce 100644 --- a/testsuite/tests/simplStg/should_run/T13861.hs +++ b/testsuite/tests/simplStg/should_run/T13861.hs @@ -36,6 +36,12 @@ quux' Fal = True quux' _ = False {-# NOINLINE quux' #-} +-- the 'Fal' and default case should be lumped together +lump Fal = True +lump Dunno = unsafeCoerce Tru +lump _ = False +{-# NOINLINE lump #-} + nested :: Either Int (Either Int a) -> Either Bool (Maybe a) nested (Right (Right x)) = Right (Just x) @@ -96,6 +102,8 @@ test x = do (same $! r52) $! r53 -- no, quux' is not STG identity on 'Tru' let (r54, r55) = (Fal, quux' r54) (same $! r54) $! r55 -- yes, quux' is STG identity on 'Fal' + let (r56, r57) = (Tru, lump r56) + (same $! r56) $! r57 -- yes, lump is STG identity on 'Tru' let (r4,_) = bar r1 let r5 = nested r4 diff --git a/testsuite/tests/simplStg/should_run/T13861.stdout b/testsuite/tests/simplStg/should_run/T13861.stdout index 2e3ae8c..7fd4e43 100644 --- a/testsuite/tests/simplStg/should_run/T13861.stdout +++ b/testsuite/tests/simplStg/should_run/T13861.stdout @@ -11,5 +11,6 @@ no yes yes yes +yes no ("YAY","foo") From git at git.haskell.org Fri Dec 29 12:28:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Dec 2017 12:28:12 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: create DEFAULT when more than two alts give binder (f6216f9) Message-ID: <20171229122812.12CFB3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/f6216f98555ef3e1ed2e5f05068da3399be9579f/ghc >--------------------------------------------------------------- commit f6216f98555ef3e1ed2e5f05068da3399be9579f Author: Gabor Greif Date: Fri Dec 29 11:46:20 2017 +0100 WIP: create DEFAULT when more than two alts give binder >--------------------------------------------------------------- f6216f98555ef3e1ed2e5f05068da3399be9579f compiler/simplStg/StgCse.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 0fab9f2..7ca74ec 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -95,6 +95,8 @@ import Name (NamedThing (..), mkFCallName) import Unique (mkUniqueGrimily, getKey, getUnique) import TyCon (tyConFamilySize) +import Data.List (partition) + -------------- -- The Trie -- -------------- @@ -418,7 +420,8 @@ mkStgCase scrut bndr ty alts | all isBndr alts = scrut isBndr (_, _, StgApp f []) = f == bndr isBndr _ = False -- see Note [Lumping alternatives together] - grouped alts | any isBndr alts = pprTrace "mkStgCase" (ppr alts) Nothing + grouped ((DEFAULT, _, _) : alts) | any isBndr alts = pprTrace "mkStgCaseDEFAULT" (ppr alts) Nothing + grouped alts | (bs@(_:_:_),rest) <- partition isBndr alts = pprTrace "mkStgCase" (ppr bs) $ Just ((DEFAULT, []{-FIXME-}, StgApp bndr []) : rest) grouped _ = Nothing -- Utilities From git at git.haskell.org Fri Dec 29 12:28:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Dec 2017 12:28:14 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: add note (696c056) Message-ID: <20171229122814.CD3BB3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/696c05643c035c6046c59db430e1aa536b4b3762/ghc >--------------------------------------------------------------- commit 696c05643c035c6046c59db430e1aa536b4b3762 Author: Gabor Greif Date: Fri Dec 29 12:16:19 2017 +0100 WIP: add note >--------------------------------------------------------------- 696c05643c035c6046c59db430e1aa536b4b3762 compiler/simplStg/StgCse.hs | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 7ca74ec..3d76704 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -421,7 +421,11 @@ mkStgCase scrut bndr ty alts | all isBndr alts = scrut isBndr _ = False -- see Note [Lumping alternatives together] grouped ((DEFAULT, _, _) : alts) | any isBndr alts = pprTrace "mkStgCaseDEFAULT" (ppr alts) Nothing - grouped alts | (bs@(_:_:_),rest) <- partition isBndr alts = pprTrace "mkStgCase" (ppr bs) $ Just ((DEFAULT, []{-FIXME-}, StgApp bndr []) : rest) + grouped alts | (binds@(_:_:_),rest) <- partition isBndr alts + , null $ concat [gs | (_, gs, _) <- binds] + = Just ((DEFAULT, [], StgApp bndr []) : rest) + -- CAVEAT: guards + -- TODO: common constr applications: partition, sort, group grouped _ = Nothing -- Utilities @@ -434,7 +438,7 @@ mkStgLet stgLet (Just binds) body = stgLet binds body {- Note [All alternatives are the binder] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When all alternatives simply refer to the case binder, then we do not have to bother with the case expression at all (#13588). CoreSTG does this as well, @@ -451,6 +455,17 @@ Core cannot just turn this into as this would not be well-typed. But to STG, where MkT is no longer in the way, we can. +Note [Lumping alternatives together] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +When some (>1) alternatives return the binder or a constructor +and there is no DEFAULT, then we can establish a new default case +and lump those together. We need to be careful, that there are no +guards attached, though. We can even do better if we discover that +the DEFAULT is present, but returns the same thing. Then we can simply +drop the lumped-together cases. Ideally we should weight our choices +by the count of the potentially lumped-together alternatives. + Note [Trivial case scrutinee] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We want to be able to handle nested reconstruction of constructors as in From git at git.haskell.org Fri Dec 29 12:28:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Dec 2017 12:28:17 +0000 (UTC) Subject: [commit: ghc] wip/T13861: check other lump identity (65635a8) Message-ID: <20171229122817.90F753A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/65635a88ceca0cd69c1baf4ac9622ab97571103f/ghc >--------------------------------------------------------------- commit 65635a88ceca0cd69c1baf4ac9622ab97571103f Author: Gabor Greif Date: Fri Dec 29 12:24:41 2017 +0100 check other lump identity >--------------------------------------------------------------- 65635a88ceca0cd69c1baf4ac9622ab97571103f testsuite/tests/simplStg/should_run/T13861.hs | 2 ++ testsuite/tests/simplStg/should_run/T13861.stdout | 1 + 2 files changed, 3 insertions(+) diff --git a/testsuite/tests/simplStg/should_run/T13861.hs b/testsuite/tests/simplStg/should_run/T13861.hs index 6442dce..0622899 100644 --- a/testsuite/tests/simplStg/should_run/T13861.hs +++ b/testsuite/tests/simplStg/should_run/T13861.hs @@ -104,6 +104,8 @@ test x = do (same $! r54) $! r55 -- yes, quux' is STG identity on 'Fal' let (r56, r57) = (Tru, lump r56) (same $! r56) $! r57 -- yes, lump is STG identity on 'Tru' + let (r58, r59) = (Fal, lump r58) + (same $! r58) $! r59 -- yes, lump is STG identity on 'Fal' let (r4,_) = bar r1 let r5 = nested r4 diff --git a/testsuite/tests/simplStg/should_run/T13861.stdout b/testsuite/tests/simplStg/should_run/T13861.stdout index 7fd4e43..155d985 100644 --- a/testsuite/tests/simplStg/should_run/T13861.stdout +++ b/testsuite/tests/simplStg/should_run/T13861.stdout @@ -12,5 +12,6 @@ yes yes yes yes +yes no ("YAY","foo") From git at git.haskell.org Fri Dec 29 12:28:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Dec 2017 12:28:20 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: implement DEFAULT lumping (86248ba) Message-ID: <20171229122820.55BC83A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/86248baf106255cc4e26b24a28fed697038e58f5/ghc >--------------------------------------------------------------- commit 86248baf106255cc4e26b24a28fed697038e58f5 Author: Gabor Greif Date: Fri Dec 29 12:25:52 2017 +0100 WIP: implement DEFAULT lumping and fix note, as we have no guards in STG >--------------------------------------------------------------- 86248baf106255cc4e26b24a28fed697038e58f5 compiler/simplStg/StgCse.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 3d76704..960c254 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -420,11 +420,11 @@ mkStgCase scrut bndr ty alts | all isBndr alts = scrut isBndr (_, _, StgApp f []) = f == bndr isBndr _ = False -- see Note [Lumping alternatives together] - grouped ((DEFAULT, _, _) : alts) | any isBndr alts = pprTrace "mkStgCaseDEFAULT" (ppr alts) Nothing + grouped (def@(DEFAULT, _, _) : alts) | isBndr def + , (binds@(_:_),rest) <- partition isBndr alts + = pprTrace "mkStgCaseDEFAULT" (ppr alts) $ Just (def:rest) grouped alts | (binds@(_:_:_),rest) <- partition isBndr alts - , null $ concat [gs | (_, gs, _) <- binds] = Just ((DEFAULT, [], StgApp bndr []) : rest) - -- CAVEAT: guards -- TODO: common constr applications: partition, sort, group grouped _ = Nothing @@ -458,10 +458,9 @@ we can. Note [Lumping alternatives together] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When some (>1) alternatives return the binder or a constructor +When some (>1) alternatives return the binder or a constructor, and there is no DEFAULT, then we can establish a new default case -and lump those together. We need to be careful, that there are no -guards attached, though. We can even do better if we discover that +and lump those together. We can even do better, if we discover that the DEFAULT is present, but returns the same thing. Then we can simply drop the lumped-together cases. Ideally we should weight our choices by the count of the potentially lumped-together alternatives. From git at git.haskell.org Fri Dec 29 12:28:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Dec 2017 12:28:23 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: lump with DEFAULT (35e0ef1) Message-ID: <20171229122823.1D9D83A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/35e0ef1ac7d59ff6298d8a1795d5fd2148a2c5f6/ghc >--------------------------------------------------------------- commit 35e0ef1ac7d59ff6298d8a1795d5fd2148a2c5f6 Author: Gabor Greif Date: Fri Dec 29 12:47:59 2017 +0100 WIP: lump with DEFAULT >--------------------------------------------------------------- 35e0ef1ac7d59ff6298d8a1795d5fd2148a2c5f6 compiler/simplStg/StgCse.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 960c254..6b805d7 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -420,9 +420,10 @@ mkStgCase scrut bndr ty alts | all isBndr alts = scrut isBndr (_, _, StgApp f []) = f == bndr isBndr _ = False -- see Note [Lumping alternatives together] - grouped (def@(DEFAULT, _, _) : alts) | isBndr def - , (binds@(_:_),rest) <- partition isBndr alts - = pprTrace "mkStgCaseDEFAULT" (ppr alts) $ Just (def:rest) + grouped (def@(DEFAULT, _, _) : alts) + | isBndr def + , (binds@(_:_),rest) <- partition isBndr alts + = pprTrace "mkStgCase" (ppr alts) $ Just (def:rest) grouped alts | (binds@(_:_:_),rest) <- partition isBndr alts = Just ((DEFAULT, [], StgApp bndr []) : rest) -- TODO: common constr applications: partition, sort, group From git at git.haskell.org Fri Dec 29 12:28:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Dec 2017 12:28:31 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: add some noise (c055266) Message-ID: <20171229122831.674863A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/c0552668cc8e0c57c05702f51e5bd27bee07e2bc/ghc >--------------------------------------------------------------- commit c0552668cc8e0c57c05702f51e5bd27bee07e2bc Author: Gabor Greif Date: Fri Dec 29 13:27:04 2017 +0100 WIP: add some noise >--------------------------------------------------------------- c0552668cc8e0c57c05702f51e5bd27bee07e2bc compiler/simplStg/StgCse.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 6b805d7..6643454 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -425,7 +425,7 @@ mkStgCase scrut bndr ty alts | all isBndr alts = scrut , (binds@(_:_),rest) <- partition isBndr alts = pprTrace "mkStgCase" (ppr alts) $ Just (def:rest) grouped alts | (binds@(_:_:_),rest) <- partition isBndr alts - = Just ((DEFAULT, [], StgApp bndr []) : rest) + = pprTrace "mkStgCase#" (ppr alts) $ Just ((DEFAULT, [], StgApp bndr []) : rest) -- TODO: common constr applications: partition, sort, group grouped _ = Nothing From git at git.haskell.org Fri Dec 29 12:28:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Dec 2017 12:28:25 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: less noise, and add TODO (98c8190) Message-ID: <20171229122825.D887F3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/98c819092be44b38d25fa77ba416aec8d70d6409/ghc >--------------------------------------------------------------- commit 98c819092be44b38d25fa77ba416aec8d70d6409 Author: Gabor Greif Date: Fri Dec 29 13:23:50 2017 +0100 WIP: less noise, and add TODO >--------------------------------------------------------------- 98c819092be44b38d25fa77ba416aec8d70d6409 compiler/codeGen/StgCmmClosure.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 034a641..6566672 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -591,10 +591,6 @@ getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt -getCallMethod _ name id (LFUnknown False) 0 _v_args cg_loc _self_loop_info - | occNameString (nameOccName name) == "wild" - = pprTrace "getCallMethod" (ppr id <+> ppr cg_loc) ReturnIt - getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt -- n_args=0 because it'd be ill-typed to apply a saturated @@ -635,6 +631,10 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info = SlowCall -- might be a function +getCallMethod _ name id (LFUnknown False) 0 _v_args cg_loc _self_loop_info + | occNameString (nameOccName name) == "wild" -- TODO: make this robust + = ReturnIt -- seems to come from case, must be (tagged) WHNF already + getCallMethod _ name _ (LFUnknown False) n_args _v_args _cg_loc _self_loop_info = ASSERT2( n_args == 0, ppr name <+> ppr n_args ) EnterIt -- Not a function From git at git.haskell.org Fri Dec 29 12:28:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Dec 2017 12:28:28 +0000 (UTC) Subject: [commit: ghc] wip/T13861: Another identity test (e51bf6d) Message-ID: <20171229122828.A12CC3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/e51bf6d849e9f498e59878adde17ae6153830127/ghc >--------------------------------------------------------------- commit e51bf6d849e9f498e59878adde17ae6153830127 Author: Gabor Greif Date: Fri Dec 29 13:25:42 2017 +0100 Another identity test >--------------------------------------------------------------- e51bf6d849e9f498e59878adde17ae6153830127 testsuite/tests/simplStg/should_run/T13861.hs | 11 ++++++++++- testsuite/tests/simplStg/should_run/T13861.stdout | 1 + 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/simplStg/should_run/T13861.hs b/testsuite/tests/simplStg/should_run/T13861.hs index 0622899..6c4f5a0 100644 --- a/testsuite/tests/simplStg/should_run/T13861.hs +++ b/testsuite/tests/simplStg/should_run/T13861.hs @@ -36,12 +36,19 @@ quux' Fal = True quux' _ = False {-# NOINLINE quux' #-} --- the 'Fal' and default case should be lumped together +-- the 'Dunno' and default case (i.e. 'Tru') should be lumped together lump Fal = True lump Dunno = unsafeCoerce Tru lump _ = False {-# NOINLINE lump #-} +-- the 'One' and default case should be lumped together +data Boom = Zero | One | Two | Three +lump' One = Fal +lump' Three = Tru +lump' other = unsafeCoerce other -- Zero -> Tru, Two -> Dunno +{-# NOINLINE lump' #-} + nested :: Either Int (Either Int a) -> Either Bool (Maybe a) nested (Right (Right x)) = Right (Just x) @@ -106,6 +113,8 @@ test x = do (same $! r56) $! r57 -- yes, lump is STG identity on 'Tru' let (r58, r59) = (Fal, lump r58) (same $! r58) $! r59 -- yes, lump is STG identity on 'Fal' + let (r60, r61) = (Two, lump' r60) + (same $! r60) $! r61 -- yes, lump' is STG identity on 'Two' let (r4,_) = bar r1 let r5 = nested r4 diff --git a/testsuite/tests/simplStg/should_run/T13861.stdout b/testsuite/tests/simplStg/should_run/T13861.stdout index 155d985..2a61dc3 100644 --- a/testsuite/tests/simplStg/should_run/T13861.stdout +++ b/testsuite/tests/simplStg/should_run/T13861.stdout @@ -13,5 +13,6 @@ yes yes yes yes +yes no ("YAY","foo") From git at git.haskell.org Sat Dec 30 00:04:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 Dec 2017 00:04:25 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: implement lumping of same results for may constructors (b05558e) Message-ID: <20171230000425.3E05A3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/b05558e4eb151243f9d280c4f17f9e2364b4aa9c/ghc >--------------------------------------------------------------- commit b05558e4eb151243f9d280c4f17f9e2364b4aa9c Author: Gabor Greif Date: Sat Dec 30 01:02:09 2017 +0100 WIP: implement lumping of same results for may constructors >--------------------------------------------------------------- b05558e4eb151243f9d280c4f17f9e2364b4aa9c compiler/codeGen/StgCmmClosure.hs | 2 +- compiler/simplStg/StgCse.hs | 19 +++++++++++++------ 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 6566672..c7e6e2d 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -631,7 +631,7 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info = SlowCall -- might be a function -getCallMethod _ name id (LFUnknown False) 0 _v_args cg_loc _self_loop_info +getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | occNameString (nameOccName name) == "wild" -- TODO: make this robust = ReturnIt -- seems to come from case, must be (tagged) WHNF already diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 6643454..ded1761 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -95,7 +95,8 @@ import Name (NamedThing (..), mkFCallName) import Unique (mkUniqueGrimily, getKey, getUnique) import TyCon (tyConFamilySize) -import Data.List (partition) +import Data.List (partition, sortBy, groupBy) +import Data.Function (on) -------------- -- The Trie -- @@ -422,11 +423,17 @@ mkStgCase scrut bndr ty alts | all isBndr alts = scrut -- see Note [Lumping alternatives together] grouped (def@(DEFAULT, _, _) : alts) | isBndr def - , (binds@(_:_),rest) <- partition isBndr alts - = pprTrace "mkStgCase" (ppr alts) $ Just (def:rest) - grouped alts | (binds@(_:_:_),rest) <- partition isBndr alts - = pprTrace "mkStgCase#" (ppr alts) $ Just ((DEFAULT, [], StgApp bndr []) : rest) - -- TODO: common constr applications: partition, sort, group + , ((_:_),rest) <- partition isBndr alts + = Just (def:rest) + grouped alts | ((_:_:_),rest) <- partition isBndr alts + = Just ((DEFAULT, [], StgApp bndr []) : rest) + grouped ((DEFAULT, _, _) : _) = Nothing + grouped alts + | (cons@(_:_:_),rest) <- partition (\case (_,_,StgConApp _ [] [])->True; _->False) alts + , let itsCon (_,_,StgConApp c [] []) = c + gcons = groupBy ((==) `on` itsCon) cons + , (((_,_,res):_:_):others) <- sortBy (comparing $ Down . length) gcons + = pprTrace "mkStgCase##" (ppr others) $ Just ((DEFAULT, [], res) : concat others ++ rest) grouped _ = Nothing -- Utilities From git at git.haskell.org Sat Dec 30 00:30:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 Dec 2017 00:30:28 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: cleanups (ea8b155) Message-ID: <20171230003028.3C40A3A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/ea8b155d68ed0a341ec175c90d2bedbc0a1c4325/ghc >--------------------------------------------------------------- commit ea8b155d68ed0a341ec175c90d2bedbc0a1c4325 Author: Gabor Greif Date: Sat Dec 30 01:30:13 2017 +0100 WIP: cleanups of warnings, thinkos >--------------------------------------------------------------- ea8b155d68ed0a341ec175c90d2bedbc0a1c4325 compiler/simplStg/StgCse.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index ded1761..df3acab 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -1,5 +1,4 @@ {-# LANGUAGE TypeFamilies, LambdaCase #-} -{-# OPTIONS -Wno-error=unused-imports -Wno-error=unused-top-binds #-} {-| Note [CSE for Stg] @@ -92,11 +91,11 @@ import TrieMap import NameEnv import Control.Monad( (>=>) ) import Name (NamedThing (..), mkFCallName) -import Unique (mkUniqueGrimily, getKey, getUnique) -import TyCon (tyConFamilySize) +import Unique (mkUniqueGrimily) import Data.List (partition, sortBy, groupBy) import Data.Function (on) +import Data.Ord (Down(..), comparing) -------------- -- The Trie -- @@ -431,6 +430,7 @@ mkStgCase scrut bndr ty alts | all isBndr alts = scrut grouped alts | (cons@(_:_:_),rest) <- partition (\case (_,_,StgConApp _ [] [])->True; _->False) alts , let itsCon (_,_,StgConApp c [] []) = c + itsCon _ = pprPanic "mkStgCase" (text "not StgConApp") gcons = groupBy ((==) `on` itsCon) cons , (((_,_,res):_:_):others) <- sortBy (comparing $ Down . length) gcons = pprTrace "mkStgCase##" (ppr others) $ Just ((DEFAULT, [], res) : concat others ++ rest) From git at git.haskell.org Sat Dec 30 13:14:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 Dec 2017 13:14:53 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: another test (f3fd83b) Message-ID: <20171230131453.3BB483A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/f3fd83b698bf01e9f1542797ba8a9e666268cb37/ghc >--------------------------------------------------------------- commit f3fd83b698bf01e9f1542797ba8a9e666268cb37 Author: Gabor Greif Date: Sat Dec 30 14:14:36 2017 +0100 WIP: another test >--------------------------------------------------------------- f3fd83b698bf01e9f1542797ba8a9e666268cb37 testsuite/tests/simplStg/should_run/T13861.hs | 8 ++++++++ testsuite/tests/simplStg/should_run/T13861.stdout | 1 + 2 files changed, 9 insertions(+) diff --git a/testsuite/tests/simplStg/should_run/T13861.hs b/testsuite/tests/simplStg/should_run/T13861.hs index 6c4f5a0..b4049fc 100644 --- a/testsuite/tests/simplStg/should_run/T13861.hs +++ b/testsuite/tests/simplStg/should_run/T13861.hs @@ -49,6 +49,12 @@ lump' Three = Tru lump' other = unsafeCoerce other -- Zero -> Tru, Two -> Dunno {-# NOINLINE lump' #-} +lump'' Zero = True +lump'' One = False +lump'' Two = False +lump'' Three = False +{-# NOINLINE lump'' #-} + nested :: Either Int (Either Int a) -> Either Bool (Maybe a) nested (Right (Right x)) = Right (Just x) @@ -115,6 +121,8 @@ test x = do (same $! r58) $! r59 -- yes, lump is STG identity on 'Fal' let (r60, r61) = (Two, lump' r60) (same $! r60) $! r61 -- yes, lump' is STG identity on 'Two' + let (r62, r63) = (lump'' One, lump'' Three) + (same $! r62) $! r63 -- yes let (r4,_) = bar r1 let r5 = nested r4 diff --git a/testsuite/tests/simplStg/should_run/T13861.stdout b/testsuite/tests/simplStg/should_run/T13861.stdout index 2a61dc3..0f920b7 100644 --- a/testsuite/tests/simplStg/should_run/T13861.stdout +++ b/testsuite/tests/simplStg/should_run/T13861.stdout @@ -14,5 +14,6 @@ yes yes yes yes +yes no ("YAY","foo") From git at git.haskell.org Sat Dec 30 13:29:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 Dec 2017 13:29:44 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: appease travis (542eb1b) Message-ID: <20171230132944.9B8C53A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/542eb1bb5305350f5db16f677dc012e879da2d4a/ghc >--------------------------------------------------------------- commit 542eb1bb5305350f5db16f677dc012e879da2d4a Author: Gabor Greif Date: Sat Dec 30 14:29:32 2017 +0100 WIP: appease travis >--------------------------------------------------------------- 542eb1bb5305350f5db16f677dc012e879da2d4a compiler/codeGen/StgCmmClosure.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index c7e6e2d..cc148f8 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -631,7 +631,7 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info = SlowCall -- might be a function -getCallMethod _ name id (LFUnknown False) 0 _v_args _cg_loc _self_loop_info +getCallMethod _ name _ (LFUnknown False) 0 _v_args _cg_loc _self_loop_info | occNameString (nameOccName name) == "wild" -- TODO: make this robust = ReturnIt -- seems to come from case, must be (tagged) WHNF already From git at git.haskell.org Sat Dec 30 22:06:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 30 Dec 2017 22:06:52 +0000 (UTC) Subject: [commit: ghc] wip/T13861: WIP: clean up some cruft (a0fdeba) Message-ID: <20171230220652.935093A5F5@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13861 Link : http://ghc.haskell.org/trac/ghc/changeset/a0fdeba207e457924a2b7204dd4f7db14d5e4364/ghc >--------------------------------------------------------------- commit a0fdeba207e457924a2b7204dd4f7db14d5e4364 Author: Gabor Greif Date: Sat Dec 30 23:06:36 2017 +0100 WIP: clean up some cruft >--------------------------------------------------------------- a0fdeba207e457924a2b7204dd4f7db14d5e4364 compiler/codeGen/StgCmmClosure.hs | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index cc148f8..8bcea14 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP, RecordWildCards, StandaloneDeriving #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE CPP, RecordWildCards #-} + ----------------------------------------------------------------------------- -- -- Stg to C-- code generation: @@ -223,13 +223,8 @@ data LambdaFormInfo -- always a value, needs evaluation | LFLetNoEscape -- See LetNoEscape module for precise description - deriving Show -deriving instance Show TopLevelFlag -deriving instance Show OneShotInfo -deriving instance Show ArgDescr -deriving instance Show StandardFormInfo -instance Show DataCon where show _ = "" + ------------------------- -- StandardFormInfo tells whether this thunk has one of -- a small number of standard forms